#!/usr/bin/perl
#!c:/perl/bin/perl.exe
# The above line may need to be changed to reflect the location of
# the perl interpreter on your system.  Use "which perl" on a Unix system
# to make a noble attempt to locate your perl interpreter.  If you are
# installing this on an NT IIS server then you probably do not need to
# modify this line because it will most likely be ignored.  Apache under
# NT generally DOES require the top line to be configured.  We have provided
# two common paths above as examples, only the top line will be used, the
# second line is just there to provide an example.

############################################################################
# MailMan, Professional Edition, version 3.1
#
# Copyright (c) 1996 - 2002, Endymion Corporation. All rights reserved.
# Endymion Corporation: http://www.endymion.com/
# by Ryan Alyn Porter, 1996 - 2002
# contributions by Stephen M Noa, 2001
#
# This product is not free and is not in the public domain.
# For detailed information on the licensing structure of MailMan, see
# http://www.endymion.com/products/mailman/
#
# Initiated:      9/07/1997 Version 1.1
# Re-awakened:    4/24/1998 Version 2.0 beta
# Released:       7/20/1998 Version 2.0
# Last Modified:  2/05/2002 Version 3.1
############################################################################

# If you are having problems with MailMan not working at all, please
# take a look at the MailMan FAQ, stored online at
# http://www.endymion.com/products/mailman/faq.htm.  A version of the FAQ
# should also have been in the distribution that contained this file.

package mailman;

# Enable these while you are working on modifications.  Make absolutely
# certain that 'use strict' is NOT enabled in production installations.
# CGI.pm and 'use strict' are not compatible, if you have 'use strict'
# enabled then your users will not be able to upload files because CGI.pm
# provides uploaded files using a bizarre on-the-fly file handle that will
# cause an error if you have 'use strict' enabled.  We think that this is
# ugly too, but there is no way around it at the moment.
#use strict;
#$^W = 1; # Warnings.

# If you are getting mysterious "Internal Server Error" messages when
# you try to run MailMan, then you might want to un-comment this line
# to get a decent log of the error in a location that you can find.
#BEGIN
#{
#  open(STDERR, 'c:/tmp/mailman_log.txt');
#}

# Version information that might find its way into output.
$mailman::strMailManVersion = 'v3.1';
$mailman::strMailManEdition = 'Professional Edition';

# Variable initialization.  Clean and neat and all, but very necessary
# for mod_perl.
InitializeVars();

############################################################################
# This section contains a few variables that you might need to set  in order
# to get MailMan functioning properly.  If your installation is working,
# then you don't need to worry about any of these.
############################################################################

# Local Location Users
# IMPORTANT: Set this variable to point to a directory that you have 
# set up as the user storage area.  Make sure that your web user has
# read and write access to this directory.  This needs to be a path
# that makes sense at runtime for the web user, probably an absolute
# path like '/something/somewhere/mailman/users/' or 
# "C\:\\mailman\\users\\".  Note the terminal slash at the end.  That's
# important.  It won't work without that slash.  You probably shouldn't
# be storing your user messages in publicly readable areas of your
# web server for obvious security reasons, but some people don't have the
# option.  Just use your head, and ask us if you have any questions.
# Also PLEASE remember that the data that MailMan writes to this
# directory should be considered irreplacable user data and should be
# handled and backed up appropriately.
$mailman::strLocalLocationUsers = '/users/';

# User Disk Quota
# This is fairly self-explanatory, it's the number of bytes that users
# are allowed to use on your HTTP server for storing messages.  If this
# value is set to zero then no quota will be maintained and users will
# never see quota status indicators.  You can turn this on and off and
# mess with the size at will, but note that if you decrease the quota
# size after users have downloaded stuff then you could put some users
# over quota.  We have taken care to gracefully handle this situation
# but your users might not think that things look very graceful when that
# happens.  Remember to set this in bytes.  1024*1024 bytes in a megabyte,
# some common values are as follows:
# 1  MB = 1048576 B
# 2  MB = 2097152 B
# 5  MB = 5242880 B
# 10 MB = 10485760 B
# Note that there are a couple of ways that a user can go slightly
# over quota.  MailMan allows this in cases like the storage of an
# outgoing message and the like where recovery from a quota error
# would be very difficult and un-graceful.  Quotas are primarily
# enforced when a user downloads new messages.  If you notice that a
# particular user has gone slightly over 100% of his/her quota, please
# don't consider that a bug in MailMan.  We have intentionally set things
# up this way.  This is a hint to administrators to allow for a little
# more room on storage systems than the sum of all users' quotas.
$mailman::iUserDiskQuota = 20971520;

# Download Individual Accounts
# Use this variable to tell MailMan that it should only download messages
# from external accounts when the user explicitly issues a LOADACCOUNT
# command.  If this value is not set, MailMan will automatically download
# messages from all of a user's accounts when they log in.
#$mailman::bDownloadIndividualAccounts = 1;

# Case Insensitive Accounts
# This variable is used to indicate to MailMan that the POP3 account
# names are case insensitive, so "BOB", "Bob" and "bob" are all considered
# the same POP3 user.  This is important in locating the user's persistent
# information such as the message archive and the user's properties files.
$mailman::bCaseInsensitiveAccounts = 1;

# Outgoing Banner Text
# This is the banner that is appended to the end of any message that
# this MailMan installation sends.  One reason why this is one of the
# first configuration options is because we want to make it very 
# obvious that you can remove or modify this banner.  Endymion places
# no restrictions at all on this banner, so don't worry about leaving
# credit to us in here or anything like that.  Please feel free to 
# change this to whatever you like, or completely remove it.  If this
# value is not defined then it will simply append no banner.
#$mailman::strOutgoingBannerText = 
#    "\n" .
#    "---------------------------------------------\n" .
#    "This message was sent using RCC Mail.\n" .
#
# Incoming Mail Server:
# The way that we originally intended to allow people to 'rig' the server
# names for an installation was through simple template modifications, as
# mentioned in the FAQ.  A lot of people have asked about ways to rig the
# server names in the script itself though, so we added this.  We aim to
# please...  If you want to rig your incoming server name so that it makes
# no difference at all what an incoming form specifies, just un-comment
# this line and specify it.
#$mailman::strIncomingServer = 'pop3.norton.antivirus';

$mailman::strIncomingServer = 'rcctvm.org';
# Outgoing Mail Server:
# Same deal, different server.
$mailman::strOutgoingServer = 'rcctvm.org';

# Sendmail Path:
# If you would like your MailMan installation to use a local Sendmail
# invocation when sending outbound mail instead of connecting to an
# SMTP server, then you can un-comment this line and configure this to
# point to the path of your Sendmail command.  Use this if you do not
# have an SMTP server running at all.
# This might also work with some minor modification with other
# command-line agents that support something like Sendmail's "-bs"
# option, which instructs Sendmail to use the SMTP protocol via standard
# input and standard output.  If you have access to an SMTP server then
# you are really probably better off using the wire connection instead
# of this.
#$mailman::strLocalLocationSendmail = '/usr/sbin/sendmail';

# Email Address Settings
# The following few settings pertain to MailMan's need to infer a
# user's email address.  When a user logs in to MailMan, they provide
# a POP3 username, server name, and password.  That's not quite
# enough information though.  If the user ever wants to send mail,
# then MailMan will need to know the user's email address for using
# on the "FROM" line of the outgoing message.  In many cases the
# user's email address can be inferred by concatenating the user's
# POP3 username with the POP3 server name.  For example, the POP3
# user "sales" at the mail server "endymion.com" would result in the
# email address "sales@endymion.com".  This is the default behavior,
# and if it is possible for you to configure your server name simply
# like in this example so that it will result in functional and
# attractive email addresses, then you don't need to do anything to
# any of these options.

# From Domain Trim:
# If you have to specify a machine name for your POP3 server, then
# such as "mail.endymion.com" rather than "endymion.com", then 
# MailMan will guess something dumb like "sales@mail.endymion.com"
# when it needs to guess an email address.  You can use this option
# to have MailMan automatically trim one or more names from the
# left side of a POP3 server's name. The number that you set here
# represents the total number of names to shear off of the left-hand
# side of the machine name.  For instance, if the user's POP3 server
# name is "mail.rex.endymion.com", and you set this value to 0, the
# default, then when the user composes a message MailMan will guess
# "sales@mail.rex.endymion.com" as the 'from' address.  If you set
# this value to 1 then it will guess "sales@rex.endymion.com", if
# you set it to 2 then it will guess "sales@endymion.com", etc.  This
# can be helpful if you have a number of different virtual domains
# and you want the email address to be inferred dynamically, rather
# than by hard-coding it with the "From Domain Name" configuration value.
#$mailman::iFromDomainTrim = 1;

# From Domain Name:
# In some cases, the POP3 server that your users check their mail from
# doesn't have anything to do with the domain name portion of the
# user's email address.  You can use this option to manually set the
# entire domain name portion of a user's email address.
# For instance, consider the hyptothetical email address
# "sales@endymion.com", which is served by a mailbox on the server
# "mail5.it.endy-backoffice.com".  When the user "sales" logs into
# the POP3 server "mail5.it.endy-backoffice.com", MailMan will assume
# that the email address is "sales@mail5.it.endy-backoffice.com".
# If you set this variable to "endymion.com", then it will assume that
# this user's email address is "sales@endymion.com" instead.
$mailman::strFromDomainName = "rcctvm.org";

# Username is the Email Address
# The above options hopefully helped you to configure the domain name
# portion of your users' email addresses.  In some cases you don't
# want MailMan trying to guess a domain name at all because your users
# log in to the POP3 server with their complete email address.  For
# instance, consider the hypothetical email address "sales@endymion.com"
# that is served by a mailbox called "sales@endymion.com" on the 
# mail server "pop3.endymion.com".  MailMan's default behavior would
# be to infer the email address "sales@endymion.com@pop3.endymion.com",
# which is obviously wrong.  Un-comment the following line to instruct
# MailMan to simply ignore the entire mail server name when inferring
# the user's email address, using only the POP3 username.
#$mailman::bUsernameIsEmailAddress = '1';

# Email Address Mapping File
# This is a last  option if all else fails.  In an increasing number of
# cases, the user's POP3 username has nothing to do with their email
# address at all.  For instance, you might have a user named "endy-sales"
# on your mail server, but that mailbox actually corresponds to the
# email address "sales@endymion.com".  In these cases you either need
# to make a custom code modification to MailMan that will allow your
# user to log in with the name "sales" and have MailMan automatically
# infer or look up the POP3 user name "endy-sales", which is hard and
# may take some time.  The simpler solution is to have your users log
# in using their POP3 username as normal, and then provide a mapping
# file that allows MailMan to look up each user's email address based
# on their POP3 username, like a phone book.  For instance, if you
# provide a flat text file that contains a few lines like this:
# endy-sales   sales@endymion.com
# endy-support support@endymion.com
# (without the '#' marks at the beginning of the lines)
# ...then MailMan will open the file and search for the POP3 user
# name in the left column each time it needs to infer an email
# address.  If an entry is found, then it will use the email address
# listed, if an entry is not found then MailMan will fall back on
# the methods listed above.  To enable this option, simply construct
# a text file and provide the name of the text file here.  The text
# file can be automatically constructed if you like.
#$mailman::strUsernameMappingFileName = "mapfile.txt";

# Outgoing Domain Name:
# When a user specifies a recipient name without full domain qualification
# ("rap" instead of "rap@endymion.com", for example) then the SMTP server
# should provide configuration rules for determining how to deal with this
# mail.  It should not be the responsibility of the mail client to fill in
# a complete address.  We have had many requests for a feature to allow 
# an administrator to specify a default domain name, however, and we aim
# to please.  This configuration variable is the result.  If you want
# MailMan to assume a default domain name when it is given an incomplete
# address, uncomment this line and set it to your domain name.  We strongly
# recommend against this, however, you should be looking into your SMTP
# server's configuration options and not using this feature.
#$mailman::strOutgoingDomainName = 'endymion.com';

# Messages Per Page:
# This value controls the number of messages returned per page in a
# message list.  Adjust it if you like.
# The user has the option of overriding this value in the user preferences
# page.  If you don't want them to be able to do this you can hide that
# field in your templates.
$mailman::iMessagesPerPage = 10;

# Redirect Location
# MailMan can redirect users to an alternate web page instead of the login
# page when logging out.  To redirect to an alternate location besides the
# default login page you need to uncomment the line below and set it to the
# URL location of the page you want to use.
#$mailman::strURLRedirectLocation = 'http://www.rcctvm.org/';

# Local Template Location:
# If you have a web server that sets the current directory to something
# strange, you can set this to an absolute path to make it easier to
# allow MailMan to find the templates.  Just set this variable to an
# absolute path like "C\:\\inetpub\\wwwroot\\mailman\\templates\\"
# or '/usr/home/rap/mailman/' or whatever.  Note the final slash, that's
# important.  If you leave it out then things won't work.  If you need
# to set this value, then un-comment the following line:
#$mailman::strLocalTemplateLocation = "D:/inetpub/wwwroot/Endymion2/products/mailman/demo/";

# Local Script Location:
# If your server is one of the ones that causes problems that require the
# above value to be set, then you might also need to set this value.  In
# most cases your script location and your template location will be 
# identical, but if you move your templates to a different directory than
# your script for whatever reason, then you will need to set this.  If you
# have no idea what I'm talking about, you should probably just leave this.
$mailman::strLocalScriptLocation = $mailman::strLocalTemplateLocation;

# URL Image Location:
# Use this to rig the URLs that will be used to access the images that
# the templates point to.  This value will be prepended to any value in
# the templates of the form ""i_*.gif"" (including the inner quotes).
# If you have customized your templates and your own custom images are
# not showing up in MailMan's output, it is probably because the custom
# images that you are using are not named "i_*.gif".
# To use this variable, set it to the exact value that you want prepended
# to image names in order to make them into URLs that will point to your
# image directory.  For instance, if you bury your images in an "images"
# directory under the directory where MailMan is installed, set this to
# 'images/' (with the slash).  If you put your images in a completely
# different directory, something that is rooted, like '/mailman/images/'
# might be what you are looking for.  In the most extreme cases you can
# do away with relative URLs entirely and provide a complete absolute URL
# like the one below
#$mailman::strURLImageLocation = 'http://www.endymion.com/images/';

# Use Perl 'alarm()' function:
# Set this to true if your Perl interpreter supports "alarm".  As of this
# Writing, NT Perl does not.  If this is not set, MailMan will not be able
# to timeout when a server hangs.  The OSSettings() routine will attempt
# to set this variable, but you can override it here if you want.
# The point of the "alarm" feature as used in MailMan is to allow MailMan
# to detect when a mail server has not responded within a reasonable
# amount of time.  If your server's Perl interpreter does not support
# "alarm", then MailMan will still work, but if a mail server ever does
# not respond then the user will get no feedback to that effect.
#$mailman::bUseAlarm = 1;

# Timeout Duration:
# The aforementioned timeout delay.  Set this to something else to modify
# how long MailMan will sit around waiting for a mail server to respond.
# Only works if $mailman::bUseAlarm is set to something.
$mailman::iTimeoutDurationInSeconds = 180;

# Use Perl 'crypt()' function:
# Some Perl impelentations apparently do not support the crypt() function.
# We have never seen one, and there are plenty of implementations out there
# that you should be able to find a good one, but we try to accomodate
# anyway.  Comment out this line if your Perl implementation is breaking
# on the crypt() function.  Be warned that if you do this your users'
# usernames and passwords will be less obfuscated than they were before,
# which admittedly wasn't much.  This is a good place to repeat the 
# suggestion that MailMan is an excellent candidate for SSL and other
# fancy HTTP security mechanisms.
#$mailman::bUseCrypt = 1;

# Use Hijack Test:
# MailMan performs a test to determine if the current session has been
# hijacked by a different user from a different address.  On a few 
# systems this will not work because of the configuration.  If your
# MailMan installation sits behind a cluster of caching proxy servers
# for load balancing, for instance.  If you want to disable the hijack
# checking functionality, just comment out this line.
#$mailman::bUseHijackTest = 1;

# Kiosk Mode:
# If you are using MailMan in a kiosk environment, it will generally
# be possible for a user to use a combination of "BACK" and "RELOAD" in
# the kiosk web browser to intrude backwards into the mail sessions of
# previous users.  If you set this value then MailMan will operate in
# kiosk mode, which means that when a user logs in, MailMan will create
# a new browser window with that user's session.  If the user logs out
# then that window will close, and the user's history information will
# go with the window so that intrusions with "BACK" and "RELOAD" aren't
# possible.  We recommend against using this feature for installations
# that are not kiosk-based because it relies on Javascript and cookies,
# which does not leave users with older browsers with a way in.  If you
# are in a kiosk environment then you have control over the browser an
# that's not a problem.  We strongly recommend against using the
# Microsoft Internet Explorer for kiosk environments because it does not
# properly respect the "Expires:" and "Cache-control:" HTTP headers, so
# IE will cache user mail to the hard drive whether you want it to or
# not.  Microsoft appears to have no interest in fixing this problem.
# IE 4 SP1 pretty consistently crashed during our tests of the 
# full-screen popup window kiosk mode, too, which is likely not exactly
# the behavior that you are looking for in your kiosk browser.
# The kiosk mode feature primarily activates and deactivates sections
# of outbound templates, so if you have customized your templates before
# you decided to use kiosk mode then it is entirely possible that you
# broke this mode by removing vital Javascript.  Consult the
# out-of-the-box template set for examples of the Javascript snippets
# necessary for this mode.
#$mailman::bKioskMode = 1;

# Date Format
# By default, MailMan does not process dates as date objects, it handles
# them as simple strings.  If you want more control over the formatting
# of your dates, then you can set this date format string and this format
# will be used for the dates on message lists.  The format for this string
# is specified by the documentation for the Date::Manip Perl module, which
# is included in most Unix Perl distributions now.  If you get an error
# when you try to use this, just make sure that you have Date::Manip 
# installed from CPAN, http://www.cpan.org  Note also that date processing
# is dependent on your time zone, so make sure that your 'TZ' environment
# variable is set.  If you get an error about this, then you can always
# explicitly set the time zone by un-commenting the following:
$ENV{'TZ'} = 'EST';
# Un-comment the following line to instruct MailMan to reformat dates.
$mailman::strDateFormat = '%dd/%mm/%yy';

# Location Attachments
# When a user selects an attachment from a message for downloading,
# MailMan generates that attachment on-the-fly and sends it through the
# HTTP server to the user's browser.  MailMan includes the necessary
# HTTP header information for the user's browser to determine the
# file name, but many broswers, most notably Microsoft's Internet
# Explorer, either ignore these headers or just don't handle them
# very well.  The result is that when a user downloads an attachment,
# your browser may present the user with a "Save As" box with the
# file name filled in as the name of this script, a string or random
# characters, or any number of other un-graceful things.  We think that
# the best solution to this problem would be for browser makers to
# pay attention to HTTP headers, but until then we provide a mechanism
# for working around the problem.  If you set up a directory that is
# writable by MailMan and readable by your web server, then MailMan
# will write out the attachment file to that directory temporarily,
# and redirect the user's browser to that file.  When the user logs
# in or out MailMan will ensure that the user's files in this
# temporary directory are removed.  A user that exits MailMan without
# logging out and never logs back in could potentially leave stale
# attachment files on the server, so occasional monitoring of the
# temporary directory for stale files would be appropriate.  Also note
# that this mechanism could be considered a privacy problem since a
# user's attachments are deposited temporarily into a world-readable
# directory rather than generated on-the-fly the way MailMan normally
# would do.  We have left the decision up to each individual
# administrator as to whether or not to use this feature.  Most people
# seem to prefer allowing MailMan to generate attachments on-the-fly
# for simplicity, ease of administration, and security/privacy, but
# some people think that the attachment file name thing is a critical
# issue.  The decision is yours.
# IMPORTANT SECURITY ADVISORY:
# Make absolutely certain that the directory that you use for
# attachments does *NOT* allow executable code.  Do NOT use this
# method of attachment handling if you are not absolutely certain
# that executable code is not allowed in that directory.  If your
# temporary directory allows executable code then any attachments
# that end in ".cgi", ".php", ".pl", etc, may be executed by your
# server when they are accessed, rather than simply served.  You do
# *NOT* want this.
# To use this feature, create a directory that is readable by your
# web server and writable by the user that MailMan runs as.  Set
# $mailman::strLocalLocationAttachments to the local path name of 
# this directory, for instance
# $mailman::strLocalLocationAttachments = '/public_html/attachtmp/';
# Then set $mailman::strURLLocationAttachments to the URL location
# of this directory, for instance
# $mailman::strURLLocationAttachments = '/attachtmp/';
# Note the terminal slashes at the end, those are necessary.  Just
# set and uncomment the following lines to use this feature:
#$mailman::strLocalLocationAttachments = 'c:/www/public_html/mailman/tmp/';
#$mailman::strURLLocationAttachments = '/mailman/tmp/';

# Local File Permissions
# Use this if you want to modify the permissions that files and
# directories created by MailMan use.  This will only make much sense
# to Unix and Unix-like operating systems.  If this value is not set,
# nothing will happen.  This should be an octal integer as in the
# example below, not a string.
$mailman::iLocalFilePermissions = 0666;

# Local Directory Permissions
# Same as above, used for directories created by MailMan.
$mailman::iLocalDirectoryPermissions = 0777;

# Subject Truncation Length
# This is the maximum length allowed for a subject line in the message
# list pages.  If you set this then subject lines will be truncated at
# this length, for predictable layout.  If you don't set this, then
# subjects will be left untouched.  Subjects will always be left alone
# on the message display page.
$mailman::iSubjectTruncationLength = 20;

############################################################################
# You should not have to configure any values after this line.
############################################################################

# The following section of code is CGI manipulation routines
# originally provided as a module called "cgi-lib.pl".  This
# code includes some very minor modifications to that code.
# This is the original copyright notice from that code:
#
# Copyright (c) 1993-1999 Steven E. Brenner  
# Unpublished work.
#
# We have removed the original license notice to avoid confusion
# over MailMan's license.  If you are interested in this excellent
# CGI handling code, then please see:
#     http://cgi-lib.stanford.edu/cgi-lib/

$cgi_lib'version = sprintf("%d.%02d", q$Revision: 2.18 $ =~ /(\d+)\.(\d+)/);

# ReadParse
# Reads in GET or POST data, converts it to unescaped text, and puts
# key/value pairs in %in, using "\0" to separate multiple selections

# Returns >0 if there was input, 0 if there was no input 
# undef indicates some failure.

# Now that cgi scripts can be put in the normal file space, it is useful
# to combine both the form and the script in one place.  If no parameters
# are given (i.e., ReadParse returns FALSE), then a form could be output.

# If a reference to a hash is given, then the data will be stored in that
# hash, but the data from $in and @in will become inaccessable.
# If a variable-glob (e.g., *cgi_input) is the first parameter to ReadParse,
# information is stored there, rather than in $in, @in, and %in.
# Second, third, and fourth parameters fill associative arrays analagous to
# %in with data relevant to file uploads. 

# If no method is given, the script will process both command-line arguments
# of the form: name=value and any text that is in $ENV{'QUERY_STRING'}
# This is intended to aid debugging and may be changed in future releases

sub ReadParse {
  # Disable warnings as this code deliberately uses local and environment
  # variables which are preset to undef (i.e., not explicitly initialized)
  my ($perlwarn);
  $perlwarn = $^W;
  $^W = 0;

  # Parameters affecting cgi-lib behavior
  # User-configurable parameters affecting file upload.
#  $cgi_lib'maxdata    = 131072;    # maximum bytes to accept via POST - 2^17
  $cgi_lib'maxdata    = 5242880;    # five megabytes
  $cgi_lib'writefiles =      0;    # directory to which to write files, or
                                 # 0 if files should not be written
  $cgi_lib'filepre    = "cgi-lib"; # Prefix of file names, in directory above

  # Do not change the following parameters unless you have special reasons
  $cgi_lib'bufsize  =  8192;    # default buffer size when reading multipart
  $cgi_lib'maxbound =   100;    # maximum boundary length to be encounterd
  $cgi_lib'headerout =    0;    # indicates whether the header has been printed

  (*mailman::in) = shift if @_;    # CGI input
  (*mailman::incfn,                # Client's filename (may not be provided)
   *mailman::inct,                 # Client's content-type (may not be provided)
   *mailman::insfn) = @_;          # Server's filename (for spooled files)
  my ($len, $type, $meth, $errflag, $cmdflag, $got, $name);
	
  binmode(STDIN);   # we need these for DOS-based systems
  binmode(STDOUT);  # and they shouldn't hurt anything else 
  binmode(STDERR);
	
  # Get several useful env variables
  $type = $ENV{'CONTENT_TYPE'};
  $len  = $ENV{'CONTENT_LENGTH'};
  $meth = $ENV{'REQUEST_METHOD'};
  
  if ($len > $cgi_lib'maxdata) { #'
      &CgiDie("cgi-lib.pl: Request to receive too much data: $len bytes\n");
  }
  
  if (!defined $meth || $meth eq '' || $meth eq 'GET' || 
      $meth eq 'HEAD' ||
      $type eq 'application/x-www-form-urlencoded') {
    my ($key, $val, $i);
	
    # Read in text
    if (!defined $meth || $meth eq '') {
      $mailman::in = $ENV{'QUERY_STRING'};
      $cmdflag = 1;  # also use command-line options
    } elsif($meth eq 'GET' || $meth eq 'HEAD') {
      $mailman::in = $ENV{'QUERY_STRING'};
    } elsif ($meth eq 'POST') {
        if (($got = read(STDIN, $mailman::in, $len) != $len))
	  {$errflag="Short Read: wanted $len, got $got\n";};
    } else {
      &CgiDie("cgi-lib.pl: Unknown request method: $meth\n");
    }

    @mailman::in = split(/[&;]/,$mailman::in); 
    push(@mailman::in, @ARGV) if $cmdflag; # add command-line parameters

    foreach $i (0 .. $#mailman::in) {
      # Convert plus to space
      $mailman::in[$i] =~ s/\+/ /g;

      # Split into key and value.  
      ($key, $val) = split(/=/,$mailman::in[$i],2); # splits on the first =.

      # Convert %XX from hex numbers to alphanumeric
      $key =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
      $val =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;

      # Associate key and value
      $mailman::in{$key} .= "\0" if (defined($mailman::in{$key})); # \0 is the multiple separator
      $mailman::in{$key} .= $val;
    }

  } elsif ($ENV{'CONTENT_TYPE'} =~ m/^multipart\/form-data/) {
    # for efficiency, compile multipart code only if needed
    $errflag = !(eval <<'END_MULTIPART');

    my ($buf, $boundary, $head, @heads, $cd, $ct, $fname, $ctype, $blen);
    my ($bpos, $lpos, $left, $amt, $fn, $ser);
    my ($bufsize, $maxbound, $writefiles) = 
      ($cgi_lib'bufsize, $cgi_lib'maxbound, $cgi_lib'writefiles);

    # The following lines exist solely to eliminate spurious warning messages
    $buf = ''; 

    ($boundary) = $type =~ /boundary="([^"]+)"/; #";   # find boundary
    ($boundary) = $type =~ /boundary=(\S+)/ unless $boundary;
    &CgiDie ("Boundary not provided: probably a bug in your server") 
      unless $boundary;
    $boundary =  "--" . $boundary;
    $blen = length ($boundary);

    if ($ENV{'REQUEST_METHOD'} ne 'POST') {
      &CgiDie("Invalid request method for  multipart/form-data: $meth\n");
    }

    if ($writefiles) {
      my($me);
      stat ($writefiles);
      $writefiles = "/tmp" unless  -d _ && -w _;
      # ($me) = $0 =~ m#([^/]*)$#;
      $writefiles .= "/$cgi_lib'filepre"; 
    }

    # read in the data and split into parts:
    # put headers in @in and data in %in
    # General algorithm:
    #   There are two dividers: the border and the '\r\n\r\n' between
    # header and body.  Iterate between searching for these
    #   Retain a buffer of size(bufsize+maxbound); the latter part is
    # to ensure that dividers don't get lost by wrapping between two bufs
    #   Look for a divider in the current batch.  If not found, then
    # save all of bufsize, move the maxbound extra buffer to the front of
    # the buffer, and read in a new bufsize bytes.  If a divider is found,
    # save everything up to the divider.  Then empty the buffer of everything
    # up to the end of the divider.  Refill buffer to bufsize+maxbound
    #   Note slightly odd organization.  Code before BODY: really goes with
    # code following HEAD:, but is put first to 'pre-fill' buffers.  BODY:
    # is placed before HEAD: because we first need to discard any 'preface,'
    # which would be analagous to a body without a preceeding head.

    $left = $len;
   PART: # find each part of the multi-part while reading data
    while (1) {
      die $@ if $errflag;

      $amt = ($left > $bufsize+$maxbound-length($buf) 
	      ?  $bufsize+$maxbound-length($buf): $left);
      $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt);
      die "Short Read: wanted $amt, got $got\n" if $errflag;
      $left -= $amt;

      $mailman::in{$name} .= "\0" if defined $mailman::in{$name}; 
      $mailman::in{$name} .= $fn if $fn;

      $name=~/([-\w]+)/;  # This allows $insfn{$name} to be untainted
      if (defined $1) {
        $mailman::insfn{$1} .= "\0" if defined $mailman::insfn{$1}; 
        $mailman::insfn{$1} .= $fn if $fn;
      }

     BODY: 
      while (($bpos = index($buf, $boundary)) == -1) {
        if ($left == 0 && $buf eq '') {
          my $value;
	  foreach $value (values %mailman::insfn) {
            unlink(split("\0",$value));
	  }
	  &CgiDie("cgi-lib.pl: reached end of input while seeking boundary " .
		  "of multipart. Format of CGI input is wrong.\n");
        }
        die $@ if $errflag;
        if ($name) {  # if no $name, then it's the prologue -- discard
          if ($fn) { print FILE substr($buf, 0, $bufsize); }
          else     { $mailman::in{$name} .= substr($buf, 0, $bufsize); }
        }
        $buf = substr($buf, $bufsize);
        $amt = ($left > $bufsize ? $bufsize : $left); #$maxbound==length($buf);
        $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt);
	die "Short Read: wanted $amt, got $got\n" if $errflag;
        $left -= $amt;
      }
      if (defined $name) {  # if no $name, then it's the prologue -- discard
        if ($fn) { print FILE substr($buf, 0, $bpos-2); }
        else     { $mailman::in {$name} .= substr($buf, 0, $bpos-2); } # kill last \r\n
      }
      close (FILE);
      last PART if substr($buf, $bpos + $blen, 2) eq "--";
      substr($buf, 0, $bpos+$blen+2) = '';
      $amt = ($left > $bufsize+$maxbound-length($buf) 
	      ? $bufsize+$maxbound-length($buf) : $left);
      $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt);
      die "Short Read: wanted $amt, got $got\n" if $errflag;
      $left -= $amt;


      undef $head;  undef $fn;
     HEAD:
      while (($lpos = index($buf, "\r\n\r\n")) == -1) { 
        if ($left == 0  && $buf eq '') {
	  my $value;
          foreach $value (values %mailman::insfn) {
            unlink(split("\0",$value));
	  }
	  &CgiDie("cgi-lib: reached end of input while seeking end of " .
		  "headers. Format of CGI input is wrong.\n$buf");
        }
        die $@ if $errflag;

        $head .= substr($buf, 0, $bufsize);
        $buf = substr($buf, $bufsize);
        $amt = ($left > $bufsize ? $bufsize : $left); #$maxbound==length($buf);
        $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt);
        die "Short Read: wanted $amt, got $got\n" if $errflag;
        $left -= $amt;
      }
      $head .= substr($buf, 0, $lpos+2);
      push (@mailman::in, $head);

      @heads = split("\r\n", $head);
      ($cd) = grep (/^\s*Content-Disposition:/i, @heads);
      ($ct) = grep (/^\s*Content-Type:/i, @heads);

      ($name) = $cd =~ /\bname="([^"]+)"/i; #"; 
      ($name) = $cd =~ /\bname=([^\s:;]+)/i unless defined $name;  

      ($fname) = $cd =~ /\bfilename="([^"]*)"/i; #"; # filename can be null-str
      ($fname) = $cd =~ /\bfilename=([^\s:;]+)/i unless defined $fname;
      $mailman::incfn{$name} .= (defined $mailman::in{$name} ? "\0" : "") . 
        (defined $fname ? $fname : "");

      ($ctype) = $ct =~ /^\s*Content-type:\s*"([^"]+)"/i;  #";
      ($ctype) = $ct =~ /^\s*Content-Type:\s*([^\s:;]+)/i unless defined $ctype;
      $mailman::inct{$name} .= (defined $mailman::in{$name} ? "\0" : "") . $ctype;

      if ($writefiles && defined $fname) {
        $ser++;
	$fn = $writefiles . ".$$.$ser";
	open (FILE, ">$fn") || &CgiDie("Couldn't open $fn\n");
        binmode (FILE);  # write files accurately
      }
      substr($buf, 0, $lpos+4) = '';
      undef $fname;
      undef $ctype;
    }

1;
END_MULTIPART
    if ($errflag) {
      my ($errmsg, $value);
      $errmsg = $@ || $errflag;
      foreach $value (values %mailman::insfn) {
        unlink(split("\0",$value));
      }
      &CgiDie($errmsg);
    } else {
      # everything's ok.
    }
  } else {
    &CgiDie("cgi-lib.pl: Unknown Content-type: $ENV{'CONTENT_TYPE'}\n");
  }

  # no-ops to avoid warnings
  $mailman::insfn = $mailman::insfn;
  $mailman::incfn = $mailman::incfn;
  $mailman::inct  = $mailman::inct;

  $^W = $perlwarn;

  return ($errflag ? undef :  scalar(@mailman::in)); 
}


# PrintHeader
# Returns the magic line which tells WWW that we're an HTML document

sub PrintHeader {
  return "Content-type: text/html\n\n";
}


# HtmlTop
# Returns the <head> of a document and the beginning of the body
# with the title and a body <h1> header as specified by the parameter

sub HtmlTop
{
  my ($title) = @_;

  return <<END_OF_TEXT;
<html>
<head>
<title>$title</title>
</head>
<body>
<h1>$title</h1>
END_OF_TEXT
}


# HtmlBot
# Returns the </body>, </html> codes for the bottom of every HTML page

sub HtmlBot
{
  return "</body>\n</html>\n";
}


# SplitParam
# Splits a multi-valued parameter into a list of the constituent parameters

sub SplitParam
{
  my ($param) = @_;
  my (@params) = split ("\0", $param);
  return (wantarray ? @params : $params[0]);
}


# MethGet
# Return true if this cgi call was using the GET request, false otherwise

sub MethGet {
  return (defined $ENV{'REQUEST_METHOD'} && $ENV{'REQUEST_METHOD'} eq "GET");
}


# MethPost
# Return true if this cgi call was using the POST request, false otherwise

sub MethPost {
  return (defined $ENV{'REQUEST_METHOD'} && $ENV{'REQUEST_METHOD'} eq "POST");
}


# MyBaseUrl
# Returns the base URL to the script (i.e., no extra path or query string)
sub MyBaseUrl {
  my ($ret, $perlwarn);
  $perlwarn = $^W; $^W = 0;
  $ret = 'http://' . $ENV{'SERVER_NAME'} .  
         ($ENV{'SERVER_PORT'} != 80 ? ":$ENV{'SERVER_PORT'}" : '') .
         $ENV{'SCRIPT_NAME'};
  $^W = $perlwarn;
  return $ret;
}


# MyFullUrl
# Returns the full URL to the script (i.e., with extra path or query string)
sub MyFullUrl {
  my ($ret, $perlwarn);
  $perlwarn = $^W; $^W = 0;
  $ret = 'http://' . $ENV{'SERVER_NAME'} .  
         ($ENV{'SERVER_PORT'} != 80 ? ":$ENV{'SERVER_PORT'}" : '') .
         $ENV{'SCRIPT_NAME'} . $ENV{'PATH_INFO'} .
         (length ($ENV{'QUERY_STRING'}) ? "?$ENV{'QUERY_STRING'}" : '');
  $^W = $perlwarn;
  return $ret;
}


# MyURL
# Returns the base URL to the script (i.e., no extra path or query string)
# This is obsolete and will be removed in later versions
sub MyURL  {
  return &MyBaseUrl;
}


# CgiError
# Prints out an error message which which containes appropriate headers,
# markup, etcetera.
# Parameters:
#  If no parameters, gives a generic error message
#  Otherwise, the first parameter will be the title and the rest will 
#  be given as different paragraphs of the body

sub CgiError {
  my (@msg) = @_;
  my ($i,$name);

  if (!@msg) {
    $name = &MyFullUrl;
    @msg = ("Error: script $name encountered fatal error\n");
  };

  if (!$cgi_lib'headerout) { #')
    print &PrintHeader;	
    print "<html>\n<head>\n<title>$msg[0]</title>\n</head>\n<body>\n";
  }
  print "<h1>$msg[0]</h1>\n";
  foreach $i (1 .. $#msg) {
    print "<p>$msg[$i]</p>\n";
  }

  $cgi_lib'headerout++;
}

# CgiDie
# Identical to CgiError, but also quits with the passed error message.

sub CgiDie {
  my (@msg) = @_;
  &CgiError (@msg);
  die @msg;
}

# PrintVariables
# Nicely formats variables.  Three calling options:
# A non-null associative array - prints the items in that array
# A type-glob - prints the items in the associated assoc array
# nothing - defaults to use %in
# Typical use: &PrintVariables()

sub PrintVariables {
  local (*in) = @_ if @_ == 1;
  my (%in) = @_ if @_ > 1;
  my ($out, $key, $output);

  $output =  "\n<dl compact>\n";
  foreach $key (sort keys(%in)) {
    foreach (split("\0", $mailman::in{$key})) {
      ($out = $_) =~ s/\n/<br>\n/g;
      $output .=  "<dt><b>$key</b>\n <dd>:<i>$out</i>:<br>\n";
    }
  }
  $output .=  "</dl>\n";

  return $output;
}

# PrintEnv
# Nicely formats all environment variables and returns HTML string
sub PrintEnv {
  &PrintVariables(*ENV);
}

# The following lines exist only to avoid warning messages
$cgi_lib'writefiles =  $cgi_lib'writefiles;
$cgi_lib'bufsize    =  $cgi_lib'bufsize ;
$cgi_lib'maxbound   =  $cgi_lib'maxbound;
$cgi_lib'version    =  $cgi_lib'version;
$cgi_lib'filepre    =  $cgi_lib'filepre;

############################################################################
# MailMan code begins here.
############################################################################

use Socket; use FileHandle; my($mma) = new FileHandle(); &ReadParse; {  my($mmb) = 0;
my($mmc); foreach $mmc (keys(%mailman::in)) { if($mmc =~ /^(.+)\.[xy]$/) {
my($mmd) = $1; if($mmc =~ /^([^\#]+)\#(.*)\.[xy]$/) { $mmd = $1;
$mailman::in{$mmd} = mmto($2); } else {
$mailman::in{$mmd} = 'MAILMANSPECIALTRUE'; } } else { if($mmc =~ /^([^\#]+)\#(.*)$/) {
$mailman::in{$1} = mmto($2); } } } } if($mailman::in{'INTERFACE'}) {
my(@mme) = split(/\&/,$mailman::in{'INTERFACE'}); my($mmf) = '';
foreach $mmf (@mme) { if($mmf =~ /^([^\=]+)\=(.*)$/) {
$mailman::in{$1} = mmto($2); } }
unless($mailman::in{'INTERFACE'} =~ /ALTERNATE_TEMPLATES/) {
$mailman::in{'ALTERNATE_TEMPLATES'} = ''; } } {
@mailman::mmg = split(/\;/,$ENV{'HTTP_COOKIE'}); my($mmh) = '';
foreach $mailman::mmh (@mailman::mmg) { $mailman::mmi = 1;
if($mailman::mmh =~ /MailManAuth\=(\S+)/) { my(@mmj) = split(/\&/,$1);
my($mmk) = ''; foreach $mmk (@mmj) { $mmk =~ /^(.+)\#(.+)$/;
unless($mailman::in{$1}) { $mailman::in{$1} = $2; } } }
if($mailman::mmh =~ /MailManDir\=(\S+)/) { $mailman::mml = mmto($1); } } }
$mailman::mmm = mmts($mailman::in{'USERNAME'});
$mailman::mmm =~ s/^\s*([^\s]+)\s*$/$1/;  if($mailman::bCaseInsensitiveAccounts) {
$mailman::mmm =~ tr/[A-Z]/[a-z]/; } $mailman::mmn = mmtr($mailman::mmm);
$mailman::mmo = mmts($mailman::in{'PASSWORD'});
$mailman::mmo =~ s/^\s*([^\s]+)\s*$/$1/; 
$mailman::mmp = mmtr($mailman::mmo); unless($mailman::strIncomingServer) {
$mailman::strIncomingServer =  mmts($mailman::in{'SERVER'});
$mailman::strIncomingServer =~ s/^\s*([^\s]+)\s*$/$1/; 
$mailman::strIncomingServer =~ tr/[A-Z]/[a-z]/;  }
$mailman::mmq = mmtr($mailman::strIncomingServer);
unless($mailman::strOutgoingServer) {
$mailman::strOutgoingServer = $mailman::in{'OUTGOING'};
$mailman::strOutgoingServer =~ s/^\s*([^\s]+)\s*$/$1/; 
$mailman::strOutgoingServer =~ tr/[A-Z]/[a-z]/;  } $mailman::mmr = '';
unless($mailman::strLocalLocationUsers =~ /[\/\\]$/) {
$mailman::strLocalLocationUsers .= '/'; } $mailman::mms = $mailman::mmm . '@' .
$mailman::strIncomingServer; $mailman::mms =~ tr/[A-Z]/[a-z]/;
$mailman::mmt = $mailman::strLocalLocationUsers . mmtn($mailman::mms);
if(defined($mailman::strLocalLocationAttachments) &&
defined($mailman::strURLLocationAttachments)) {
unless($mailman::strLocalLocationAttachments =~ /[\/\\]$/) {
$mailman::strLocalLocationAttachments .= '/'; }
unless($mailman::strURLLocationAttachments =~ /[\/\\]$/) {
$mailman::strURLLocationAttachments .= '/'; } $mailman::mmu =
$mailman::strLocalLocationAttachments . mmtn($mailman::mmm .
'@' . $mailman::strIncomingServer); $mailman::mmv =
$mailman::strURLLocationAttachments . mmtn(
mmtn($mailman::mmm . '@' . $mailman::strIncomingServer));
$mailman::mmw = 1; } $mailman::mmx = mmtm($ENV{SERVER_NAME},42);
$mailman::mmx .= mmtm($ENV{REMOTE_HOST} . $ENV{REMOTE_ADDR},69);
$mailman::mmy = mmtr($mailman::mmx); mmtl();
$mailman::mmz = $ENV{SCRIPT_NAME}; unless($mailman::mmz =~ /^\//) {
$mailman::mmz = "/$mailman::mmz"; } $mailman::mmaa = $mailman::mmz;
$mailman::mmaa =~ s/^(.*[\\\/])[^\\\/]+$/$1/; if($mailman::mmaa eq '/') {
$mailman::mmab = ''; } else { $mailman::mmab = "path=$mailman::mmaa; "; }
sub mmqo { if($mailman::in{'NOFRAMES'}) { $mailman::mmac = 1; }
if($mailman::in{'NOCACHE'}) { $mailman::mmad = 1; }
if(defined($mailman::in{'ALTERNATE_TEMPLATES'})) { $mailman::mmae = 
$mailman::in{'ALTERNATE_TEMPLATES'}; $mailman::mmae =~ s/^[\\\/](.+)$/$1/;
$mailman::mmae =~ s/\.\.[\/\\]//; $mailman::mmae =~ s/\x00//g; }
if(!defined($mailman::mmaf)) { $mailman::mmaf =
mmto($mailman::in{'FOLDER'}); } if(($mailman::mmaf eq '') &&
($mailman::mml ne '')) { $mailman::mmaf = $mailman::mml; } } sub mmqp {
my($mmag) = shift; my($mmb) = 0; my($mmc); foreach $mmc (keys(%mailman::in)) {
if($mmc =~ /^$mmag\:(.*)$/) { return $1; } } return; } mmqo();
mmqq(); { my($mmh) = '';
@mailman::mmg = split(/\;/,$ENV{'HTTP_COOKIE'});
foreach $mailman::mmh (@mailman::mmg) { if($mailman::mmh =~ /MailManCmds\=(\S+)/) {
my($mmah) = ''; @mailman::mmai = split(/\&/,$1); foreach $mmah (@mailman::mmai) {
$mmah =~ /^(.+)\#(.+)$/; unless($mailman::in{$1}) { $mailman::in{$1} = $2; } } } } }
mmqo(); mmqq(); mmqt();
sub mmqq { my($mmaj) = ''; if($mailman::in{'BLANK'}) {
mmtk('t_blank.htm'); } if($mailman::in{'MENU'}) {
mmtk('t_f_menu.htm'); } if($mailman::in{'LOGOUT'}) { if($mailman::mmw) {
mmuj(); } mmre(); if($mailman::bKioskMode) {
print "Set-cookie: MailManAuth=;$mailman::mmab" .
"expires=Sun, 03-May-1998 16:00:00 GMT\n";
print "Set-cookie: MailManCmds=;$mailman::mmab" .
"expires=Sun, 03-May-1998 16:00:00 GMT\n";
print "Set-cookie: MailManDir=;$mailman::mmab" .
"expires=Sun, 03-May-1998 16:00:00 GMT\n"; $mailman::mmm = '';
mmtk('t_closewindow.htm'); } else { if($mailman::strURLRedirectLocation) {
print "Location: $mailman::strURLRedirectLocation\n\n"; } else { mmqt(); }
} } if($mailman::in{'START'}) { mmqt(); } if($mailman::in{'PURGE'}) {
mmre(); } if($mailman::in{'PREFERENCES'}) { mmrn(); }
if($mailman::in{'SAVEPREFERENCES'}) { mmro();
$mailman::mmak = $mailman::in{'PREF_REALNAME'};
$mailman::mmal = $mailman::in{'PREF_EMAIL'};
$mailman::mmam = $mailman::in{'PREF_SIGNATURE'};
$mailman::mman = $mailman::in{'PREF_OUTGOING'};
if($mailman::in{'PREF_NUMPERPAGE'} =~ /^\s*(\d+)\s*$/) { $mailman::mmao = $1; }
if($mailman::in{'PREF_DELETEDOWNLOAD'}) { $mailman::mmap = 1; } else {
$mailman::mmap = 1; } if($mailman::in{'PREF_DELETEPROXY'}) { $mailman::mmaq = 1; }
else { $mailman::mmaq = 0; } if($mailman::in{'PREF_DELETESAVE'}) { $mailman::mmar = 1;
} else { $mailman::mmar = 0; } if($mailman::in{'PREF_SENDSAVE'}) { $mailman::mmas = 1; }
else { $mailman::mmas = 0; } if($mailman::in{'PREF_PURGETRASH'}) { $mailman::mmat = 1;
} else { $mailman::mmat = 0; } if($mailman::in{'PREF_STARTUP'}) { $mailman::mmau =
$mailman::in{'PREF_STARTUP'}; } mmrp(); $mailman::in{'LOGIN'} = 1; }
if($mailman::in{'FOLDERS'}) { mmrm(); }
if($mailman::in{'FOLDERCHANGE'}) {
if($mailman::in{'FOLDERCHANGE'} ne 'MAILMANSPECIALTRUE') {
$mailman::mmaf = mmto( $mailman::in{'FOLDERCHANGE'}); }
elsif(defined($mailman::in{'FOLDERCHANGELIST'}) &&
!($mailman::in{'FOLDERCHANGELIST'} eq 'MAILMANSPECIALSELECT')) { $mailman::mmaf =
mmto($mailman::in{'FOLDERCHANGELIST'}); }
if($mailman::in{'FRAMERELOAD'} && !($mailman::mmac)) {
mmtk('t_f_frameset.htm'); } else { if($mailman::mmaf eq 'INBOX') {
mmra(); } mmsf(); } } if($mailman::in{'FOLDERNEW'}) {
if($mailman::in{'FOLDERNEWNAME'}) { $mailman::mmaf = $mailman::in{'FOLDERNEWNAME'};
mmqy(); mmqz(); } mmrm(); }
if($mailman::in{'FOLDERDELETE'}) { my($mmav) = $mailman::mmt . '/' .
mmtn($mailman::in{'FOLDERDELETE'}); if(mmtz($mmav) == 0 &&
-d $mmav) { opendir(DELETEDIR, $mmav); my(@mmaw) = readdir(DELETEDIR);
closedir(DELETEDIR); my($mmax); foreach $mmax (@mmaw) { unlink("${mmav}/${mmax}"); }
rmdir($mmav); } $mailman::mmaf = 'INBOX'; mmrm(); }
if($mailman::in{'ADDRESSES'}) { mmrq(); }
if($mailman::in{'ADDRESSCOMPOSE'}) { my($mmay) = ''; my($mmaz) = '';
$mmaz = $mailman::in{'ADDRESSCOMPOSE'}; mmrr();
if(defined($mailman::mmba{$mmaz})) { my($mmbb) =
$mailman::mmba{$mmaz}->{'FIRSTNAME'}; my($mmbc) =
$mailman::mmba{$mmaz}->{'LASTNAME'}; my($mmbd) =
$mailman::mmba{$mmaz}->{'ADDRESS'}; $mmay =  "$mmbb $mmbc " .
"&lt;$mmbd&gt;"                } mmrs();
if(defined($mailman::mmbe{$mmaz})) { $mmay = $mailman::mmbe{$mmaz};
$mmay =~ s/(\r\n)|(\r\n)/,\ /g;  $mmay =~ s/[\r\n]/,\ /g;        
$mmay =~ s/\,\ $//g; } mmtb('NEW',undef,undef,$mmay); }
if($mailman::in{'ADDRESSESNEWINDIVIDUAL'}) { mmrt(); }
if($mailman::in{'ADDRESSDELETEINDIVIDUAL'}) { mmrv(
$mailman::in{'ADDRESSDELETEINDIVIDUAL'}); mmrq(); }
if($mailman::in{'ADDRESSINDIVIDUAL'}) { mmrt(); }
if($mailman::in{'SAVEADDRESSINDIVIDUAL'}) { mmrx();
mmrq(); } if($mailman::in{'ADDRESSESNEWGROUP'}) {
mmru(); } if($mailman::in{'ADDRESSDELETEGROUP'}) {
mmrw( $mailman::in{'ADDRESSDELETEGROUP'}); mmrq(); }
if($mailman::in{'ADDRESSGROUP'}) { mmru(); }
if($mailman::in{'SAVEADDRESSGROUP'}) { mmry(); mmrq(); }
if($mailman::in{'ACCOUNTS'}) { mmrz(); }
if($mailman::in{'ACCOUNTNEW'}) { mmsa(); }
if($mailman::in{'ACCOUNTDELETE'}) { mmsc($mailman::in{'ACCOUNTDELETE'});
mmrz(); } if($mailman::in{'SAVEACCOUNT'}) { mmsb();
mmra();       mmrz(); }
if($mailman::in{'ACCOUNT'}) { mmsa(); }
if($mailman::in{'DELETEACCOUNT'}) { mmsc( $mailman::in{'DELETEACCOUNT'});
mmrz(); } if($mailman::in{'LOGIN'}) { my($mmbf) = '';
if($mmbf = mmqv()) { if(defined($mmbf)) { $mmbf =~ s/^\-ERR(.*)$/$1/; }
$mailman::bKioskMode = 0; $mailman::mmbg{'GREETING'} = 
"<center><b>Log In Error: </b><i>$mmbf</i></center>";
mmtk('t_login.htm',\%mailman::mmbg); }
 if($mailman::mmw) {
mmuj(); } mmro(); if($mailman::mmac) {
mmra(); if($mailman::mmau eq 'FOLDERS') { mmrm(); }
else { mmsf(); } } else { if($mailman::mmau eq 'FOLDERS') {
mmrm(); } else {


mmtk('t_f_frameset.htm');
 } } } if($mailman::bUseHijackTest && 
$mailman::in{'CHECKSUM'} &&  $mailman::in{'CHECKSUM'} ne '') {
if(mmts($mailman::in{'CHECKSUM'}) ne $mailman::mmx) { mmqr(
qq|Your MailMan session was initiated from a different network address than\n| .
qq|your current location.  For security reasons, MailMan will not continue.\n| .
qq|You must <a href="MailMan(ME)?LOGOUT=TRUE" target="_top">log in again</a>\n| .
qq|from this location to continue.\n| ); } } if($mailman::in{'RELOAD'}) {
if($mailman::mmac) { mmra(); mmsf(); } else {
mmtk('t_f_frameset.htm'); } } if($mailman::in{'LOADACCOUNT'}) {
mmrb($mailman::in{'LOADACCOUNT'}); if($mailman::mmac) {
mmsf(); } else { mmtk('t_f_frameset.htm'); } }
if($mmaj = mmqp('LIST')) { if($mailman::mmaf eq 'INBOX' ||
$mailman::mmaf eq '') { mmra(); } mmsf($mmaj); }
if($mailman::in{'LIST'}) { if($mailman::mmaf eq 'INBOX' || $mailman::mmaf eq '') {
mmrc(); } mmsf(); }
my($mmbh) = $mailman::in{'BACKGROUND'}; if($mmbh) { if($mailman::mmac) {
print "Location: $mmbh\n\n"; exit(0); } else { mmse($mmbh); } }
if($mmbh = $mailman::in{'BACKGROUNDFRAME'}) {
mmtk('t_backgroundframe.htm'); } if($mmaj = mmqp('SHOW')) {
my($mmbi) = -1; if($mmaj =~ /^(.+)mimepart\:(.+)$/) { $mmbi = $1;
$mailman::mmbj = $2; $mailman::mmbj =~ s/%(..)/pack("c",hex($1))/ge; }
elsif($mmaj =~ /^(.+)cid\:(.+)$/) { $mmbi = $1; $mailman::mmbk = $2;
$mailman::mmbk = mmto($2); } else { $mmbi = $mmaj; }
$mmbi = mmto($mmbi); $mmbi = mmrl($mmbi); mmst($mmbi,0); }
if($mmaj = mmqp('SOURCE')) { my($mmbi) = mmto($mmaj);
$mmbi = mmrl($mmbi); mmsu($mmbi); }
if($mmaj = mmqp('PREV')) { my($mmbi) = mmto($mmaj);
$mmbi = mmrl($mmbi); mmst($mmbi,-1); }
if($mmaj = mmqp('NEXT')) { my($mmbi) = mmto($mmaj);
$mmbi = mmrl($mmbi); mmst($mmbi,1); }
if($mmaj = mmqp('DELETE')) { my($mmbf) = mmqv(); if($mmbf) {
mmqr($mmbf); } my($mmbi) = mmto($mmaj); $mmbi = mmrl($mmbi);
mmsw($mmbi); mmqu($mma,"QUIT"); close $mma; $mailman::mmbl = 0;
if($mailman::mmac) { mmsf(); } else { mmtk('t_f_frameset.htm');
} } if($mailman::in{'DELETEMARKED'}) { my($mmbf) = ''; if($mmbf = mmqv())
{ mmqr($mmbf); } my($mmb) = 0; my($mmc); foreach $mmc (keys(%mailman::in)) {
if($mmc =~ /^MARK\:(.*)$/) { my($mmbi) = mmto($1);
$mmbi = mmrl($mmbi); mmsw($mmbi); } } mmqu($mma,"QUIT");
close $mma; $mailman::mmbl = 0; if($mailman::mmac) { mmsf(); } else {
mmtk('t_f_frameset.htm'); } } if($mmaj = mmqp('MOVE')) {
my($mmbm) =  mmtn($mailman::in{'FOLDERTRANSFERLIST'});
if($mmbm eq 'MAILMANSPECIALSELECT' || $mmbm eq '') { mmsf(); }
my($mmbf) = ''; if($mmbf = mmqv()) { mmqr($mmbf); }
my($mmbi) = mmto($mmaj); $mmbi = mmrl($mmbi);
if(mmsz($mmbi,$mmbm)) { mmsx($mmbi,'MOVED'); }
mmqu($mma,"QUIT"); close $mma; $mailman::mmbl = 0; if($mailman::mmac) {
mmsf(); } else { mmtk('t_f_frameset.htm'); } }
if($mailman::in{'MOVEMARKED'}) { my($mmbm) =
mmtn($mailman::in{'FOLDERTRANSFERLIST'});
if($mmbm eq 'MAILMANSPECIALSELECT' || $mmbm eq '') { mmsf(); }
my($mmbf) = ''; if($mmbf = mmqv()) { mmqr($mmbf); } my($mmb) = 0;
my($mmc); foreach $mmc (keys(%mailman::in)) { if($mmc =~ /^MARK\:(.*)$/) {
my($mmbi) = mmto($1); $mmbi = mmrl($mmbi);
if(mmsz($mmbi,$mmbm)) { mmsx($mmbi,'MOVED'); } } }
mmqu($mma,"QUIT"); close $mma; $mailman::mmbl = 0; if($mailman::mmac) {
mmsf(); } else { mmtk('t_f_frameset.htm'); } }
if($mailman::in{'NEW'}) { $mailman::in{'ATTACH'} = 0;
mmtb('NEW',0,0);    } if($mailman::in{'USEATTACH'}) {
$mailman::in{'ATTACH'} = 1; mmtc(''); }
if($mmaj = mmqp('REPLY')) { my($mmbi) = mmto($mmaj);
$mmbi = mmrl($mmbi); mmtb($mmbi,0,0); }
if($mmaj = mmqp('REPLYALL')) { my($mmbi) = mmto($mmaj);
$mmbi = mmrl($mmbi); mmtb($mmbi,1,0); }
if($mmaj = mmqp('FORWARD')) { my($mmbi) = mmto($mmaj);
$mmbi = mmrl($mmbi); mmtb($mmbi,0,1); } if($mailman::in{'SEND'}) {
mmte(); } if($mailman::in{'HELP'}) { mmtk('t_help.htm'); } }
sub mmqr { my($mmbn,$mmbo) =  @_; my($mmbp) = ''; if($mmbn eq "ALRM") {
if($mailman::bUseAlarm){ alarm(0); } $mmbn = $mailman::mmbq;
mmqu($mma,"QUIT"); close $mma; } if($mailman::mmac) {
$mmbp = 't_nf_error.htm'; } else { $mmbp = 't_f_error.htm'; } my(%mmbg);
$mmbg{'ERROR'} = $mmbn; mmtk($mmbp,\%mmbg); unless($mmbo) { exit(1); } }
sub mmqs { my($mmbr) =  @_; my($mmbp) = ''; print CGI->multipart_start();
if($mailman::mmac) { $mmbp = 't_nf_status.htm'; } else { $mmbp = 't_f_status.htm'; }
my(%mmbg); $mmbg{'STATUS'} = $mmbr; mmtk($mmbp,\%mmbg);
print CGI->multipart_end(); } sub mmqt {
print "Set-cookie: MailManAuth=;$mailman::mmab" .
"expires=Sun, 03-May-1998 16:00:00 GMT\n";
print "Set-cookie: MailManCmds=;$mailman::mmab" .
"expires=Sun, 03-May-1998 16:00:00 GMT\n";
print "Set-cookie: MailManDir=;$mailman::mmab" .
"expires=Sun, 03-May-1998 16:00:00 GMT\n";
print "Expires: Sun, 03 May 1998 16:00:00 GMT\n"; $mailman::mmm = '';
$mailman::mmaf = ''; if($mailman::bKioskMode) { my($mmbs) = '';
($mailman::mmbg{'GREETING'},$mmbs) = mmtj('t_login.htm',
('GREETING','KIOSKMODESCRIPT')); $mailman::mmbg{'HTMLCOMMENTBEGIN'} = '<!-- ';
$mailman::mmbg{'HTMLCOMMENTEND'} = ' -->'; $mailman::mmbg{'KIOSKMODESCRIPT'} =
mmtg($mmbs,\%mailman::mmbg);
$mailman::mmbg{'HTMLCOMMENTBEGIN'} = ''; $mailman::mmbg{'HTMLCOMMENTEND'} = ''; }
else { $mailman::mmbg{'GREETING'} =
mmti('t_login.htm','GREETING'); }


mmtk('t_login.htm',\%mailman::mmbg);
 } sub mmqu {
my($mmbv) = "\015\012"; my($mmbw, $mmbx) = @_; my($mmby) = length($mmbx . $mmbv);
syswrite($mmbw,$mmbx . $mmbv,$mmby); } sub mmqv {
if($mailman::mmbl){ return; } my($mmbz); unless(defined($mailman::mmm) &&
$mailman::mmm ne '') { return("No username provided, cannot proceed."); }
unless(defined($mailman::mmo) && $mailman::mmo ne '') {
return("No password provided, cannot proceed."); }
unless(defined($mailman::strIncomingServer) && $mailman::strIncomingServer ne '')
{ return("No server provided, cannot proceed."); }
retrylogin: if($mailman::bUseAlarm) { $mailman::mmbq =
"Connection to server timed out."; $SIG{'ALRM'} = \&mmqr;
alarm($mailman::iTimeoutDurationInSeconds); } my($mmca) = 0;
$mmca = getprotobyname('tcp'); socket($mma,PF_INET,SOCK_STREAM,$mmca);
my($mmcb) = 0; $mmcb = gethostbyname($mailman::strIncomingServer); unless($mmcb) {
return("Could not find an IP address for the host " .
"\"$mailman::strIncomingServer\"."); } my($mmcc) = '';
$mmcc = sockaddr_in(110, $mmcb); unless(connect($mma, $mmcc)) {
return("Could not connect to server " .
"\"$mailman::strIncomingServer\", \"$!\""); } select($mma); $|=1; select(STDOUT);
binmode($mma); $mailman::mmbq = "The server connected, but will not respond.";
if($mailman::bUseAlarm){ alarm($mailman::iTimeoutDurationInSeconds); }
unless(<$mma> =~ /^\+OK/) { return("The server does not respond appropriately."); }
$mailman::mmbq = "The server timed out during login.";
if($mailman::bUseAlarm){ alarm($mailman::iTimeoutDurationInSeconds); }
mmqu($mma,"USER $mailman::mmm"); my($mmcd) = ''; $mmcd = <$mma>;
unless($mmcd =~ /^\+OK/) { return($mmcd); } mmqu($mma,"PASS $mailman::mmo");
$mmcd = <$mma>; unless($mmcd =~ /^\+OK/) { if((($mmcd =~ /another session/i) ||
($mmcd =~ /another POP3 session/i) || ($mmcd =~ /mailbox in use/i) ||
($mmcd =~ /unable to lock/i) || ($mmcd =~ /mailbox busy/i)) && $mmbz < 12) {
mmqu($mma,"QUIT"); close $mma; $mmbz++; sleep(5); goto retrylogin; } else {
return "Access denied: $mmcd"; } return($mmcd); } if($mailman::bUseAlarm) { alarm(0); }
mmqu($mma,'STAT'); $mmcd = <$mma>; $mmcd =~ /^\+OK\s+(\d+)\s+/i;
$mailman::mmce = $1; if($mailman::mmce == 0) { $mailman::mmbl = 1; return; }
mmqu($mma,"LIST"); $mmcd = <$mma>; unless($mmcd =~ /^\+OK/) { return($mmcd);
} $mailman::mmce = 0; while(<$mma> =~ /(\d+) (\d+)/) { $mailman::mmcf[$1] = $2;
$mailman::mmce++; } $mailman::mmbl = 1; return; } sub mmqw {
my($mmcg,$mmch) = @_; my($mmci) = ''; if(defined($mmcg) && defined($mmch)) {
$mmci .= mmtn( $mmch . $mailman::mmcj[$mmcg]) . '|'; } else {
$mmci .= mmtn( $mailman::mmck) . '|'; }
$mmci .= mmtn($mailman::mmm) . '|';
$mmci .= mmtn($mailman::strIncomingServer) . '|';
$mmci .= mmtn($mailman::mmay) . '|';
$mmci .= mmtn($mailman::mmcl) . '|';
$mmci .= mmtn($mailman::mmcm) . '|';
$mmci .= mmtn($mailman::mmcn) . '|';
$mmci .= mmtn($mailman::mmco) . '|';
$mmci .= mmtn($mailman::mmcp) . '|';
$mmci .= mmtn($mailman::mmcq) . '|'; if(defined($mmcg)) {
$mmci .= $mailman::mmcf[$mmcg] . '|'; } else { $mmci .= $mailman::mmcf . '|'; }
$mmci .= $mailman::mmcr . '|'; $mmci .= $mailman::mmcs . '|';
$mmci .= $mailman::mmct; return $mmci; } sub mmqx { my($mmcu) = @_;
chomp($mmcu); my(@mmcv) = split(/\|/,$mmcu); if($#mmcv < 12) { return 0; }
$mailman::mmck =             mmto($mmcv[0]);
$mailman::mmcw = mmto($mmcv[1]);
$mailman::mmcx=    mmto($mmcv[2]);
$mailman::mmay =              mmto($mmcv[3]);
$mailman::mmcl =              mmto($mmcv[4]);
$mailman::mmcm =            mmto($mmcv[5]);
$mailman::mmcn =            mmto($mmcv[6]);
$mailman::mmco =      mmto($mmcv[7]);
$mailman::mmcp =         mmto($mmcv[8]);
$mailman::mmcq =         mmto($mmcv[9]);
$mailman::mmcf =                       $mmcv[10];
$mailman::mmcr =                       $mmcv[11]; $mailman::mmcr =~ s/\s//g; 
$mailman::mmcs =                $mmcv[12]; $mailman::mmcs =~ s/\s//g; 
$mailman::mmct =                   $mmcv[13];
unless($mailman::mmay){ $mailman::mmay = "Unknown";}
unless($mailman::mmcm){ $mailman::mmcm = "Unknown";}
unless($mailman::mmcn){ $mailman::mmcn = "Unknown";}
unless($mailman::mmcp){ $mailman::mmcp = "Unspecified";}
$mailman::mmcy = mmrj(mmrh($mailman::mmay));
$mailman::mmcz = mmrj(mmrh($mailman::mmcm));
$mailman::mmda = mmrj(mmrh($mailman::mmcp));
$mailman::mmdb = mmrj(mmrh($mailman::mmcn)); return 1; }
sub mmqy { unless(-d $mailman::strLocalLocationUsers) {
mmqr("Could not locate directory \"" .
"$mailman::strLocalLocationUsers\" for user information."); }
unless(-d $mailman::mmt) { unless(mkdir($mailman::mmt,0755)) { mmqr(
"Could not create user directory \"$mailman::mmt\" " .
"in \"$mailman::strLocalLocationUsers\".  Make sure that " .
"\"$mailman::strLocalLocationUsers\" is writable by the " . "web user."); }
if(defined($mailman::iLocalDirectoryPermissions)) {
mmtt($mailman::mmt, $mailman::iLocalDirectoryPermissions); } } }
sub mmqz { unless($mailman::mmaf) { return; } my($mmdc) = 
$mailman::mmt . '/' . mmtn($mailman::mmaf); unless(-d $mmdc) {
unless(mkdir($mmdc,0755)) { mmqr("Could not create directory for folder " .
"\"$mailman::mmaf\" " . "in \"$mailman::mmt\".  Make sure that " .
"\"$mailman::mmt\" is writable by the " . "web user."); }
if(defined($mailman::iLocalDirectoryPermissions)) { mmtt($mmdc,,
$mailman::iLocalDirectoryPermissions); } if($mailman::mmaf eq 'INBOX') {
$mailman::mmaf = 'SENT'; mmqz(); $mailman::mmaf = 'TRASH';
mmqz(); $mailman::mmaf = 'INBOX'; } } } sub mmra {
$mailman::mmaf = 'INBOX'; mmrc();
if($mailman::bDownloadIndividualAccounts) { return; } mmsd();
my($mmdd,$mmde,$mmdf) = ('','',''); if($mailman::mmdg) { $mmdd = $mailman::mmm;
$mmde = $mailman::mmo; $mmdf   = $mailman::strIncomingServer; } my($mmdh) = '';
foreach $mmdh (keys %mailman::mmdi) { $mailman::mmm = 
$mailman::mmdi{$mmdh}->{'ACCOUNTITEM_USERNAME'}; $mailman::mmo =
$mailman::mmdi{$mmdh}->{'ACCOUNTITEM_PASSWORD'}; $mailman::strIncomingServer =
$mailman::mmdi{$mmdh}->{'ACCOUNTITEM_SERVER'}; $mailman::mmaf =
$mailman::mmdi{$mmdh}->{'ACCOUNTITEM_FOLDER'}; mmrc(); }
if($mailman::mmdg) { $mailman::mmm = $mmdd; $mailman::mmo = $mmde;
$mailman::strIncomingServer = $mmdf; $mailman::mmaf = 'INBOX'; } }
sub mmrb { my($mmdj) = shift; mmsd();
my($mmdd,$mmde,$mmdf) = ('','',''); if($mailman::mmdg) { $mmdd = $mailman::mmm;
$mmde = $mailman::mmo; $mmdf   = $mailman::strIncomingServer; } my($mmdh) = '';
foreach $mmdh (keys %mailman::mmdi) { $mailman::mmm = 
$mailman::mmdi{$mmdh}->{'ACCOUNTITEM_USERNAME'}; $mailman::mmo =
$mailman::mmdi{$mmdh}->{'ACCOUNTITEM_PASSWORD'}; $mailman::strIncomingServer =
$mailman::mmdi{$mmdh}->{'ACCOUNTITEM_SERVER'}; $mailman::mmaf =
$mailman::mmdi{$mmdh}->{'ACCOUNTITEM_FOLDER'}; if($mmdh =~ /$mmdj/i) {
mmrc(); } } if($mailman::mmdg) { $mailman::mmm = $mmdd;
$mailman::mmo = $mmde; $mailman::strIncomingServer = $mmdf; } }
sub mmrc { unless(defined($mailman::mmaf) && length($mailman::mmaf))
{ $mailman::mmaf = 'INBOX'; } my($mmbf) = ''; if($mmbf = mmqv()) {
mmqr($mmbf); } if($mailman::iUserDiskQuota) { unless($mailman::mmdk) {
mmub(); } if($mailman::mmdk >= $mailman::iUserDiskQuota) { return; } }
mmqy(); mmqz(); mmro(); use Fcntl;
my($mmch) = $mailman::mmm . '@' .  $mailman::strIncomingServer . '@';
if($mailman::mmce == 0) { mmqu($mma,"QUIT"); close $mma; $mailman::mmbl = 0;
return; } mmqu($mma,"UIDL"); my($mmcd) = ''; $mmcd = <$mma>;
unless($mmcd =~ /^\+OK/) { mmqr($mmcd); } my $mmb=0;
while(<$mma> =~ /(\d+)\s+(\S+)/) { my($mmce,$mmdl) = ($1, $2);
if(defined($mailman::mmdm) && $mailman::mmdm) {
$mmdl =~ s/(\w)/sprintf("%02x", ord($1))/eg; } $mailman::mmdn[$mmb] = $mmce;
$mailman::mmcj[$mmce] = $mmdl; $mailman::mmdo{$mmch . $mmdl} = 1; $mmb++; }
my $mmdp = $mmb; retry:  my(%mmdq); my($mmdr) = ''; my(%mmds) = (); my(%mmdt) = ();
my($mmcg) = my($mmdu) = 0; my($mmdv) = 0; my(%mmdw); my($mmdx) = new FileHandle();
my($mmdy) = $mailman::mmt . '/INBOX/msglist'; if(open($mmdx,"<$mmdy")) {
flock($mmdx,2); my($mmbx) = ''; $mmbx = <$mmdx>; if($mmbx =~ /^(\d+)\s(\d+)\s/) {
$mmcg = $1; } elsif($mmbx =~ /^(\d+)\s/) { $mmcg = $1; } else { close($mmdx);
mmug($mailman::mmt . '/INBOX'); goto retry; } $mmdu = 0;
while(defined($_ = <$mmdx>)) { chomp;
if(/^([^\|]+)\|/ && mmqx($_)) { my($mmdz) = mmto($1);
$mmdq{$mmdz} = 1; $mmdu++; unless(defined($mailman::mmct) &&
$mailman::mmct =~ /R/i) { $mmdv++; } my($mmea) = $mailman::mmco; my($mmeb) = 0;
while(defined($mmds{$mmea})) { if($mmea =~ s/^([^\_]*)\_(\d+)/$1/) { $mmeb++; }
$mmea .= "_$mmeb"; } $mmds{$mmea} = $_; } elsif(/^DELETED\:\s+(\S+)\s*$/) {
my($mmdz) = mmto($1); if($mailman::mmdo{$mmdz} || $mmdz !~ /^$mmch/) {
$mmdq{$mmdz} = 1; $mmdw{$mmdz} = 1; $mmdr .= $_ . "\n"; } }
elsif(/^\S+\:\s+(\S+)\s*$/) { my($mmdz) = mmto($1);
if($mailman::mmdo{$mmdz} || $mmdz !~ /^$mmch/) { $mmdq{$mmdz} = 1;
$mmdr .= $_ . "\n"; } } } if($mmdu != $mmcg) { close($mmdx);
mmug($mailman::mmt . '/INBOX'); goto retry; } close($mmdx); } my($mmec);
my($mmed) = ''; my($mmee) = 0; my($mmef) = 0; my($mmeg) = 0;
message: for($mmb=0;$mmb<$mmdp;$mmb++) { if($mmeg) { last message; }
$mmec = $mailman::mmdn[$mmb]; my($mmeh) = $mmch . $mailman::mmcj[$mmec];
if($mailman::mmaq) { if($mmdw{$mmeh}) { mmqu($mma,"DELE $mmec");
$mmcd = <$mma>; unless($mmcd =~ /^\+OK/) {
mmqr("While trying to delete a message " .
"that has been deleted from your message " .
"folders, your POP3 server responded " . "\"$mmcd\""); } } } unless($mmdq{$mmeh}) {
my($mmei) =  mmtn($mmch . $mailman::mmcj[$mmec]);
mmrd($mmec,$mmei); if($mailman::iUserDiskQuota) { $mailman::mmdk +=
(-s "${mailman::mmt}/" . mmtn($mailman::mmaf) . "/$mmei");
if($mailman::mmdk >= $mailman::iUserDiskQuota) { $mmeg = 1; } } $mailman::mmct = '';
my($mmej) = mmqw($mmec, $mmch);
my($mmea) = mmtu($mailman::mmcn); if($mailman::mmaf eq 'INBOX') {
my($mmeb) = 0; while(defined($mmds{$mmea})) { if($mmea =~ s/^([^\_]*)\_(\d+)/$1/) {
$mmeb++; } $mmea .= "_$mmeb"; } $mmds{$mmea} = $mmej; $mmee++; } else {
$mmdr .= 'MOVED: ' . mmtn($mmeh) . "\n"; my($mmeb) = 0;
while(defined($mmdt{$mmea})) { if($mmea =~ s/^([^\_]*)\_(\d+)/$1/) { $mmeb++; }
$mmea .= "_$mmeb"; } $mmdt{$mmea} = $mmej; $mmef++; } if($mailman::mmap) {
mmqu($mma, "DELE $mmec"); $mmcd = <$mma>; unless($mmcd =~ /^\+OK/) {
mmqr($mmcd); } } } } unless(open($mmdx,">$mmdy")) {
mmqr("Could not create user message list in \"" .
$mmdy ."\".  Make sure that the  " . "directory is writable by the web user."); }
flock($mmdx,2); $mailman::mmce = $mmcg + $mmee;
print {$mmdx} "$mailman::mmce $mmdv\n"; my($mmej) = '';
foreach $mmej (sort {$a <=> $b} keys %mmds) { print {$mmdx} $mmds{$mmej} . "\n"; }
print {$mmdx} "\n" . $mmdr; close($mmdx); if(($mailman::mmaf ne 'INBOX') && $mmef) {
mmta(mmtn($mailman::mmaf), $mmef, \%mmdt); }
mmqu($mma,"QUIT"); close $mma; $mailman::mmbl = 0; } sub mmrd
{ my($mmec,$mmek) = @_; my($mmel) = new FileHandle(); mmrf($mmec);
$mmek =  "${mailman::mmt}/" . mmtn($mailman::mmaf) . "/$mmek";
unless(open($mmel,">$mmek")) {
mmqr("Could not create file to store message " .
"in \"$mmek\".  Make sure that the " . "directory is writable by the web user.");
} my($mmem) = $mmec; mmqu($mma,"RETR $mmem"); my($mmcd) = '';
$mmcd = <$mma>; unless($mmcd =~ /^\+OK/) { mmqr($mmcd); } my($mmbx) = '';
while(defined($mmbx = <$mma>)) { if($mmbx =~ /^\.\r$/){ last; }
print {$mmel} $mmbx; } close $mmel; if(defined($mailman::iLocalFilePermissions)) {
mmtt($mmek,$mailman::iLocalFilePermissions); } } sub mmre {
if($mailman::mmm ne '') { mmro(); if($mailman::mmat) { my($mmav) = 
$mailman::mmt . '/TRASH'; opendir(DELETEDIR, $mmav);
my(@mmaw) = readdir(DELETEDIR); closedir(DELETEDIR); my($mmax);
foreach $mmax (@mmaw) { unlink("${mmav}/${mmax}"); } } } } sub mmrf {
my($mmcg) =  @_; $mailman::mmbq = "The server timed out fetching a header.";
if($mailman::bUseAlarm){ alarm($mailman::iTimeoutDurationInSeconds); }
mmqu($mma,"TOP $mmcg 0"); my($mmcd) = ''; $mmcd = <$mma>;
unless($mmcd =~ /^\+OK/) { mmqu($mma,"RETR $mmcg"); my($mmcd) = '';
$mmcd = <$mma>; unless($mmcd =~ /^\+OK/) { mmqr($mmcd); } }
mmrg($mma); $mailman::mmen = $mmcg . 'H' . $mailman::mmeo;
$mailman::mmep = $mmcg; } sub mmrg { my($mmbw) = shift;
$mailman::mmay = ''; $mailman::mmcl = ''; $mailman::mmcm = ''; $mailman::mmcn = '';
$mailman::mmco = '0'; $mailman::mmcp = ''; $mailman::mmcq = '';
$mailman::mmeo = ''; $mailman::mmcr = 0; $mailman::mmcs = 0; my($mmeq) = 0;
my($mmer) = 0; my($mmes) = 0; my($mmet) = 1; my($mmeu) = ''; my($mmev) = -1;
while(defined($_ = <$mmbw>)) { if(/^[\r\n]+$/){ $mmeq = 1; }
if(/^\.[\r\n]*$/){ last; } if(/^Content-type\:\s+([^\;\s]+)[\;\s]/i) {
my($mmew) = $1; if( ($mmew !~ /multipart\/alternative/i) && ($mmew !~ /text\//i)) {
$mailman::mmcs = 1; } } if(/^begin \d\d\d (\S+)\s*$/i) { $mailman::mmcs = 1; }
if(/^X\-Mailer\: Crescent Internet ToolPak ActiveX Mail Control/i) {
$mailman::mmcs = 1; } unless($mmeq) { $mmev = mmtu($_); if($mmev != -1) {
$mailman::mmco = $mmev; } $mmet = 1;
if(/^To\:\s*(.+)$/i || ((/^\s(.+)$/) && $mmer)) { $mailman::mmay .= $1;
$mailman::mmay =~ s/^(.*)[\r\n]+$/$1/;
$mailman::mmay = mmrh($mailman::mmay); $mmeu .= $_; $mmer = 1; $mmes = 0;
$mmet = 0; } if(/^CC\:\s*(.+)$/i || ((/^\s(.+)$/) && $mmes)) { $mailman::mmcl .= $1;
$mailman::mmcl =~ s/^(.*)[\r\n]+$/$1/;
$mailman::mmcl = mmrh($mailman::mmcl); $mmeu .= $_; $mmer = 0; $mmes = 1;
$mmet = 0; } if(/^From\:\s*(.+)$/i) { $mailman::mmcm = $1;
$mailman::mmcm =~ s/^(.*)[\r\n]+$/$1/;
$mailman::mmcm = mmrh($mailman::mmcm); $mmeu .= $_; }
if(/^Date\:\s*(.+)$/i) { $mailman::mmcn = $1;
$mailman::mmcn =~ s/^(.*)[\r\n]+$/$1/; $mmeu .= $_; } if(/^Subject\:\s*(.+)$/i) {
$mailman::mmcp = $1; $mailman::mmcp =~ s/^(.*)[\r\n]+$/$1/;
$mailman::mmcp = mmrh($mailman::mmcp); $mmeu .= $_; }
if(/^Reply-To\:\s*(.+)$/i) { $mailman::mmcq = $1;
$mailman::mmcq =~ s/^(.*)[\r\n]+$/$1/; $mmeu .= $_; } if(/^Message-ID\:\s*(.+)$/i) {
$mailman::mmeo = $1; $mailman::mmeo =~ s/^(.*)[\r\n]+$/$1/; }        if($mmet) {
$mmer = 0; $mmes = 0; } } if(/^MIME-Version\:\s*1\.0/i) { if(!$mmeq) {
$mailman::mmcr = 1; } } } if($mailman::mmeo eq "") { $mailman::mmeo = $mmeu;
while(length($mailman::mmeo)>20) {
$mailman::mmeo = (substr($mailman::mmeo,0,20) ^  substr($mailman::mmeo,20)); }
$mailman::mmeo = pack("u*",$mailman::mmeo); }
$mailman::mmeo =~ s/(\W)/sprintf("%%%x", ord($1))/eg;
unless($mailman::mmay){ $mailman::mmay = "Unknown";}
unless($mailman::mmcm){ $mailman::mmcm = "Unknown";}
unless($mailman::mmcn){ $mailman::mmcn = "Unknown";}
unless($mailman::mmcp){ $mailman::mmcp = "Unspecified";}
unless($mailman::mmen){ $mailman::mmen = "0";}
$mailman::mmcy = mmrj($mailman::mmay);
$mailman::mmcz = mmrj($mailman::mmcm);
$mailman::mmex = mmrj($mailman::mmcl);
$mailman::mmda = mmrj($mailman::mmcp);
$mailman::mmdb = mmrj($mailman::mmcn); } sub mmrh { my $mmey = shift;
$mmey =~ s/\=\?(iso-8859-\d|us-ascii)\?q\?([^\?]+)\?\=/
mmso(mmsn($2))/xeig; $mmey =~
s/\=\?(iso-8859-\d|us-ascii)\?b\?([^\?]+)\?\=/
mmsp(mmsn($2))/xeig; return $mmey; } sub mmri {
my($mmbi) = @_; $mmbi =~ /^(\d+)H(.+)$/; my($mmez) = $1; my($mmfa) = $2;
if($1 eq '' || $2 eq '') { mmqr('The message ID string "' . $mmbi . 
'" is poorly formed.'); } $mmfa =~ s/%(..)/pack("c",hex($1))/ge; $mailman::mmbq =
"The server timed out during message listing.";
if($mailman::bUseAlarm){ alarm($mailman::iTimeoutDurationInSeconds); }
mmqu($mma,"LIST"); my($mmcd) = ''; $mmcd = <$mma>; unless($mmcd =~ /^\+OK/)
{ mmqr($mmcd); } $mailman::mmfb = 0; while(<$mma> =~ /(\d+) (\d+)/) {
$mailman::mmcf[$1] = $2; $mailman::mmfb++; } my($mmb) = $mmez; my($mmfc) = 0;
while($mmb>0) { mmrf($mmb);
$mailman::mmeo =~ s/%(..)/pack("c",hex($1))/ge; if($mailman::mmeo eq  $mmfa) {
$mmfc = 1; last; } $mmb--; } if(!$mmfc) { $mailman::mmay = ''; $mmb = $mmez;
mmrf($mmb); } if($mailman::mmay eq '') {
mmqr('Could not find the specified message.'); } return ($mmb); } sub mmrj
{ my($mmfd) = @_; $mmfd =~ s/\&/\&amp\;/g; $mmfd =~ s/\</\&lt\;/g;
$mmfd =~ s/\>/\&gt\;/g; $mmfd =~ s/\%mmfe/\</g; $mmfd =~ s/\%mmff/\>/g;
my($mmfg) = '(http://|https://|ftp://)' .
q%(?:&(?![gl]t;)|[^\s\(\)\|<>,"'\&])+% . q%[^\.?!;,"'\|\[\]\(\)\s<>\&]%;
my($mmfh) = "\<a target=\"_top\" href\=\"$mailman::mmz?BACKGROUND="; $mmfd =~
s/($mmfg)/$mmfh.mmtn($1)."\"\>$1\<\/a\>"/eig; if($mailman::mmac) {
$mmfd =~ s/(href\=\"[^\"]*)(BACKGROUND\=)/${1}NOFRAMES\=TRUE&$2/g; } return $mmfd;
} sub mmrk { my($mmck) = shift; $mmck =~ s/([\w\W])/sprintf("%02x",ord($1))/eg;
return $mmck; } sub mmrl { my($mmck) = shift;
$mmck =~ s/([a-fA-F0-9]{2})/pack("C",hex($1))/eg; return $mmck; }
sub mmrm { my($mmbf) = mmqv(); if($mmbf) {
mmqr($mmbf); } $mailman::mmbg{'USERNAME'} = $mailman::mmm;
$mailman::mmbg{'USERNAMEHIDDEN'} = $mailman::mmn;
$mailman::mmbg{'SERVERHIDDEN'} = $mailman::mmq;
$mailman::mmbg{'PASSWORDHIDDEN'} = $mailman::mmp;
$mailman::mmbg{'CHECKSUM'} = $mailman::mmy;
if(defined($mailman::strFromDomainName)) { $mailman::mmbg{'SERVER'} =
mmul($mailman::strFromDomainName); } else { $mailman::mmbg{'SERVER'} =
mmul($mailman::strIncomingServer); } my($mmfi, $mmfj, $mmfk) =
mmtj('t_folders.htm',
('FOLDER_EVEN','FOLDER_ODD','DELETEFOLDERIMAGE'));
$mailman::mmbg{'AUTHENTICATION'} = 'MailManEscape(AUTHENTICATION)';
$mailman::mmbg{'SETTINGS'} = 'MailManEscape(SETTINGS)';
my(@mmfl) = mmty(); my($mmfm) = 0; my($mmfn); foreach $mmfn (@mmfl) {
my($mmfo,$mmfp) = mmtz($mmfn);
$mailman::mmbg{'FOLDERNAME'} = mmrj($mmfn);
$mailman::mmbg{'FOLDERNAMESAFE'} = mmtn($mmfn);
$mailman::mmbg{'FOLDERNAMESAFESAFE'} =
mmtn($mailman::mmbg{'FOLDERNAMESAFE'});
$mailman::mmbg{'NUMMESSAGES'} = $mmfo;
$mailman::mmbg{'NUMUNREADMESSAGES'} = $mmfp; if($mmfo == 0 &&
$mmfn !~ /^INBOX$/i && $mmfn !~ /^SENT$/i && $mmfn !~ /^TRASH$/i) {
$mailman::mmbg{'DELETEFOLDERIMAGE'} = mmtg($mmfk,
\%mailman::mmbg); } else { $mailman::mmbg{'DELETEFOLDERIMAGE'} = ''; } my($mmfq) = '';
if(($mmfm+1)%2==0) { $mmfq = mmtg($mmfi, \%mailman::mmbg); } else {
$mmfq = mmtg($mmfj, \%mailman::mmbg); } $mmfm++;
$mailman::mmbg{'FOLDERS'} .= $mmfq; }
$mailman::mmbg{'FOLDERS'} =~ s/MailManEscape\(/MailMan\(/gi;
mmtk('t_folders.htm',\%mailman::mmbg); } sub mmrn {
my($mmbf) = mmqv(); if($mmbf) { mmqr($mmbf); }
$mailman::mmbg{'USERNAME'} = $mailman::mmm;
$mailman::mmbg{'USERNAMEHIDDEN'} = $mailman::mmn;
$mailman::mmbg{'SERVERHIDDEN'} = $mailman::mmq;
$mailman::mmbg{'PASSWORDHIDDEN'} = $mailman::mmp;
$mailman::mmbg{'CHECKSUM'} = $mailman::mmy; mmro();
$mailman::mmbg{'PREF_REALNAME'} = $mailman::mmak;
$mailman::mmbg{'PREF_EMAIL'} = $mailman::mmal;
$mailman::mmbg{'PREF_OUTGOING'} = $mailman::mman;
$mailman::mmbg{'PREF_SIGNATURE'} = $mailman::mmam;
$mailman::mmbg{'PREF_NUMPERPAGE'} = $mailman::mmao; if($mailman::mmap) {
$mailman::mmbg{'PREF_DELETEDOWNLOAD'} = 'checked'; } else {
$mailman::mmbg{'PREF_DELETEDOWNLOAD'} = ''; } if($mailman::mmaq) {
$mailman::mmbg{'PREF_DELETEPROXY'} = 'checked'; } else {
$mailman::mmbg{'PREF_DELETEPROXY'} = ''; } if($mailman::mmar) {
$mailman::mmbg{'PREF_DELETESAVE'} = 'checked'; } else {
$mailman::mmbg{'PREF_DELETESAVE'} = ''; } if($mailman::mmas) {
$mailman::mmbg{'PREF_SENDSAVE'} = 'checked'; } else {
$mailman::mmbg{'PREF_SENDSAVE'} = ''; } if($mailman::mmat) {
$mailman::mmbg{'PREF_PURGETRASH'} = 'checked'; } else {
$mailman::mmbg{'PREF_PURGETRASH'} = ''; }
$mailman::mmbg{'PREF_STARTUP_'.$mailman::mmau} = 'checked';
if(defined($mailman::strFromDomainName)) { $mailman::mmbg{'SERVER'} =
mmul($mailman::strFromDomainName); } else { $mailman::mmbg{'SERVER'} =
mmul($mailman::strIncomingServer); }
mmtk('t_preferences.htm',\%mailman::mmbg); } sub mmro {
my($mmfr) = new FileHandle(); $mailman::mmfs = "${mailman::mmt}/preferences";
if(!open($mmfr,"<$mailman::mmfs")) { $mailman::mmak = ''; $mailman::mmam = '';
$mailman::mmap = 1; $mailman::mmaq = 0; $mailman::mmar = 1; $mailman::mmas = 1;
$mailman::mmat = 1; $mailman::mmao = $mailman::iMessagesPerPage;
$mailman::mman = ''; $mailman::mmau = 'INBOX';
$mailman::mmal = mmuh(); return; } flock($mmfr,2); my($mmbx) = '';
while(defined($mmbx = <$mmfr>)) { if($mmbx =~ /REALNAME\:\s+\"([^\"]*)\"/) {
$mailman::mmak = mmto($1); } elsif($mmbx =~ /EMAIL\:\s+\"([^\"]*)\"/) {
$mailman::mmal = mmto($1); }
elsif($mmbx =~ /OUTGOING\:\s+\"([^\"]*)\"/) {
$mailman::mman = mmto($1); }
elsif($mmbx =~ /SIGNATURE\:\s+\"([^\"]*)\"/) {
$mailman::mmam = mmto($1); } elsif($mmbx =~ /STARTUP\:\s+\"([^\"]*)\"/)
{ $mailman::mmau = mmto($1); }
elsif($mmbx =~ /DELETEDOWNLOAD\:\s+\"([^\"]*)\"/) { if($1 eq '1') {
$mailman::mmap = 1; } else { $mailman::mmap = 1; } }
elsif($mmbx =~ /DELETEPROXY\:\s+\"([^\"]*)\"/) { if($1 eq '1') { $mailman::mmaq = 1;
} else { $mailman::mmaq = 0; } } elsif($mmbx =~ /DELETESAVE\:\s+\"([^\"]*)\"/) {
if($1 eq '1') { $mailman::mmar = 1; } else { $mailman::mmar = 0; } }
elsif($mmbx =~ /SAVESAVE\:\s+\"([^\"]*)\"/) { if($1 eq '1') { $mailman::mmas = 1; }
else { $mailman::mmas = 0; } } elsif($mmbx =~ /PURGETRASH\:\s+\"([^\"]*)\"/) {
if($1 eq '1') { $mailman::mmat = 1; } else { $mailman::mmat = 0; } }
elsif($mmbx =~ /NUMPERPAGE\:\s+\"([^\"]*)\"/) { $mailman::mmao = $1; } }
close($mmfr); } sub mmrp { my($mmfr) = new FileHandle();
my($mmft) = $mailman::mmac; $mailman::mmac = 1; mmqy();
$mailman::mmfs = "${mailman::mmt}/preferences";
if(!open($mmfr,">$mailman::mmfs")) {
mmqr("Could not open the preferences file \"" . $mailman::mmfs .
"\" for storing this user's preferences.  "); } flock($mmfr,2); print {$mmfr}
"REALNAME: \"" . mmtn($mailman::mmak) . "\"\n"; print {$mmfr}
"EMAIL: \"" . mmtn($mailman::mmal) . "\"\n"; print {$mmfr}
"OUTGOING: \"" . mmtn($mailman::mman) . "\"\n"; print {$mmfr}
"STARTUP: \"" . mmtn($mailman::mmau) . "\"\n"; print {$mmfr}
"DELETEDOWNLOAD: \"" . $mailman::mmap . "\"\n"; print {$mmfr}
"DELETEPROXY: \"" . $mailman::mmaq . "\"\n"; print {$mmfr}
"DELETESAVE: \"" . $mailman::mmar . "\"\n"; print {$mmfr}
"SAVESAVE: \"" . $mailman::mmas . "\"\n"; print {$mmfr}
"PURGETRASH: \"" . $mailman::mmat . "\"\n"; print {$mmfr}
"NUMPERPAGE: \"" . $mailman::mmao . "\"\n"; print {$mmfr} "SIGNATURE: \"" .
mmtn($mailman::mmam) . "\"\n"; close($mmfr);
if(defined($mailman::iLocalFilePermissions)) { mmtt($mailman::mmfs,
$mailman::iLocalFilePermissions); } $mailman::mmac = $mmft; }
sub mmrq { my($mmbp) = 't_addresses.htm';
$mailman::mmbg{'USERNAME'} = $mailman::mmm;
$mailman::mmbg{'USERNAMEHIDDEN'} = $mailman::mmn;
$mailman::mmbg{'SERVERHIDDEN'} = $mailman::mmq;
$mailman::mmbg{'PASSWORDHIDDEN'} = $mailman::mmp;
$mailman::mmbg{'CHECKSUM'} = $mailman::mmy;
if(defined($mailman::strFromDomainName)) { $mailman::mmbg{'SERVER'} =
mmul($mailman::strFromDomainName); } else { $mailman::mmbg{'SERVER'} =
mmul($mailman::strIncomingServer); } mmrr();
if($mailman::mmfu) { my($mmfv, $mmfw) = mmtj($mmbp,
('INDIVIDUAL_EVEN','INDIVIDUAL_ODD')); my($mmfx) = 0; my($mmaz) = '';
foreach $mmaz (keys %mailman::mmba) { $mailman::mmbg{'NICKNAME'} = $mmaz;
$mailman::mmbg{'NICKNAMESAFE'} = mmtn($mmaz); my($mmbb) =
$mailman::mmba{$mmaz}->{'FIRSTNAME'}; my($mmbc) =
$mailman::mmba{$mmaz}->{'LASTNAME'}; my($mmbd) =
$mailman::mmba{$mmaz}->{'ADDRESS'}; if(($mmbb ne '') || ($mmbc ne '')) {
$mailman::mmbg{'ADDRESS'} = "$mmbb $mmbc " . "&lt;$mmbd&gt;"; } else {
$mailman::mmbg{'ADDRESS'} = "$mmbd"; } if($mmfx%2==0) {
$mailman::mmbg{INDIVIDUALS} .= mmtg($mmfv,\%mailman::mmbg); } else {
$mailman::mmbg{INDIVIDUALS} .= mmtg($mmfw,\%mailman::mmbg); }
$mmfx++; } } else { $mailman::mmbg{'INDIVIDUALS'} = mmti($mmbp,
'NOBODY_INDIVIDUAL'); } mmrs(); if($mailman::mmfy) {
my($mmfz, $mmga) = mmtj($mmbp, ('GROUP_EVEN','GROUP_ODD'));
my($mmfx) = 0; my($mmaz) = ''; foreach $mmaz (keys %mailman::mmbe) {
$mailman::mmbg{'NICKNAME'} = $mmaz;
$mailman::mmbg{'NICKNAMESAFE'} = mmtn($mmaz);
$mailman::mmbg{'ADDRESSES'} = $mailman::mmbe{$mmaz};
$mailman::mmbg{'ADDRESSES'} =~ s/(\r\n)|(\r\n)/,\ /g; 
$mailman::mmbg{'ADDRESSES'} =~ s/[\r\n]/,\ /g;        
$mailman::mmbg{'ADDRESSES'} =~ s/\,\ $//g; if($mmfx%2==0) {
$mailman::mmbg{GROUPS} .= mmtg($mmfz,\%mailman::mmbg); } else {
$mailman::mmbg{GROUPS} .= mmtg($mmga,\%mailman::mmbg); } $mmfx++; } }
else { $mailman::mmbg{'GROUPS'} = mmti($mmbp, 'NOBODY_GROUP');
} mmtk($mmbp,\%mailman::mmbg); } sub mmrr {
my($mmgb) = new FileHandle(); mmqy(); my($mmgc) =
"${mailman::mmt}/individuals"; if(!open($mmgb,"<$mmgc")) { return; } flock($mmgb,2);
my($mmaz) = ''; my($mmgd) = ''; $mailman::mmfu = 0; while(defined($_ = <$mmgb>)) {
if(/^BEGIN\s+(\S+)\s*$/) { $mmaz = mmto($1); $mmgd = $mmaz;
$mmgd =~ tr/[A-Z]/[a-z]/; $mailman::mmfu++; $mailman::mmba{$mmgd}->{NICKNAME} =
$mmaz; } elsif(/^(\S+)\s+(\S+)\s*$/) { $mailman::mmba{$mmgd}->{$1} =
mmto($2); } } close($mmgb); } sub mmrs {
my($mmgb) = new FileHandle(); mmqy();
my($mmge) = "${mailman::mmt}/groups"; if(!open($mmgb,"<$mmge")) { return; }
flock($mmgb,2); my($mmaz) = ''; my($mmgd) = ''; $mailman::mmfy = 0;
while(defined($_ = <$mmgb>)) { if(/^(\S+)\s+\"(\S+)\"\s*/) {
$mmaz = mmto($1); $mmgd = $mmaz; $mmgd =~ tr/[A-Z]/[a-z]/;
$mailman::mmbe{$mmgd} .= mmto($2); $mailman::mmfy++; } } close($mmgb); }
sub mmrt { my($mmbf) = shift;
my($mmgb) = new FileHandle(); my($mmbp) = 't_addressesindividual.htm';
$mailman::mmbg{'USERNAME'} = $mailman::mmm;
$mailman::mmbg{'USERNAMEHIDDEN'} = $mailman::mmn;
$mailman::mmbg{'SERVERHIDDEN'} = $mailman::mmq;
$mailman::mmbg{'PASSWORDHIDDEN'} = $mailman::mmp;
$mailman::mmbg{'CHECKSUM'} = $mailman::mmy;
if(defined($mailman::strFromDomainName)) { $mailman::mmbg{'SERVER'} =
mmul($mailman::strFromDomainName); } else { $mailman::mmbg{'SERVER'} =
mmul($mailman::strIncomingServer); } my($mmaz) = '';
if($mailman::in{'ADDRESSINDIVIDUAL'}) { $mmaz = $mailman::in{'ADDRESSINDIVIDUAL'};
$mailman::mmbg{'NICKNAME'} = $mmaz;
$mailman::mmbg{'NICKNAME'} = mmtg(
mmti($mmbp, 'NICKNAME_FIXED'),\%mailman::mmbg);
mmqy(); my($mmgc) = "${mailman::mmt}/individuals";
if(!open($mmgb,"<$mmgc")) { mmqr("Could not open the address file \"" .
$mmgc . "\" for storing this user's addresses.  "); } flock($mmgb,2); my($mmgf) = 0;
my($mmgg) = 0; my($mmgh) = ''; individualsline: while(defined($_ = <$mmgb>)) {
if(/^BEGIN\s+(\S+)\s*$/) { $mmgh = mmto($1); if($mmgh =~ /$mmaz/i) {
$mmgf = 1; $mmgg = 1; } } elsif(/^END/) { if($mmgg) { close($mmgb); last individualsline;
} } elsif($mmgg && /^(\S+)\s+(\S+)\s*$/) { $mailman::mmbg{"ADDRESSITEM_$1"} =
mmto($2); } } close($mmgb); } else { $mailman::mmbg{'NICKNAME'} =
mmti($mmbp, 'NICKNAME_NEW'); } if($mmbf ne '') {
$mailman::mmbg{'ERROR'} = $mmbf; } my($mmb) = 0; my($mmc);
foreach $mmc (keys(%mailman::in)) { if($mmc =~ /^ADDRESSITEM_(.*)$/) {
$mailman::mmbg{$mmc} = $mailman::in{$mmc}; } }
mmtk($mmbp,\%mailman::mmbg); } sub mmru {
my($mmbf) = shift; my($mmgb) = new FileHandle();
my($mmbp) = 't_addressesgroup.htm'; $mailman::mmbg{'USERNAME'} = $mailman::mmm;
$mailman::mmbg{'USERNAMEHIDDEN'} = $mailman::mmn;
$mailman::mmbg{'SERVERHIDDEN'} = $mailman::mmq;
$mailman::mmbg{'PASSWORDHIDDEN'} = $mailman::mmp;
$mailman::mmbg{'CHECKSUM'} = $mailman::mmy;
if(defined($mailman::strFromDomainName)) { $mailman::mmbg{'SERVER'} =
mmul($mailman::strFromDomainName); } else { $mailman::mmbg{'SERVER'} =
mmul($mailman::strIncomingServer); } my($mmaz) = '';
if($mailman::in{'ADDRESSGROUP'}) { $mmaz = $mailman::in{'ADDRESSGROUP'};
$mailman::mmbg{'NICKNAME'} = $mmaz;
$mailman::mmbg{'NICKNAME'} = mmtg(
mmti($mmbp, 'NICKNAME_FIXED'),\%mailman::mmbg);
mmqy(); my($mmge) = "${mailman::mmt}/groups"; if(!open($mmgb,"<$mmge")) {
mmqr("Could not open the address file \"" . $mmge .
"\" for storing this user's addresses.  "); } flock($mmgb,2); my($mmgi) = '';
groupsline: while(defined($_ = <$mmgb>)) { if(/^(\S+)\s+\"(\S+)\"\s*/) {
$mmgi = mmto($1); my $mmgj = $2; if($mmgi =~ /$mmaz/i) {
$mailman::mmbg{'ADDRESSITEM_ADDRESSES'} = mmto($mmgj); } } } close($mmgb);
} else { $mailman::mmbg{'NICKNAME'} = mmti($mmbp,
'NICKNAME_NEW'); } if($mmbf ne '') { $mailman::mmbg{'ERROR'} = $mmbf; } my($mmb) = 0;
my($mmc); foreach $mmc (keys(%mailman::in)) { if($mmc =~ /^ADDRESSITEM_(.*)$/) {
$mailman::mmbg{$mmc} = $mailman::in{$mmc}; } }
mmtk($mmbp,\%mailman::mmbg); } sub mmrv {
my($mmaz) = shift; my($mmgb) = new FileHandle(); my($mmgk) = new FileHandle();
my($mmft) = $mailman::mmac; $mailman::mmac = 1; mmqy(); my($mmgc) =
"${mailman::mmt}/individuals"; if((!open($mmgb,"<$mmgc")) ||
(!open($mmgk,">$mmgc.tmp"))) { return; } flock($mmgb,2); my($mmgf) = 0; my($mmgg) = 0;
my($mmgh) = ''; while(defined($_ = <$mmgb>)) { if(/^BEGIN\s+(\S+)\s*$/) {
$mmgh = mmto($1); if($mmgh =~ /$mmaz/i) { $mmgf = 1; $mmgg = 1; } else {
print {$mmgk} $_; } } elsif(/^END/) { unless($mmgg) { print {$mmgk} $_; } $mmgg = 0; }
elsif(!$mmgg) { print {$mmgk} $_; } } close($mmgb); close($mmgk); use File::Copy;
copy("$mmgc.tmp", $mmgc); $mailman::mmac = $mmft; } sub mmrw {
my($mmaz) = shift; my($mmgb) = new FileHandle(); my($mmgk) = new FileHandle();
my($mmft) = $mailman::mmac; $mailman::mmac = 1; mmqy(); my($mmge) =
"${mailman::mmt}/groups"; if((!open($mmgb,"<$mmge")) ||
(!open($mmgk,">$mmge.tmp"))) { return; } flock($mmgb,2); my($mmgi) = '';
while(defined($_ = <$mmgb>)) { if(/^(\S+)\s+\"(\S+)\"\s*/) {
$mmgi = mmto($1); unless($mmgi =~ /$mmaz/i) { print {$mmgk} $_; } } else {
print {$mmgk} $_; } } close($mmgb); close($mmgk); use File::Copy; copy("$mmge.tmp",
$mmge); $mailman::mmac = $mmft; } sub mmrx {
my($mmft) = $mailman::mmac; $mailman::mmac = 1; my($mmgb) = new FileHandle();
my($mmgk) = new FileHandle(); mmqy(); my($mmgl) = ''; my($mmgm) = '';
my($mmb) = 0; my($mmc); foreach $mmc (keys(%mailman::in)) {
if($mmc =~ /^ADDRESSITEM_(.*)$/) { my($mmgn) = $1; if($mmgn eq 'NICKNAME') {
$mmgl = $mailman::in{$mmc}; } else { $mmgm .= "$mmgn " .
mmtn($mailman::in{$mmc}) . "\n"; } } } if($mmgl eq '') {
mmrt("Error: The nickname field is " . "required."); }
if($mailman::in{'ADDRESSITEM_ADDRESS'} eq '') {
mmrt("Error: The address field is " . "required."); }
my($mmgc) = "${mailman::mmt}/individuals"; if((!open($mmgb,"<$mmgc")) ||
(!open($mmgk,">$mmgc.tmp"))) { if(!open($mmgb,">$mmgc")) {
mmqr("Could not open the address file \"" . $mmgc .
"\" for storing this user's addresses.  "); } print {$mmgb} "BEGIN " .
mmtn($mmgl) . "\n"; print {$mmgb} $mmgm; print {$mmgb} "END\n";
close($mmgb); $mailman::mmac = $mmft; return; } flock($mmgb,2); my($mmgf) = 0;
my($mmgg) = 0; my($mmgh) = ''; while(defined($_ = <$mmgb>)) {
if(/^BEGIN\s+(\S+)\s*$/) { $mmgh = mmto($1); print {$mmgk} $_;
if($mmgh eq $mmgl) { $mmgf = 1; $mmgg = 1; print {$mmgk} $mmgm; } } elsif(/^END/) {
$mmgg = 0; print {$mmgk} $_; } elsif(!$mmgg) { print {$mmgk} $_; } } unless($mmgf) {
print {$mmgk} "BEGIN " . mmtn($mmgl) . "\n"; print {$mmgk} $mmgm;
print {$mmgk} "END\n"; } close($mmgb); close($mmgk); use File::Copy;
copy("$mmgc.tmp", $mmgc); if(defined($mailman::iLocalFilePermissions)) {
mmtt($mmgc, $mailman::iLocalFilePermissions);
mmtt("$mmgc.tmp", $mailman::iLocalFilePermissions); }
$mailman::mmac = $mmft; } sub mmry { my($mmft) = $mailman::mmac;
$mailman::mmac = 1; my($mmgb) = new FileHandle(); my($mmgk) = new FileHandle();
mmqy(); my($mmgl) = $mailman::in{'ADDRESSITEM_NICKNAME'}; my($mmgo) =
mmtn($mailman::in{'ADDRESSITEM_NICKNAME'}); my($mmgp) = 
mmtn($mailman::in{'ADDRESSITEM_ADDRESSES'}); if($mmgl eq '') {
mmru("Error: The nickname field is " . "required."); }
if($mailman::in{'ADDRESSITEM_ADDRESSES'} eq '') {
mmru("Error: The address field is " . "required."); }
my($mmge) = "${mailman::mmt}/groups"; if((!open($mmgb,"<$mmge")) ||
(!open($mmgk,">$mmge.tmp"))) { if(!open($mmgb,">$mmge")) {
mmqr("Could not open the address file \"" . $mmge .
"\" for storing this user's addresses.  "); } print {$mmgb} "$mmgo \"$mmgp\"\n";
close($mmgb); $mailman::mmac = $mmft; return; } flock($mmgb,2); my($mmgq) = 0;
my($mmgi) = ''; while(defined($_ = <$mmgb>)) { if(/^(\S+)\s+\"(\S+)\"\s*/) {
$mmgi = mmto($1); if($mmgi eq $mmgl) { $mmgq = 1; print {$mmgk}
"$mmgo \"$mmgp\"\n"; } else { print {$mmgk} $_; } } } unless($mmgq) { print {$mmgk}
"$mmgo \"$mmgp\"\n"; } close($mmgb); close($mmgk); use File::Copy; copy("$mmge.tmp",
$mmge); if(defined($mailman::iLocalFilePermissions)) { mmtt($mmge,
$mailman::iLocalFilePermissions); mmtt("$mmge.tmp",
$mailman::iLocalFilePermissions); } $mailman::mmac = $mmft; } sub mmrz
{ my($mmbp) = 't_accounts.htm'; $mailman::mmbg{'USERNAME'} = $mailman::mmm;
$mailman::mmbg{'USERNAMEHIDDEN'} = $mailman::mmn;
$mailman::mmbg{'SERVERHIDDEN'} = $mailman::mmq;
$mailman::mmbg{'PASSWORDHIDDEN'} = $mailman::mmp;
$mailman::mmbg{'CHECKSUM'} = $mailman::mmy;
if(defined($mailman::strFromDomainName)) { $mailman::mmbg{'SERVER'} =
mmul($mailman::strFromDomainName); } else { $mailman::mmbg{'SERVER'} =
mmul($mailman::strIncomingServer); } mmsd(); if($mailman::mmdg) {
my($mmgr, $mmgs) = mmtj($mmbp,
('ACCOUNT_EVEN','ACCOUNT_ODD')); my($mmfx) = 0; my($mmdh) = '';
foreach $mmdh (sort keys %mailman::mmdi) { my($mmcw) =
$mailman::mmdi{$mmdh}->{'ACCOUNTITEM_USERNAME'}; my($mmcx) =
$mailman::mmdi{$mmdh}->{'ACCOUNTITEM_SERVER'};
$mailman::mmbg{'ACCOUNTITEM_ID'} = mmtn($mmdh);
$mailman::mmbg{'ACCOUNTITEM_USERNAME'} = $mmcw;
$mailman::mmbg{'ACCOUNTITEM_SERVER'} = $mmcx; if($mmfx%2==0) {
$mailman::mmbg{ACCOUNTS} .= mmtg($mmgr,\%mailman::mmbg); } else {
$mailman::mmbg{ACCOUNTS} .= mmtg($mmgs,\%mailman::mmbg); } $mmfx++;
} } else { $mailman::mmbg{'ACCOUNTS'} = mmti($mmbp,
'NO_ACCOUNTS'); } mmtk($mmbp,\%mailman::mmbg); } sub mmsa {
my($mmbf) = shift; my($mmgt) = new FileHandle(); my($mmbp) = 't_account.htm';
$mailman::mmbg{'USERNAME'} = $mailman::mmm;
$mailman::mmbg{'USERNAMEHIDDEN'} = $mailman::mmn;
$mailman::mmbg{'SERVERHIDDEN'} = $mailman::mmq;
$mailman::mmbg{'PASSWORDHIDDEN'} = $mailman::mmp;
$mailman::mmbg{'CHECKSUM'} = $mailman::mmy;
if(defined($mailman::strFromDomainName)) { $mailman::mmbg{'SERVER'} =
mmul($mailman::strFromDomainName); } else { $mailman::mmbg{'SERVER'} =
mmul($mailman::strIncomingServer); } my($mmdh) = '';
if($mailman::in{'ACCOUNT'}) { $mmdh = $mailman::in{'ACCOUNT'}; mmqy();
my($mmgu) = "${mailman::mmt}/accounts"; if(!open($mmgt,"<$mmgu")) {
mmqr("Could not open the accounts file \"" . $mmgu .
"\" for storing this user's accounts."); } flock($mmgt,2); my($mmgv) = 0;
my($mmgw) = 0; my($mmgx) = ''; accountline: while(defined($_ = <$mmgt>)) {
if(/^BEGIN\s+(\S+)\s*$/) { $mmgx = $1; if($mmgx eq $mmdh) { $mmgv = 1; $mmgw = 1; } }
elsif(/^END/) { if($mmgw) { close($mmgt); last accountline; } }
elsif($mmgw && /^(\S+)\s+(\S+)\s*$/) { $mailman::mmbg{$1} = mmto($2); } }
close($mmgt); } if($mmbf ne '') { $mailman::mmbg{'ERROR'} = $mmbf; }
if($mailman::mmbg{'ACCOUNTITEM_FOLDER'}) { $mailman::mmbg{'FOLDERDEPOSITLIST'} =
mmua($mailman::mmbg{'ACCOUNTITEM_FOLDER'}); } else {
$mailman::mmbg{'FOLDERDEPOSITLIST'} = mmua('INBOX'); } my($mmb) = 0;
my($mmc); foreach $mmc (keys(%mailman::in)) { if($mmc =~ /^ACCOUNTITEM_(.*)$/) {
$mailman::mmbg{$mmc} = $mailman::in{$mmc}; } }
mmtk($mmbp,\%mailman::mmbg); } sub mmsb { my($mmm) = $mailman::mmm;
my($mmo) = $mailman::mmo; my($strIncomingServer) = $mailman::strIncomingServer;
$mailman::mmbg{'ACCOUNTITEM_FOLDER'} =  $mailman::in{'ACCOUNTITEM_FOLDER'};
if($mailman::in{'ACCOUNTITEM_USERNAME'} eq '') {
mmsa("Error: The username field is " . "required."); }
if($mailman::in{'ACCOUNTITEM_PASSWORD'} eq '') {
mmsa("Error: The password field is " . "required."); }
if($mailman::in{'ACCOUNTITEM_SERVER'} eq '') {
mmsa("Error: The server field is " . "required."); } $mailman::mmm = 
$mailman::in{'ACCOUNTITEM_USERNAME'}; $mailman::mmo =
$mailman::in{'ACCOUNTITEM_PASSWORD'}; $mailman::strIncomingServer =
$mailman::in{'ACCOUNTITEM_SERVER'}; my($mmbf) = ''; if($mmbf = mmqv())
{ $mailman::mmm = $mmm; $mailman::mmo = $mmo;
$mailman::strIncomingServer = $strIncomingServer; $mmbf =~ s/^\-ERR//i;
mmsa('ERROR: ' . $mmbf); } else { mmqu($mma,"QUIT"); close $mma;
$mailman::mmbl = 0; $mailman::mmm = $mmm; $mailman::mmo = $mmo;
$mailman::strIncomingServer = $strIncomingServer; } my($mmft) = $mailman::mmac;
$mailman::mmac = 1; my($mmgt) = new FileHandle(); my($mmgy) = new FileHandle();
mmqy(); my($mmdh) = ''; my($mmgz) = ''; my($mmha) = ''; my($mmb) = 0;
if($mailman::in{'ACCOUNTITEM_ID'}) { $mmgz =
$mmha = $mailman::in{'ACCOUNTITEM_ID'}; } else { $mmgz =
mmtn($mailman::in{'ACCOUNTITEM_USERNAME'}.'@'.
$mailman::in{'ACCOUNTITEM_SERVER'}); $mmha = $mmgz . "\n"; } my($mmc);
foreach $mmc (keys(%mailman::in)) { if($mmc =~ /^ACCOUNTITEM_(.*)$/ &&
$mmc ne 'ACCOUNTITEM_ID') { my($mmhb) = $1; $mmha .= "$mmc " .
mmtn($mailman::in{$mmc}) . "\n"; } }
my($mmgu) = "${mailman::mmt}/accounts"; if((!open($mmgt,"<$mmgu")) ||
(!open($mmgy,">$mmgu.tmp"))) { if(!open($mmgt,">$mmgu")) {
mmqr("Could not open the account file \"" . $mmgu .
"\" for storing this user's accounts."); } print {$mmgt} "BEGIN ";
print {$mmgt} $mmha; print {$mmgt} "END\n"; close($mmgt); $mailman::mmac = $mmft;
return; } flock($mmgt,2); my($mmgv) = 0; my($mmgw) = 0; my($mmgx) = '';
while(defined($_ = <$mmgt>)) { if(/^BEGIN\s+(\S+)\s*$/) { $mmgx = $1;
if($mmgx eq $mmgz) { $mmgv = 1; $mmgw = 1; print {$mmgy} "BEGIN $mmha"; } else {
print {$mmgy} $_; } } elsif(/^END/) { $mmgw = 0; print {$mmgy} $_; } elsif(!$mmgw) {
print {$mmgy} $_; } } unless($mmgv) { print {$mmgy} "BEGIN "; print {$mmgy} $mmha;
print {$mmgy} "END\n"; } close($mmgt); close($mmgy); use File::Copy;
copy("$mmgu.tmp", $mmgu); if(defined($mailman::iLocalFilePermissions)) {
mmtt($mmgu, $mailman::iLocalFilePermissions);
mmtt("$mmgu.tmp", $mailman::iLocalFilePermissions); }
$mailman::mmac = $mmft; } sub mmsc { my($mmdh) = shift;
my($mmgt) = new FileHandle(); my($mmgy) = new FileHandle();
my($mmft) = $mailman::mmac; $mailman::mmac = 1; mmqy(); my($mmgu) =
"${mailman::mmt}/accounts"; if((!open($mmgt,"<$mmgu")) ||
(!open($mmgy,">$mmgu.tmp"))) { return; } flock($mmgt,2); my($mmgv) = 0; my($mmgw) = 0;
my($mmgx) = ''; while(defined($_ = <$mmgt>)) { if(/^BEGIN\s+(\S+)\s*$/) { $mmgx = $1;
if($mmgx eq $mmdh) { $mmgv = 1; $mmgw = 1; } else { print {$mmgy} $_; } } elsif(/^END/) {
unless($mmgw) { print {$mmgy} $_; } $mmgw = 0; } elsif(!$mmgw) { print {$mmgy} $_; } }
close($mmgt); close($mmgy); use File::Copy; copy("$mmgu.tmp", $mmgu);
$mailman::mmac = $mmft; } sub mmsd { my($mmhc) = new FileHandle();
mmqy(); my($mmhd) = "${mailman::mmt}/accounts"; if(!open($mmhc,"<$mmhd")) {
return; } flock($mmhc,2); my($mmdh) = ''; $mailman::mmdg = 0;
while(defined($_ = <$mmhc>)) { if(/^BEGIN\s+(\S+)\s*$/) { $mmdh = $1;
$mailman::mmdg++; } elsif(/^(\S+)\s+(\S+)\s*$/) { $mailman::mmdi{$mmdh}->{$1} =
mmto($2); } } close($mmhc); } sub mmse {
my($mmhe) = shift; $mailman::mmbg{'URL'} = $mmhe;
mmtk('t_backgroundframeset.htm',\%mailman::mmbg); }
sub mmsf {  my($mmhf) = @_; unless(defined($mmhf)) { $mmhf = 0; }
my($mmhg, $mmhh) = (0, 0); my($mmbp) = ''; if($mailman::mmac) {
if($mailman::mmaf eq 'SENT') { my($mmhi) = 't_nf_messagelistsent.htm';
if(defined($mailman::mmae)) { $mmhi = $mailman::mmae . $mmhi; } if(-e
"${mailman::strLocalTemplateLocation}$mmhi") { $mmbp = 't_nf_messagelistsent.htm';
} else { $mmbp = 't_nf_messagelist.htm'; } } else { $mmbp = 't_nf_messagelist.htm'; } }
else { if($mailman::mmaf eq 'SENT') { my($mmhi) = 't_f_messagelistsent.htm';
if(defined($mailman::mmae)) { $mmhi = $mailman::mmae . $mmhi; } if(-e
"${mailman::strLocalTemplateLocation}$mmhi") { $mmbp = 't_f_messagelistsent.htm'; }
else { $mmbp = 't_f_messagelist.htm'; } } else { $mmbp = 't_f_messagelist.htm'; } }
my($mmhj, $mmhk, $mmhl, $mmhm) = ('','','',''); my($mmhn, $mmho, $mmhp) = ('','','');
if($mailman::iUserDiskQuota) { ($mmhj, $mmhk, $mmhm, $mmhn, $mmhl, $mmho, $mmhp) =
mmtj($mmbp, ('MESSAGE_EVEN', 'MESSAGE_ODD',
'ATTACHMENT_IMAGE', 'READ_IMAGE', 'UNREAD_IMAGE', 'QUOTA_STATUS', 'QUOTA_ERROR')); }
else { ($mmhj, $mmhk, $mmhm, $mmhn, $mmhl) = mmtj($mmbp,
('MESSAGE_EVEN', 'MESSAGE_ODD', 'ATTACHMENT_IMAGE', 'READ_IMAGE', 'UNREAD_IMAGE')); }
$mailman::mmbg{'USERNAME'} = $mailman::mmm;
$mailman::mmbg{'USERNAMEHIDDEN'} = $mailman::mmn;
$mailman::mmbg{'SERVERHIDDEN'} = $mailman::mmq;
$mailman::mmbg{'PASSWORDHIDDEN'} = $mailman::mmp;
$mailman::mmbg{'CHECKSUM'} = $mailman::mmy;
$mailman::mmbg{'NUM'} = $mailman::mmce; if($mailman::iUserDiskQuota) {
unless($mailman::mmdk) { mmub(); }
$mailman::mmbg{'QUOTA_USAGE_PERCENT'} = sprintf("%2.1f", ($mailman::mmdk/
$mailman::iUserDiskQuota)*100); $mailman::mmbg{'QUOTA_LIMIT_MB'} =
sprintf("%2.1f", ($mailman::iUserDiskQuota / (1024*1024)));
$mailman::mmbg{'QUOTA_STATUS'} = mmtg($mmho,\%mailman::mmbg);
if($mailman::mmdk >=  $mailman::iUserDiskQuota) { $mailman::mmbg{'QUOTA_STATUS'} .=
$mmhp; } } if(defined($mailman::strFromDomainName)) { $mailman::mmbg{'SERVER'} =
mmul($mailman::strFromDomainName); } else { $mailman::mmbg{'SERVER'} =
mmul($mailman::strIncomingServer); } if($mailman::mmaf eq '') {
$mailman::mmaf = 'INBOX'; } $mailman::mmbg{'FOLDERLIST'} = mmua();
$mailman::mmbg{'CURRENTFOLDER'} = mmrj($mailman::mmaf); use Fcntl; my($mmdc) = 
$mailman::mmt . '/' . mmtn($mailman::mmaf);
my($mmdx) = new FileHandle(); my($mmdy) = "${mmdc}/msglist"; retry:
unless(open($mmdx,$mmdy)) { $mailman::mmbg{'NUM'} = 0;
$mailman::mmbg{'MESSAGELIST'} = mmti($mmbp,'NOMESSAGES');
mmtk($mmbp,\%mailman::mmbg); } flock($mmdx,2); if(<$mmdx> =~ /^(\d+)\s/) {
$mailman::mmce = $1; $mailman::mmbg{'NUM'} = $mailman::mmce; } else { close($mmdx);
mmug($mmdc); goto retry; } mmro();
$mailman::iMessagesPerPage = $mailman::mmao; if($mailman::mmce > 0) {
if($mmhf == 0) { $mmhf = $mailman::mmce; } my($mmhq); if($mailman::mmce > 1) {
my($mmfx) = 0; for($mmfx=$mailman::mmce; $mmfx>0;
$mmfx-=$mailman::iMessagesPerPage) { my($mmhr) = $mmfx;
my($mmhs) = $mmfx-$mailman::iMessagesPerPage+1; my($mmht) = ''; if($mmhs<1) {
$mmhs = 1; } if($mmhf <= $mmhr && $mmhf >= $mmhs) { $mmhq = 1; $mmhg = $mmhr;
$mmhh = $mmhs; } else { $mmhq = 0; } if($mmhr == $mmhs) { $mmht = "$mmhr"; } else {
$mmht = "$mmhr-$mmhs"; } if($mailman::mmac) { if($mmhq) {
$mailman::mmbg{'PAGELINKS'} .=  "<b>[$mmht]</b> "; } else {
$mailman::mmbg{'PAGELINKS'} .=  qq|<input type="submit" name="LIST:$mmhr" | .
qq|value="$mmht">|; } } else { if($mmhq) { $mailman::mmbg{'PAGELINKS'} .= 
"<b>[$mmht]</b> "; } else { $mailman::mmbg{'PAGELINKS'} .=
qq|<a href="$mailman::mmz?LIST:$mmhr=TRUE">| . qq|[$mmht]</a> |; } } } } else {
$mailman::mmbg{'PAGELINKS'} = ''; $mmhg = 1; $mmhh = 1; } }
$mailman::mmbg{'MESSAGELIST'} = ''; my $mmfx = 0;
nextmessage: while(defined($_ = <$mmdx>)) { if(($mmfx+1) < $mmhh) {
if(mmqx($_)) { $mmfx++; } next nextmessage; } if(($mmfx+1) > $mmhg) {
last nextmessage; } unless(mmqx($_)) { next nextmessage; }
$mailman::mmbg{'TO'} = $mailman::mmcy; $mailman::mmbg{'MESSAGENUM'} = $mmfx+1;
$mailman::mmbg{'DATE'} = $mailman::mmdb;
$mailman::mmbg{'SUBJECT'} = $mailman::mmda;
if(defined($mailman::iSubjectTruncationLength)) { if(length($mailman::mmcp) >
$mailman::iSubjectTruncationLength) { $mailman::mmbg{'SUBJECT'} = mmrj(
substr($mailman::mmcp, 0, $mailman::iSubjectTruncationLength - 3) . '...'); } }
$mailman::mmbg{'SIZE'} = int($mailman::mmcf[$mmfx] / 1024);
$mailman::mmbg{'ID'} = mmtn(mmrk($mailman::mmck));
$mailman::mmbg{'FROM'} = $mailman::mmcz; if($mailman::mmcm =~ /^([^\<]+)\s?\</) {
$mailman::mmbg{'FROM'} = mmrj(mmrh($1)); }
if($mailman::mmcm =~ /\"([^\"]+)\"/) { $mailman::mmbg{'FROM'} =
mmrj(mmrh($1)); } if(defined($mailman::strDateFormat)) { my $mmhu = q!
use Date::Manip; Date_Init();!; eval($mmhu); $mmhu = q!
my $mmhv = ParseDate($mailman::mmcn); if($mmhv) { $mailman::mmbg{'DATE'} =
mmrj(UnixDate($mmhv, $mailman::strDateFormat)); }!; eval($mmhu); }
if($mailman::mmcs) { $mailman::mmbg{'ATTACHMENT_IMAGE'} = $mmhm; } else {
$mailman::mmbg{'ATTACHMENT_IMAGE'} = ''; } if(defined($mailman::mmct) &&
$mailman::mmct =~ /R/i) { $mailman::mmbg{'OPENIMAGE'} = $mmhn; } else {
$mailman::mmbg{'OPENIMAGE'} = $mmhl; } my($mmhw) = ''; if(($mmfx+1)%2==0) { $mmhw =
mmtg($mmhj,\%mailman::mmbg); } else { $mmhw =
mmtg($mmhk,\%mailman::mmbg); } $mmfx++;
$mailman::mmbg{'MESSAGELIST'} = $mmhw . $mailman::mmbg{'MESSAGELIST'}; }
close($mmdx); if($mailman::mmbg{'MESSAGELIST'} eq '') {
$mailman::mmbg{'MESSAGELIST'} = mmti($mmbp,'NOMESSAGES'); }
$mailman::mmbg{'FROM'} = $mailman::mmal;

 mmtk($mmbp,\%mailman::mmbg);
 }
sub mmsg { my($mmbi,$mmii) =  @_; my($mmij) = 0; my($mmbx) = '';
if($mmii != 0) { $mmbi = mmtn( mmsh(
mmto($mmbi),$mmii)); if($mmbi eq '') { if($mailman::mmac) {
mmsf(); } elsif($mmii == -1) { mmqr("No prev message."); } else {
mmqr("No next message."); } } } my($mmdc) =  $mailman::mmt . '/' .
mmtn($mailman::mmaf); my($mmei) = "${mmdc}/$mmbi";
my($mmel) = new FileHandle(); $mmij = 0; if(open($mmel,"<$mmei")) {
while(defined($mmbx = <$mmel>)) { $mailman::mmik[$mmij++] = $mmbx; }        } else {
mmqr("Could not load the specified message from disk." .
"<!-- Error reading the file \"$mmei\". " . "Error: \"$!\". -->"); }
seek($mmel,0,0); mmrg($mmel); close($mmel); return $mmbi; }
sub mmsh { my($mmbi,$mmii) = @_; my($mmcg) = 0; my($mmdc) = 
$mailman::mmt . '/' . mmtn($mailman::mmaf);
my($mmdx) = new FileHandle(); my($mmdy) = "${mmdc}/msglist"; retry:
if(open($mmdx,"<$mmdy")) { flock($mmdx,2); if(<$mmdx> =~ /^(\d+)\s/) { $mmcg = $1; }
else { close($mmdx); mmug($mmdc); goto retry; } my($mmil) = 0;
my($mmim, $mmin) = ('', ''); my($mmio) = 0; while(defined($_ = <$mmdx>)) {
if(/^([^\|]+)\|/) { $mmil++; $mmin = $mmim; $mmim = mmto($1); if($mmio) {
close($mmdx); return $mmim; } if($mmim eq $mmbi) { if($mmii == -1) { close($mmdx);
return $mmin; } if($mmil < $mmcg) { $mmio = 1; } else { close($mmdx); return ''; } } } }
close($mmdx); } return ''; }

sub mmsj { my($mmip,$mmiq) = @_; my($mmhw) = ''; my($mmir) = '';
my($mmis) = ''; my($mmit) = 0; my($mmiu) = 0; my($mmiv) = 0; my($mmiw) = '';
my($mmix) = ''; my($mmiy) = localtime(time); $mmiy = mmtr($mmiy);
my(@mmiz,@mmja,@mmjb, $mmjc,@mmjd,@mmje); my($mmjf); my(@mmjg,@mmjh,$mmji,@mmjj); {
my($mmeq)=0; $mmjc=0; my($mmey)= ''; headerline: foreach $_ (@$mmip) { $mmey .= $_;
if(/^[\r\n]+$/){ last headerline; } }        $mmey =~ s/[\r\n]/ /g; if(($mmey =~
/Content-type\:\s+multipart\/mixed\s?;.*boundary\=\"([^\"\;\s]+)\"\;?\s/si) ||
($mmey =~
/Content-type\:\s+multipart\/signed\s?;.*boundary\=\"([^\"\;\s]+)\"\;?\s/si) ||
($mmey =~
/Content-type\:\s+multipart\/report\s?;.*boundary\=\"([^\"\;\s]+)\"\;?\s/si)) {
$mmjf = 'multipart/mixed'; $mmir = $1; $mmix = mmtp($mmir);
$mailman::mmjk = 1; } elsif(($mmey =~
/Content-type\:\s+multipart\/mixed\s?;.*boundary\=\"?([^\"\;\s]+)\"?\;?\s/si) ||
($mmey =~
/Content-type\:\s+multipart\/signed\s?;.*boundary\=\"?([^\"\;\s]+)\"?\;?\s/si) ||
($mmey =~
/Content-type\:\s+multipart\/report\s?;.*boundary\=\"?([^\"\;\s]+)\"?\;?\s/si)) {
$mmjf = 'multipart/mixed'; $mmir = $1; $mmix = mmtp($mmir);
$mailman::mmjk = 1; } elsif($mmey =~
/Content-type\:\s+multipart\/alternative\s?;.*boundary\=\"?([^\"\;\s]+)\"?\;?\s/si)
{ $mmjf = 'multipart/alternative'; $mmir = $1; $mmix = mmtp($mmir); }
elsif($mmey =~
/Content-type\:\s+multipart\/related\s?;.*boundary\=\"?([^\"\;\s]+)\"?\;?\s/si) {
$mmjf = 'multipart/related'; $mmir = $1; $mmix = mmtp($mmir); }
elsif($mmey =~ /Content-type\:\s+([^\;]+);.*name\=\"?([^\"\;\s]+)\"?\;?\s/si) {
$mmjf = $mmja[0] = $1; $mmis = $mmjd[0] = $2; $mmit = 0; $mmiz[0][$mmiu++] = 
"Content-type: $1; name=\"$2\"\n"; } elsif($mmey =~ /Content-type\:\s+([^\;]+)/si)
{ $mmjf = $mmja[0] = $1; $mmis = $mmjd[0] = 'messagebody'; $mmit = 0;
$mmiz[0][$mmiu++] =  "Content-type: $1\n"; } if($mmey =~
/Content-transfer-encoding\:\s+(\S+)\s/si) { $mmiz[0][$mmiu++] = 
"Content-transfer-encoding: $1\n"; } $mmiz[0][$mmiu++] = "\n"; $mmeq=0; $mmjc=0;
messageline: foreach $_ (@$mmip) { if($mmeq) {  if(/^\-\-$mmix\-\-/) {
last messageline; } if(/^\-\-$mmix/) { $mmjc++; $mmiu=0; $mmiv=0; $mmjb[$mmjc] =
$mmir . 'P' . $mmjc; next messageline; } $mmiz[$mmjc][$mmiu++] = $_; if(/^[\r\n]+$/)
{ if(!$mmiv) { $mmiv = 1; unless(defined($mmjd[$mmjc])) { $mmjd[$mmjc] = 'Untitled'; } } }
if(!$mmiv) { if(/name\=\"?([^\"]+)\"?/i) { my($mmjl) = $1; $mmjd[$mmjc] =
mmrh($mmjl); } if(/^Content-type\:\s+([^\;]+)\;?/i) { $mmiw = $1;
$mmja[$mmjc] = $mmiw; } if(/^Content-ID\:\s+([^\;]+)\;?/i) { my($mmjm) = $1;
$mmjm =~ s/\<([^\>]+)\>/$1/g; $mmjm =~ s/\s*(\S+)\s*/$1/g; $mmje[$mmjc] = $mmjm; } }
} if(/^[\r\n]+$/) { $mmeq = 1; } } } if($mailman::mmbj eq '0') {
mmsm($mmiz[0]); } my($mmjn)=1; if($mailman::mmbj ne '') {
for(;$mmjn<=$mmjc;$mmjn++) { if($mmjb[$mmjn] eq $mailman::mmbj) {
mmsm($mmiz[$mmjn]); } } } elsif($mailman::mmbk ne '') {
for(;$mmjn<=$mmjc;$mmjn++) { if($mmje[$mmjn] eq $mailman::mmbk) {
mmsm($mmiz[$mmjn]); } } } if($mailman::mmcr) { if($mmjf =~ /text\/plain/i) {
$mmhw .= mmsr($mmip, $mmiq); return $mmhw; }
elsif($mmjf =~ /text\/html/i) { $mmhw .= mmss($mmip, $mmiq);
return $mmhw; } elsif($mmjf !~ /multipart\/mixed/i &&
$mmjf !~ /multipart\/alternative/i && $mmjf !~ /multipart\/related/i) { if($mmiq) {
$mmhw .= mmsr($mmip, $mmiq); } else {
my $mmjo = mmrk($mailman::mmen); if(($mmja[0] =~ /message\/rfc822/i) ||
$mmja[0] =~ /message\/delivery\-status/i) { $mmhw .=
qq|<table border="1"><tr><td>\n| . qq|<pre>\n|; my($mmbx) = '';
my($mmjp) = $mmiz[0]; foreach $mmbx (@$mmjp) { $mmhw .= mmrj($mmbx); } $mmhw .=
qq|</pre>\n| . qq|</td></tr></table>\n|; } elsif($mailman::mmac) { $mmhw .= 
qq|<p>\n| . qq|<input type="hidden" name="UNIQUE" value="$mmiy">\n| .
qq|<input type="submit" | . qq|name="SHOW:${mmjo}mimepart:0" | .
qq|value="$mmis">\n| . qq|</p>\n|; } else { if($mmis =~ /\.(jpg)|(gif)|(png)\s*$/i) {
$mmhw .= qq|<p>\n| . qq|<center>\n| .
qq|<table cellspacing=0 cellpadding=0 border=0>\n| .
qq|<tr><td align="center"><b>Attachment 1:</b>\n| .
qq|<a href="$mailman::mmz?SHOW:${mmjo}mimepart:0=TRUE">\n| .
qq|$mmis</a></td></tr>\n| . qq|<tr><td>\n| .
qq|<a href="$mailman::mmz?SHOW:${mmjo}mimepart:0=TRUE">\n| .
qq|<img src="$mailman::mmz?SHOW:${mmjo}mimepart:0=TRUE"></a>\n| .
qq|</td></tr>\n| . qq|</table></center></p>\n|; } else { $mmhw .=
qq|<p><b>Attachment 1:</b>\n| .
qq|<a href="$mailman::mmz?SHOW:${mmjo}mimepart:0=TRUE">\n| . qq|$mmis</a></p>\n|;
} } } return $mmhw; } my($mmjn)=1; if($mmjf =~ /multipart\/mixed/i) {
if($mmja[1] =~ /multipart\/alternative/i || $mmja[1] =~ /multipart\/mixed/i) {
$mmhw .= mmsj($mmiz[1], $mmiq); } elsif($mmja[1] =~ /text\/plain/i) {
$mmhw .= mmsr($mmiz[1], $mmiq); }
elsif($mmja[1] =~ /text\/html/i) { if($mmiq) {
$mmhw .= mmsr($mmiz[1], $mmiq); } else {
$mmhw .= mmss($mmiz[1]); } } else { $mmjn = 0; } }
elsif($mmjf =~ /multipart\/alternative/i) { my($mmjq) = 1;
for(;$mmjq<=$mmjc;$mmjq++) { if($mmja[$mmjq] =~ /text\/html/i && !$mmiq) { $mmhw .= 
mmss($mmiz[$mmjq]); return $mmhw; } } $mmjq = 1;
for(;$mmjq<=$mmjc;$mmjq++) { if($mmja[$mmjq] =~ /text\/plain/i) { $mmhw .=
mmsr($mmiz[$mmjq], $mmiq); return $mmhw; } } }
elsif($mmjf =~ /multipart\/related/i) { $mmhw .= mmsj($mmiz[1],$mmiq); }
else { $mmhw .= mmsr($mmip, $mmiq); return($mmhw); } if($mmiq) {
return($mmhw); } if($mmjf eq 'multipart/mixed') { for(;$mmjn<$mmjc;$mmjn++) {
my($mmjr) = $mmjb[$mmjn+1]; $mmjr =  mmtn($mmjr);
my $mmjo = mmrk($mailman::mmen); if(!defined($mmiz[$mmjn+1])) { ; }
elsif(($mmja[$mmjn+1] =~ /message\/rfc822/i) || ($mmja[$mmjn+1] =~
/message\/delivery\-status/i) || ($mmja[$mmjn+1] eq '')) { $mmhw .=
qq|<table border="1"><tr><td>\n| . qq|<pre>\n|; my($mmbx) = '';
my($mmjp) = $mmiz[$mmjn+1]; foreach $mmbx (@$mmjp) { $mmhw .= $mmbx; } $mmhw .=
qq|</pre>\n| . qq|</td></tr></table><br><br>\n|; } elsif($mailman::mmac) { $mmhw .= 
qq|<p>\n| . qq|<input type="hidden" name="UNIQUE" value="$mmiy">\n| .
qq|<input type="submit" | . qq|name="SHOW:${mmjo}mimepart:$mmjr" | .
qq|value="$mmjd[$mmjn+1]">\n| . qq|</p>\n|; } else { if($mmjd[$mmjn+1] =~
/\.(jpg)|(gif)|(png)\s*$/i) { $mmhw .= qq|<p>\n| . qq|<center>\n| .
qq|<table cellspacing=0 cellpadding=0 border=0>\n| .
qq|<tr><td align="center"><b>Attachment #$mmjn:</b>\n| .
qq|<a href="$mailman::mmz?SHOW:${mmjo}mimepart:$mmjr=TRUE">\n| .
qq|$mmjd[$mmjn+1]</a></td></tr>\n| . qq|<tr><td align="center">\n| .
qq|<a href="$mailman::mmz?SHOW:${mmjo}mimepart:$mmjr=TRUE">\n| .
qq|<img src="$mailman::mmz?SHOW:${mmjo}mimepart:$mmjr=TRUE"></a>\n| .
qq|</td></tr>\n| . qq|</table></center></p>\n|; } else { $mmhw .=
qq|<p><b>Attachment #$mmjn:</b>\n| .
qq|<a href="$mailman::mmz?SHOW:${mmjo}mimepart:$mmjr=TRUE">\n| .
qq|$mmjd[$mmjn+1]</a></p>\n|; } } } } } else { $mmji=0;
plaintextline: foreach $_ (@$mmip) { if(/^begin \d\d\d (\S+)\s*$/i) { $mmji++;
$mmiu=0; $mmjj[$mmji] = $1; $mmjh[$mmji] = $1 . 'P' . $mmji; next plaintextline; }
elsif($mmji>0 && /^end\s*$/i) { $mmji++; $mmiu=0; $mmjg[$mmji] .= "Fake Header\n\n";
next plaintextline; } $mmjg[$mmji][$mmiu++] = $_; } if($mailman::mmbj ne '') {
my($mmjs) = 0; for(;$mmjs<=$mmji;$mmjs++) { if($mmjh[$mmjs] eq $mailman::mmbj) {
if($mmjj[$mmjs] eq '') { $mmhw .= mmsr($mmjg[$mmjs], $mmiq);
return $mmhw; } else { mmsq($mmjg[$mmjs],$mmjj[$mmjs]); } } } } else {
my($mmjs) = 0; for(;$mmjs<=$mmji;$mmjs++) {
if(!defined($mmjj[$mmjs]) || $mmjj[$mmjs] eq '') {
$mmhw .= mmsr($mmjg[$mmjs], $mmiq); } elsif(!$mmiq) {
my($mmjt) = $mmjh[$mmjs]; $mmjt =  mmtn($mmjt);
my $mmjo = mmrk($mailman::mmen); if($mailman::mmac) { $mmhw .=
'<form method="post" action="' . $mailman::mmz .
'"><input type="submit" name="' . 'SHOW:' . $mmjo . 'mimepart:' . $mmjt . 
"\" value=\"$mmjj[$mmjs]\"></form><br>\n"; } else { if($mmjj[$mmjs] =~
/\.(jpg)|(gif)|(png)\s*$/i) { $mmhw .= qq|<p>\n| . qq|<center>\n| .
qq|<table cellspacing=0 cellpadding=0 border=0>\n| .
qq|<tr><td align="center"><b>Attachment #$mmjs:</b>\n| .
qq|<a href="$mailman::mmz?SHOW:${mmjo}mimepart:$mmjt=TRUE">\n| .
qq|$mmjj[$mmjs]</a></td></tr>\n| . qq|<tr><td align="center">\n| .
qq|<a href="$mailman::mmz?SHOW:${mmjo}mimepart:$mmjt=TRUE">\n| .
qq|<img src="$mailman::mmz?SHOW:${mmjo}mimepart:$mmjt=TRUE"></a>\n| .
qq|</td></tr>\n| . qq|</table></center></p>\n|; } else { $mmhw .=
qq|<p><b>Attachment #$mmjs:</b>\n| .
qq|<a href="$mailman::mmz?SHOW:${mmjo}mimepart:$mmjt=TRUE">\n| .
qq|$mmjj[$mmjs]</a></p>\n|; } } } } } if($mmja[0] =~ /text\/html/i) {
$mmhw = mmss($mmip); } return($mmhw); } return($mmhw); }

 sub mmsm { my($mmjv) = @_; my($mmjw,$mmjx) = (0, 0);
my($mmjy) = 0; my($mmiv) = 0; my($mmbx) = ''; my($mmjz) = ''; my($mmey) = '';
my($mmka) = ''; my($mmek) = 'Untitled'; foreach $mmbx (@$mmjv) {
if($mmbx =~ /^Content-transfer-encoding\: base64/i) { $mmjw = 1; }
elsif($mmbx =~ /^Content-transfer-encoding\: quoted-printable/i) { $mmjx = 1; }
elsif($mmbx =~ /^Content-transfer-encoding\: x-uuencode/i) { $mmjy = 1; } else {
if($mmiv && $mmjw) { $mmjz .= $mmbx; } elsif($mmiv && $mmjx) { $mmjz .= $mmbx; }
elsif($mmiv) { $mmjz .= $mmbx; } else { $mmey .= $mmbx; } } if($mmbx =~ /^[\r\n]+$/) {
$mmiv = 1; $mmey =~ s/[\r\n]+[ \t]+(\S)/ $1/gs; if($mmjy) { my $mmkb; do {
$mmkb = shift(@$mmjv); } while($mmkb !~ /^begin \d\d\d (\S+)\s*$/i); $mmek = $1;
mmsq($mmjv, $mmek); exit(0); } } if(!$mmiv &&
$mmbx =~ /name\=\"?([^\"\;]+)\"?\;?\s/si) { $mmek = $1; } } if($mmjw) {
$mmka = mmsp($mmjz); } elsif($mmjx) { $mmka = mmso($mmjz); }
else { $mmka = $mmjz; } print "Expires: Sun, 03 May 1998 16:00:00 GMT\n"; 
my($mmkc,$mmkd,$mmke) = mmtq(); if($mmkc !~ /MSIE/i) {
print "Cache-control: no-cache\n"; } unless($mailman::mmw) { print $mmey;
print $mmka; exit(0); } else { unless(-d $mailman::mmu) {
unless(mkdir($mailman::mmu,0755)) {
mmqr("Could not create temporary directory for " .
"storing the attachment file.  Make sure that " . "the directory " .
"\"$mailman::mmu\" exists " . "and is writable by the web user."); }
if(defined($mailman::iLocalDirectoryPermissions)) {
mmtt($mailman::mmu, $mailman::iLocalDirectoryPermissions); } }
my $mmkf = $mmek; if($mmek =~ /^(.+)(\.[^\.]+)$/) { my $mmkg = $1; my $mmkh = $2;
$mmek = mmtn(mmtn($mmkg)) . $mmkh; } else {
$mmek = mmtn(mmtn($mmek)); } my($mmki) = new FileHandle();
my($mmkj) = $mailman::mmu . '/' . $mmek; unless(open($mmki,">$mmkj")) {
mmqr("Could not create temporary attachment file in \"" .
$mmkj ."\".  Make sure that the  " . "directory is writable by the web user."); }
binmode($mmki); print {$mmki} $mmka; close($mmki); if ($mmkf =~ /^(.+)(\.[^\.]+)$/)
{ my($mmkk) = $mailman::mmv . '/' .
mmtn(mmtn(mmtn($1))) . $2;
print "Location: $mmkk\n\n"; } else { my($mmkk) = $mailman::mmv . '/' . $mmek;
print "Location: $mmkk\n\n"; } exit(0); } } sub mmsn { my $mmjz = shift;
$mmjz =~ tr/\_/\ /; return $mmjz; } sub mmso { my($mmjz) = @_;
my($mmkl); $mmjz =~ s/\s+(\r?\n)/$1/g; $mmjz =~ s/=\r?\n//g; $mmkl = $mmjz;
$mmkl =~ s/=([\da-fA-F]{2})/pack("C", hex($1))/ge; return($mmkl); }
sub mmsp { my($mmjz) = @_; my($mmkl);
$mmjz =~ tr|A-Za-z0-9+=/||cd;             if(length($mmjz)%4) { return($mmjz); }
$mmjz =~ s/=+$//; $mmjz =~ tr|A-Za-z0-9+/| -_|; while($mmjz =~ /(.{1,60})/gs) {
my($mmkm) = chr(32+length($1)*3/4); $mmkl .= unpack("u",$mmkm . $1 ); }
return($mmkl); } sub mmsq { my($mmkn,$mmko) = @_;
print "Expires: Sun, 03 May 1998 16:00:00 GMT\n";  my($mmkc,$mmkd,$mmke) =
mmtq(); if($mmkc !~ /MSIE/i) { print "Cache-control: no-cache\n";  }
unless($mailman::mmw) { print
qq|Content-Type: application\/octet-stream; name="$mmko"\n\n|; my($mmhw) = '';
my($mmbx) = ''; foreach $mmbx (@$mmkn) { $mmhw .= unpack('u',$mmbx); } print $mmhw;
exit(0); } else { unless(-d $mailman::mmu) { unless(mkdir($mailman::mmu,0755)) {
mmqr("Could not create temporary directory for " .
"storing the attachment file.  Make sure that " . "the directory " .
"\"$mailman::mmu\" exists " . "and is writable by the web user."); }
if(defined($mailman::iLocalDirectoryPermissions)) {
mmtt($mailman::mmu, $mailman::iLocalDirectoryPermissions); } }
my($mmki) = new FileHandle(); my($mmkj) = $mailman::mmu . '/' . $mmko;
unless(open($mmki,">$mmkj")) {
mmqr("Could not temporary attachment file in \"" .
$mmkj ."\".  Make sure that the  " . "directory is writable by the web user."); }
binmode($mmki); my($mmbx) = ''; foreach $mmbx (@$mmkn) {
print {$mmki} unpack('u',$mmbx); } close($mmki); my($mmkk) =
$mailman::mmv . '/' . $mmko; print "Location: $mmkk\n\n"; exit(0); } }
sub mmsr { my($mmip,$mmiq) = @_; my($mmjw,$mmjx); my($mmhw) = '';
my($mmeq) = 0; my($mmjz) = ''; if(!$mmiq) { $mmhw = "<pre>\n"; } $mmeq=0;
foreach $_ (@$mmip) { if(!$mmeq) { if(/^Content-transfer-encoding\: base64/i) {
$mmjw = 1; } elsif(/^Content-transfer-encoding\: quoted-printable/i) { $mmjx = 1; } }
if($mmeq) { my($mmkp) = ''; if($mmjx || $mmjw) { $mmjz = $_; if($mmjw) {
$mmkp = mmsp($mmjz); } elsif($mmjx) { $mmkp = mmso($mmjz); }
} else { $mmkp = $_; } my($mmkq) = length($mmkp); my($mmkr) = ''; if($mmiq) {
$mmkr = $mmkp; $mmkr =~ s/\</\&lt\;/g; $mmkr =~ s/\>/\&gt\;/g;
$mmkr =~ s/\&/\&amp\;/g; } else { $mmkr = mmrj($mmkp); } my($mmks) = 90 +
(length($mmkr) - $mmkq); $mmkr =~ s/([^\n]{1,$mmks})\s/$1\n/g; $mmkr =~ s/\015//g;
if($mmiq) { $mmkr = '> ' . $mmkr; } $mmhw .= $mmkr ; } if(/^[\r\n]+$/){ $mmeq = 1; } }
if($mmjw) { $mmhw .= mmsp($mmjz); } elsif($mmjx) {
$mmhw .= mmso($mmjz); } if(!$mmiq) { $mmhw .= "</pre>\n"; }
return $mmhw; } sub mmss { my($mmip) = @_; my($mmjw,$mmjx);
my($mmjz) = ''; my($mmhw) = ''; my($mmeq) = 0; foreach $_ (@$mmip) { if(!$mmeq) {
if(/^Content-transfer-encoding\: base64/i) { $mmjw = 1; }
elsif(/^Content-transfer-encoding\: quoted-printable/i) { $mmjx = 1; } } if($mmeq) { 
if($mmjx || $mmjw) { $mmjz .= $_; } else { my($mmkr) = $_; $mmkr =~ s/\r//g;
$mmhw .= $mmkr; } } if(/^[\r\n]+$/){ $mmeq = 1; } } if($mmjw) {
$mmhw .= mmsp($mmjz); } elsif($mmjx) {
$mmhw .= mmso($mmjz); }
$mmhw =~ s/\<\/?(html|head|body|title)[^\>]*\>//sig;
my $mmjo = mmrk($mailman::mmen); $mmhw =~
s/(src\s*\=\s*\")cid\:([^\"]+)(\")/$1 . "${mailman::mmz}?SHOW:${mmjo}cid:" .
mmtn($2) . '=TRUE' . $3/egi; return $mmhw; } sub mmst {
my($mmbi,$mmii) =  @_; my($mmcg) = 0; my($mmkt) = 0; my($mmdc) = 
$mailman::mmt . '/' . mmtn($mailman::mmaf);
my($mmdx) = new FileHandle(); my($mmdr) = ''; my(%mmds) = (); my($mmku) = '';
my($mmkv) = ''; my($mmkw) = 0; my($mmil) = 0; my($mmdv) = 0;
my($mmdy) = "${mmdc}/msglist"; retry: if(open($mmdx,"<$mmdy")) { flock($mmdx,2);
if(<$mmdx> =~ /^(\d+)\s/) { $mailman::mmfb = $1; } else { close($mmdx);
mmug($mmdc); goto retry; } messageloop: while(defined($_ = <$mmdx>)) { chomp;
if(/^([^\|]+)\|/ && mmqx($_)) { $mmil++;
my($mmim) = $mailman::mmck; unless($mmkt) { $mmcg++; }
unless(defined($mailman::mmct) && $mailman::mmct =~ /R/i) { $mmdv++; }
my($mmea) = $mailman::mmco; my($mmeb) = 0; while(defined($mmds{$mmea})) {
if($mmea =~ s/^([^\_]*)\_(\d+)/$1/) { $mmeb++; } $mmea .= "_$mmeb"; }
$mmds{$mmea} = $_; if($mmim eq $mmbi) { $mmkt = 1; $mailman::mmep = $mmil;
if($mailman::mmct !~ /R/i) { $mmdv--; $mmku = $_; $mmkv = $mmea; $mmkw = 1; } } }
elsif(/^DELETED\:\s+(\S+)\s*$/) { my($mmdz) = mmto($1);
$mmdr .= $_ . "\n"; } elsif(/^\S+\:\s+(\S+)\s*$/) { my($mmdz) = mmto($1);
$mmdr .= $_ . "\n"; } } close($mmdx); } $mailman::mmen =
mmto(mmsg(mmtn($mmbi),$mmii)); my($mmbp) = '';
if($mailman::mmac) { $mmbp = 't_nf_message.htm'; } else { $mmbp = 't_f_message.htm'; }
$mailman::mmbg{'USERNAME'} = $mailman::mmm;
$mailman::mmbg{'USERNAMEHIDDEN'} = $mailman::mmn;
$mailman::mmbg{'SERVER'} = $mailman::strIncomingServer;
$mailman::mmbg{'SERVERHIDDEN'} = $mailman::mmq;
$mailman::mmbg{'PASSWORDHIDDEN'} = $mailman::mmp;
$mailman::mmbg{'CHECKSUM'} = $mailman::mmy;
$mailman::mmbg{'NUM'} = $mailman::mmfb; $mailman::mmbg{'TO'} = $mailman::mmcy;
$mailman::mmbg{'FROM'} = $mailman::mmcz; $mailman::mmbg{'DATE'} = $mailman::mmcn;
$mailman::mmbg{'SUBJECT'} = $mailman::mmda;
$mailman::mmbg{'MESSAGENUM'} = $mailman::mmep;
$mailman::mmbg{'MESSAGE'} = mmsj(\@mailman::mmik);
$mailman::mmbg{'ID'} = mmrk($mailman::mmen);
$mailman::mmbg{'MESSAGENUM'} = $mmcg + $mmii;
$mailman::mmbg{'FOLDERLIST'} = mmua();
$mailman::mmbg{'CC'} = $mailman::mmex; $mailman::mmkx = 
mmti($mmbp,'CCLINE'); if($mailman::mmcl eq '') {
$mailman::mmkx = ''; } else { $mailman::mmkx =
mmtg($mailman::mmkx,\%mailman::mmbg); }
$mailman::mmbg{'CCLINE'} = $mailman::mmkx;
mmtk($mmbp,\%mailman::mmbg,1); if($mmkw) { mmqx($mmku);
$mailman::mmct .= 'R'; $mmku = mmqw(undef,undef);
$mmds{$mmkv} = $mmku; unless(open($mmdx,">$mmdy")) {
mmqr("Could not create user message list in \"" .
$mmdy ."\".  Make sure that the  " . "directory is writable by the web user."); }
flock($mmdx,2); $mailman::mmce = $mmcg; print {$mmdx} "$mmil $mmdv\n";
my($mmej) = ''; foreach $mmej (sort {$a <=> $b} keys %mmds) {
print {$mmdx} $mmds{$mmej} . "\n"; } print {$mmdx} "\n" . $mmdr; close($mmdx); }
exit(1); } sub mmsu { my($mmbi,$mmii) =  @_;
$mailman::mmen = mmsg(mmtn($mmbi),$mmii); my($mmbp) = '';
if($mailman::mmac) { $mmbp = 't_nf_message.htm'; } else { $mmbp = 't_f_message.htm'; }
$mailman::mmbg{'USERNAME'} = $mailman::mmm;
$mailman::mmbg{'USERNAMEHIDDEN'} = $mailman::mmn;
$mailman::mmbg{'SERVER'} = $mailman::strIncomingServer;
$mailman::mmbg{'SERVERHIDDEN'} = $mailman::mmq;
$mailman::mmbg{'PASSWORDHIDDEN'} = $mailman::mmp;
$mailman::mmbg{'CHECKSUM'} = $mailman::mmy;
$mailman::mmbg{'NUM'} = $mailman::mmfb;
$mailman::mmbg{'MESSAGENUM'} = $mailman::mmep;
$mailman::mmbg{'TO'} = $mailman::mmcy; $mailman::mmbg{'FROM'} = $mailman::mmcz;
$mailman::mmbg{'DATE'} = $mailman::mmcn;
$mailman::mmbg{'SUBJECT'} = $mailman::mmda;
$mailman::mmbg{'FOLDERLIST'} = mmua();
$mailman::mmbg{'ID'} = mmrk($mailman::mmen);
$mailman::mmbg{'CC'} = $mailman::mmex; $mailman::mmkx = 
mmti($mmbp,'CCLINE'); if($mailman::mmcl eq '') {
$mailman::mmkx = ''; } else {
$mailman::mmkx = mmtg($mailman::mmkx,\%mailman::mmbg); }
$mailman::mmbg{'CCLINE'} = $mailman::mmkx; $mailman::mmbg{'MESSAGE'} = "<pre>\n";
my($mmbx) = ''; foreach $mmbx (@mailman::mmik) { $mmbx =~ s/\015//g;
$mmbx =~ s/\&/\&amp\;/g; $mmbx =~ s/\</\&lt\;/g; $mmbx =~ s/\>/\&gt\;/g;
$mailman::mmbg{'MESSAGE'} .= $mmbx; } $mailman::mmbg{'MESSAGE'} .= "</pre>\n";
mmtk($mmbp,\%mailman::mmbg); } sub mmsv { my($mmbi) =  @_;
$mailman::mmce = mmri($mmbi); mmqu($mma,"DELE $mailman::mmce");
my($mmcd) = ''; $mmcd = <$mma>; unless($mmcd =~ /^\+OK/) { mmqr($mmcd); } }
sub mmsw { my($mmbi) =  @_; mmro(); if($mailman::mmar &&
$mailman::mmaf !~ /^TRASH$/i) { unless(mmsz($mmbi,'TRASH')) {
mmqr("There was an unknown error copying this message " .
"into the 'TRASH' folder.  The deletion was " . "aborted."); } }
mmsx($mmbi); if($mailman::mmaf ne 'INBOX') {
mmsy($mmbi); } } sub mmsx { my($mmbi,$mmky) = @_;
unless($mmky) { $mmky = 'DELETED'; } my($mmdc) =  $mailman::mmt . '/' .
mmtn($mailman::mmaf); my($mmdy) = "${mmdc}/msglist";
my($mmdx) = new FileHandle(); my($mmkz) = new FileHandle(); retry:
if(!open($mmdx,"+<$mmdy")) {
mmqr("Could not open message index for deletion."); return; }
if(!open($mmkz,">$mmdy.tmp")) {
mmqr("Could not create backup message index."); return; } flock($mmdx,2);
my($mmbx) = ''; $mmbx = <$mmdx>; if($mmbx =~ /^(\d+)\s(\d+)\s/) {
$mailman::mmfb = $1; $mailman::mmfb--; my($mmla) = ($2 - 1);
print {$mmkz} "$mailman::mmfb $mmla\n"; } elsif($mmbx =~ /^(\d+)\s/) {
$mailman::mmfb = $1; $mailman::mmfb--; print {$mmkz} "$mailman::mmfb\n"; } else {
close($mmdx); close($mmkz); mmug($mmdc); goto retry; } my($mmlb) = 0;
while(defined($_ = <$mmdx>)) { if((/^([^\|]+)\|/)||(/^\S+\:\s+(\S+)\s*$/)) {
my($mmlc) = mmto($1); if($mmlc eq $mmbi) { if($mailman::mmaf eq 'INBOX')
{ print {$mmkz} "$mmky: " . mmtn($mmlc) . "\n"; } $mmlb = 1; } else {
print {$mmkz} $_; } } } close($mmkz); if($mmlb) { if(!open($mmkz,"<$mmdy.tmp")) {
mmqr("Could not open backup message index."); return; } seek($mmdx,0,0);
truncate($mmdx,0); while(defined($_ = <$mmkz>)) { print {$mmdx} $_; } close($mmkz);
unlink($mmdc . '/' . mmtn($mmbi)); } close($mmdx); } sub mmsy {
my($mmbi) = shift; my($mmdx) = new FileHandle(); my($mmkz) = new FileHandle();
my($mmdy) = "${mailman::mmt}/INBOX/msglist"; retry: if(open($mmdx,"<$mmdy") &&
open($mmkz,">$mmdy.tmp")) { flock($mmdx,2); if(<$mmdx> =~ /^(\d+)\s/) {
print {$mmkz} "$1\n"; } else { close($mmdx); close($mmkz);
mmug("${mailman::mmt}/INBOX"); goto retry; } while(defined($_ = <$mmdx>)) {
if(/^\S+\:\s+(\S+)\s*$/) { my($mmdz) = mmto($1); unless($mmdz eq $mmbi) {
print {$mmkz} $_; } } else { print {$mmkz} $_; } } print {$mmkz} "DELETED: " . 
mmtn($mmbi) . "\n"; close($mmdx); close($mmkz); use File::Copy;
copy("$mmdy.tmp", $mmdy); } } sub mmsz { my($mmbi, $mmbm) = @_;
my($mmdc) =  $mailman::mmt . '/' . mmtn($mailman::mmaf);
my($mmld) = mmtn($mmbi); my($mmdy) = "${mmdc}/msglist";
my($mmdx) = new FileHandle(); retry: if(!open($mmdx,"+<$mmdy")) {
mmqr("Could not open message index."); return 0; } flock($mmdx,2);
if(<$mmdx> =~ /^(\d+)\s/) { $mailman::mmfb = $1; } else { close($mmdx);
mmug($mmdc); goto retry; } my($mmco) = ''; my($mmcu) = '';
while(defined($_ = <$mmdx>)) { if(/^([^\|]+)\|/) { my($mmlc) = mmto($1);
if($mmlc eq $mmbi) { $mmcu = $_; $mmco = $mailman::mmco; } } } close($mmdx);
if($mmcu eq '') { return 0; } unless(mmqx($mmcu)) { return 0; }
my($mmle) = $mailman::mmco; my(%mmds) = (); $mmds{$mmle} = $mmcu;
if(mmta($mmbm,1,\%mmds)) { unless(copy("${mmdc}/${mmld}",
"${mailman::mmt}/${mmbm}/${mmld}")) { return 0; } } return 1; } sub mmta
{ my($mmbm,$mmee,$mmlf) = @_; my($mmlg) =  $mailman::mmt . '/' . $mmbm;
unless(-d $mmlg) { my $mmlh = $mailman::mmaf; $mailman::mmaf = $mmbm;
mmqz(); $mailman::mmaf = $mmlh; } my($mmli) = "${mmlg}/msglist";
my($mmdx) = new FileHandle(); retry: if(!open($mmdx,"<$mmli")) {
if(!open($mmdx,">$mmli")) { mmqr("Could not create new message index: " .
$mmli); return; } flock($mmdx,2); print {$mmdx} "$mmee $mmee\n"; my($mmej) = '';
foreach $mmej (sort keys %{$mmlf}) { print {$mmdx} $mmlf->{$mmej} . "\n"; }
close($mmdx); return 1; } flock($mmdx,2); my($mmdr) = ''; my($mmcg) = my($mmdu) = 0;
my($mmdv) = 0; my(%mmdw); my($mmbx) = ''; $mmbx = <$mmdx>;
if($mmbx =~ /^(\d+)\s(\d+)\s/) { $mmcg = $1; } elsif($mmbx =~ /^(\d+)\s/) {
$mmcg = $1; } else { close($mmdx); mmug($mmlg); goto retry; } $mmdu = 0;
while(defined($_ = <$mmdx>)) { chomp;
if(/^([^\|]+)\|/ && mmqx($_)) { my($mmdz) = mmto($1);
$mmdu++; unless(defined($mailman::mmct) && $mailman::mmct =~ /R/i) { $mmdv++; }
my($mmea) = $mailman::mmco; my($mmeb) = 0; while(defined($mmlf->{$mmea})) {
if($mmea =~ s/^([^\_]*)\_(\d+)/$1/) { $mmeb++; } $mmea .= "_$mmeb"; }
$mmlf->{$mmea} = $_; } elsif(/^DELETED\:\s+(\S+)\s*$/) {
my($mmdz) = mmto($1); $mmdw{$mmdz} = 1; $mmdr .= $_ . "\n"; }
elsif(/^\S+\:\s+(\S+)\s*$/) { my($mmdz) = mmto($1); $mmdr .= $_ . "\n"; }
} if($mmdu != $mmcg) { close($mmdx); mmug($mmlg); goto retry; } close($mmdx);
unless(open($mmdx,">$mmli")) {
mmqr("Could not create user message list in \"" . $mmli .
"\".  Make sure that the  " . "directory is writable by the web user."); }
flock($mmdx,2); $mailman::mmce = $mmcg + $mmee; $mmdv += $mmee;
print {$mmdx} "$mailman::mmce $mmdv\n"; my($mmej) = '';
foreach $mmej (sort keys %{$mmlf}) { print {$mmdx} $mmlf->{$mmej} . "\n"; }
print {$mmdx} "\n" . $mmdr; close($mmdx); return 1; } sub mmtb {
my($mmbi,$mmlj,$mmlk, $mmay) =  @_; my($mmhw) = ''; my($mmll) = ''; my($mmlm) = '';
my($mmln) = ''; $mailman::mmbg{'ATTACH'} = $mailman::in{'ATTACH'}; my($mmbp) = '';
$mmbp = 't_messageform.htm'; mmro(); if($mmbi ne 'NEW') {
mmsg(mmtn($mmbi),0); $mmll = $mailman::mmay;
$mmlm = $mailman::mmcm; $mmln = $mailman::mmcp; if($mailman::mmcq) {
$mailman::mmay = $mailman::mmcq; } else { $mailman::mmay = $mailman::mmcm; } if($mmlj)
{ $mailman::mmay .= ", $mmll";
if($mailman::mmcl){ $mailman::mmay .= ", $mailman::mmcl"; } } if($mmlk) {
unless($mailman::mmcp =~ /^fwd\:/i) { $mailman::mmcp = "Fwd: $mailman::mmcp"; }
$mailman::mmay = ""; } else { unless($mailman::mmcp =~ /^re\:/i) {
$mailman::mmcp = "Re: $mailman::mmcp"; } } $mailman::mmcl = ''; }
$mailman::mmay =~ s/\"/&quot;/g; $mailman::mmcp =~ s/\"/&quot;/g;
if($mmbi ne 'NEW') { $mailman::mmjk = 0; $mmhw = mmsj(\@mailman::mmik,1);
if($mmlk) { my($mmlo) = mmti($mmbp, 'FORWARDHEADER');
$mailman::mmbg{'ORIGINALTO'} = $mmll; $mailman::mmbg{'ORIGINALFROM'} = $mmlm;
$mailman::mmbg{'ORIGINALSUBJECT'} = $mmln;
$mailman::mmbg{'ORIGINALDATE'} = $mailman::mmcn;
$mmhw = mmtg($mmlo, \%mailman::mmbg) . $mmhw;
$mmhw = "\n\n\n\n" . $mailman::mmam . "\n\n" . $mmhw; if($mailman::mmjk) {
$mailman::mmlp = $mmbi; $mailman::mmbg{'ERROR'} = 
'The original message attachment(s) ' . 'will be included in this message.'; } }
else  { $mmhw = "\n\n" . $mmhw . "\n\n" . $mailman::mmam; } } else  {
unless(length($mmhw)) { $mmhw = "\n\n\n\n" . $mailman::mmam; } } if(defined($mmay)) {
$mailman::mmay = $mmay; } $mailman::mmbg{'USERNAME'} = $mailman::mmm;
$mailman::mmbg{'USERNAMEHIDDEN'} = $mailman::mmn;
$mailman::mmbg{'SERVER'} = $mailman::strIncomingServer;
$mailman::mmbg{'SERVERHIDDEN'} = $mailman::mmq;
$mailman::mmbg{'PASSWORDHIDDEN'} = $mailman::mmp;
$mailman::mmbg{'CHECKSUM'} = $mailman::mmy;
$mailman::mmbg{'NUM'} = $mailman::mmce; $mailman::mmbg{'MESSAGE'} = $mmhw;
$mailman::mmbg{'TO'} = $mailman::mmay; $mailman::mmbg{'CC'} = $mailman::mmcl;
$mailman::mmbg{'SUBJECT'} = $mailman::mmcp; my($mmlq) = $mailman::mmak;
$mailman::mmbg{'FROM'} = $mmlq . ' &lt;' . $mailman::mmal . '&gt;';
my($mmlr) = $mailman::mman; $mailman::mmbg{'OUTGOING'} = $mmlr;
my($mmkc,$mmkd,$mmke) = mmtq(); my($mmls) = 0;
if(($mmkc =~ /MSIE/i && $mmkd >= 4) || ($mmkc =~ /Mozilla/i && $mmkd >= 2)) {
if(!$mmlk) { if($mailman::in{'ATTACH'}) { $mailman::mmbg{'UPLOAD'} =
mmti($mmbp, 'UPLOAD'); $mmls = 1; } else {
$mailman::mmbg{'UPLOAD'} = mmti($mmbp, 'BENIGNUPLOAD'); } }
else { $mailman::mmbg{'UPLOAD'} = ''; } } else { $mailman::mmbg{'UPLOAD'} = ''; }
if($mmls) { $mailman::mmbg{'MULTIPARTTAG'} =
mmti($mmbp,'MULTIPARTTAG');
$mailman::mmbg{'ENCTYPE'} = "multipart/form-data"; } else {
$mailman::mmbg{'ENCTYPE'} = "application/x-www-form-urlencoded"; }
mmtk($mmbp,\%mailman::mmbg); } sub mmtc { my($mmbf,$mmlt) = @_;
my($mmlk) = 0; $mailman::mmbg{'ATTACH'} = $mailman::in{'ATTACH'}; my($mmbp) = '';
$mmbp = 't_messageform.htm'; $mailman::mmbg{'USERNAME'} = $mailman::mmm;
$mailman::mmbg{'USERNAMEHIDDEN'} = $mailman::mmn;
$mailman::mmbg{'SERVER'} = $mailman::strIncomingServer;
$mailman::mmbg{'SERVERHIDDEN'} = $mailman::mmq;
$mailman::mmbg{'PASSWORDHIDDEN'} = $mailman::mmp;
$mailman::mmbg{'CHECKSUM'} = $mailman::mmy;
$mailman::mmbg{'NUM'} = $mailman::in{'NUM'};
$mailman::mmbg{'TO'} = $mailman::in{'TO'};
$mailman::mmbg{'CC'} = $mailman::in{'CC'};
$mailman::mmbg{'FROM'} = $mailman::in{'FROM'};
$mailman::mmbg{'SUBJECT'} = $mailman::in{'SUBJECT'};
$mailman::mmbg{'OUTGOING'} = $mailman::strOutgoingServer;
$mailman::mmbg{'ERROR'} = $mmbf; unless(defined($mmlt) && length($$mmlt)) {
$mailman::mmbg{'MESSAGE'} = $mailman::in{'TEXT'}; } else {
$mailman::mmbg{'MESSAGE'} = $$mmlt; }
if(defined($mailman::in{'FORWARDATTACHMENTS'})) { $mailman::mmlp =
mmto($mailman::in{'FORWARDATTACHMENTS'}); $mmlk = 1; }
my($mmkc,$mmkd,$mmke) = mmtq(); my($mmls) = 0;
if(($mmkc =~ /MSIE/i && $mmkd >= 4) || ($mmkc =~ /Mozilla/i && $mmkd >= 2)) {
if(!$mmlk) { if($mailman::in{'ATTACH'}) { $mailman::mmbg{'UPLOAD'} =
mmti($mmbp, 'UPLOAD'); $mmls = 1; } else {
$mailman::mmbg{'UPLOAD'} = mmti($mmbp, 'BENIGNUPLOAD'); } }
else { $mailman::mmbg{'UPLOAD'} = ''; } } else { $mailman::mmbg{'UPLOAD'} = ''; }
if($mmls) { $mailman::mmbg{'MULTIPARTTAG'} =
mmti($mmbp,'MULTIPARTTAG');
$mailman::mmbg{'ENCTYPE'} = "multipart/form-data"; } else {
$mailman::mmbg{'ENCTYPE'} = "application/x-www-form-urlencoded"; }
mmtk($mmbp,\%mailman::mmbg); } sub mmtd { my($mmbv) = "\015\012";
my($mmbw, $mmbx) = @_; if($mailman::mmlu) { print $mailman::mmlv $mmbx . $mmbv; }
else { my($mmby) = length($mmbx . $mmbv); syswrite($mmbw,$mmbx . $mmbv,$mmby); } }
sub mmte { my($mmbv) = "\015\012"; my($mmhw) = ''; my($mmir) = '';
my($mmlw) = ''; my($mmay) = ''; my($mmbf) = ''; if($mmbf = mmqv()) {
if(defined($mmbf)) { $mmbf =~ s/^\-ERR(.*)$/$1/; } $mailman::bKioskMode = 0;
$mailman::mmbg{'GREETING'} = 
"<center><b>Log In Error: </b><i>$mmbf</i></center>";
mmtk('t_login.htm',\%mailman::mmbg); mmqu($mma,"QUIT");
close $mma; $mailman::mmbl = 0; } mmro(); my($mmlx) = 
$mailman::in{'FORWARDATTACHMENTS'}; if($mmlx) { $mmlx = $mmlx; mmsg($mmlx,0);
my($mmjc) = 0; my($mmbx) = ''; foreach $mmbx (@mailman::mmik) {
if($mmbx =~ /boundary\=\"?([^\"]+)\"?\;?/ && $mmir eq '') { $mmir = $1; }
if($mmir ne '' && $mmbx =~ /^\-\-$mmir\s*$/) { $mmjc++; } if($mmjc > 0) {
$mmbx =~ s/[\r\n]+/$mmbv/; $mmlw .= $mmbx; } } } $mmhw = $mailman::in{'TEXT'};
$mmhw =~ s/\015//sg; $mmhw =~ s/([^\012]{1,90})\s/$1\012/sg;
$mmhw =~ s/\012/\015\012/sg; my $mmcm = $mailman::in{'FROM'}; my $mmly = 0;
local *Reader, *Writer; if(defined($mailman::strLocalLocationSendmail)) {
$mailman::mmlu = 1; use IPC::Open2; $mmly = open2(\*Reader, \*Writer,
"$mailman::strLocalLocationSendmail -bs"); $mma = \*Reader;
select($mma); $|=1; select(STDOUT); binmode($mma); $mailman::mmlv = \*Writer;
select($mailman::mmlv); $|=1; select(STDOUT); binmode($mailman::mmlv); } else {
unless($mailman::strOutgoingServer) {
mmtc("Send Error: No server provided, cannot proceed.", \$mmhw); }
my($mmca) = 0; $mmca = getprotobyname('tcp');
socket($mma,PF_INET,SOCK_STREAM,$mmca); my($mmcb) = 0;
$mmcb = gethostbyname($mailman::strOutgoingServer); unless($mmcb) {
mmtc("Could not find an IP address for the host " .
"\"$mailman::strOutgoingServer\".", \$mmhw); } my($mmcc) = '';
$mmcc = sockaddr_in(25, $mmcb); unless(connect($mma, $mmcc)) {
mmtc("Send Error: Could not connect to server " .
"$mailman::strOutgoingServer", \$mmhw); } select($mma); $|=1; select(STDOUT);
binmode($mma); } $mailman::mmbq = "The server connected, but will not respond.";
if($mailman::bUseAlarm){ alarm($mailman::iTimeoutDurationInSeconds); }
my($mmcd) = ''; $mmcd = <$mma>; unless($mmcd =~ /^220.+/) { if($mailman::mmlu) {
mmtc("Could not invoke local Sendmail instance at \"" .
$mailman::strLocalLocationSendmail . "\""); } else {
mmtc("Send Error: The server does not respond " .
"appropriately.  It responded: \"$mmcd\"", \$mmhw); } } while($mmcd =~ /^\d\d\d\-/) {
$mmcd = <$mma>; } my($mmlz) = $ENV{REMOTE_HOST};
unless($mmlz){ $mmlz = 'mailman.endymion.com';} mmtd($mma,"HELO $mmlz");
$mmcd = <$mma>; unless($mmcd =~ /^250.+/) {
mmtc('Send Error: ' . $mmcd, \$mmhw); } while($mmcd =~ /^\d\d\d\-/) {
$mmcd = <$mma>; } $mailman::mmbq =
"The server timed out while accepting a message.";
if($mailman::bUseAlarm){ alarm($mailman::iTimeoutDurationInSeconds); }
my($mmma) = $mmcm; if($mmma =~ /(\<[^\>]+\>)/) { $mmma = $1; } else {
$mmma = '<' . $mmma . '>'; } mmtd($mma,"MAIL FROM: $mmma"); $mmcd = <$mma>;
unless($mmcd =~ /^250.+/) { mmtc('Send Error: ' . $mmcd, \$mmhw); }
while($mmcd =~ /^\d\d\d\-/) { $mmcd = <$mma>; } mmrr();
my($mmaz) = ''; if($mailman::mmfu) { foreach $mmaz (sort keys %mailman::mmba) {
$mmaz =~ tr/[A-Z]/[a-z]/; my($mmbb) = $mailman::mmba{$mmaz}->{'FIRSTNAME'};
unless(defined($mmbb)){ $mmbb = ''; } my($mmbc) =
$mailman::mmba{$mmaz}->{'LASTNAME'}; unless(defined($mmbc)){ $mmbc = ''; }
my($mmbd) = $mailman::mmba{$mmaz}->{'ADDRESS'};
unless(defined($mmbd)){ $mmbd = ''; } if(($mmbb ne '') || ($mmbc ne '')) {
$mailman::mmba{$mmaz}->{'SMTPADDRESS'} = "$mmbb $mmbc <$mmbd>"; } else {
$mailman::mmba{$mmaz}->{'SMTPADDRESS'} = "$mmbd"; } } } mmrs();
my($mmgj) = ''; if($mailman::mmfy) { foreach $mmaz (sort keys %mailman::mmbe) {
$mmaz =~ tr/[A-Z]/[a-z]/; $mailman::mmbe{$mmaz} =~ s/(\r\n)|(\r\n)/,/g; 
$mailman::mmbe{$mmaz} =~ s/[\r\n]/,/g;         $mailman::mmbe{$mmaz} =~ s/\,$//g; } }
{ $mmay = $mailman::in{'TO'}; $mmay =~ s/\;/\,/g;  $mailman::in{'TO'} = $mmay; }
my($mmmb) = $mailman::in{'TO'}; $mmmb =~ s/\"[^\"]+\"//g;
my(@mmmc) = split(/[\,\;]/,$mmmb); my($mmmd) = ''; my(@mmme) = ();; my($mmcl) = '';
if($mailman::in{'CC'}) { $mmmd .= $mailman::in{'CC'};
@mmme = split(/[\,\;]/,$mmmd); $mmcl = $mailman::in{'CC'}; } my(@mmmf) = ();
my(@mmmg) = (); my(@mmmh) = (); { my($mmfx); for($mmfx=0;$mmfx<($#mmmc+1);$mmfx++) {
my($mmmi) = $mmmc[$mmfx]; $mmmi =~ s/^\s+(.*)$/$1/; $mmmi =~ s/^(.*)\s+$/$1/;
my($mmmj) = $mmmi; $mmmj =~ tr/[A-Z]/[a-z]/; if($mailman::mmbe{$mmmj}) { $mmmi =
$mailman::mmbe{$mmmj}; } push(@mmmf,split(/[\,\;]/,$mmmi)); }
for($mmfx=0;$mmfx<($#mmme+1);$mmfx++) { my($mmmi) = $mmme[$mmfx];
$mmmi =~ s/^\s+(.*)$/$1/; $mmmi =~ s/^(.*)\s+$/$1/; my($mmmj) = $mmmi;
$mmmj =~ tr/[A-Z]/[a-z]/; if($mailman::mmbe{$mmmj}) { $mmmi = $mailman::mmbe{$mmmj};
} push(@mmmg,split(/[\,\;]/,$mmmi)); } } my($mmmk) = 0; for(;$mmmk<2;$mmmk++) {
my($mmml,$mmmm,$mmmn); if($mmmk == 0) { $mmml = \$mmay; $mmmm = \@mmmf;
$mmmn = $#mmmf; } else { $mmml = \$mmcl; $mmmm = \@mmmg; $mmmn = $#mmmg; } my($mmfx);
recipient: for($mmfx=0;$mmfx<($mmmn+1);$mmfx++) { my($mmmi) = $mmmm->[$mmfx];
my($mmmj) = $mmmi; $mmmj =~ tr/[A-Z]/[a-z]/;
if($mailman::mmba{$mmmj}->{'SMTPADDRESS'}) { $mmmi =
$mailman::mmba{$mmmj}->{'SMTPADDRESS'}; $mmmm->[$mmfx] = $mmmi; }
if($mmmi =~ /^\s*$/){ next recipient; } push(@mmmh,$mmmi); }
${$mmml} = join(', ',@{$mmmm}); } my($mmmi) = ''; while($mmmi = shift(@mmmh)) {
$mmmi =~ s/^\s+(.*)$/$1/; $mmmi =~ s/^(.*)\s+$/$1/; unless($mmmi =~ /@/) {
if(defined($mailman::strOutgoingDomainName)) {
$mmmi .= "\@$mailman::strOutgoingDomainName"; } } if($mmmi =~ /(\S+)\s+\([^\)]\)/) {
$mmmi = '<' . $1 . '>'; } elsif($mmmi =~ /\<([^\>]+)\>/) { $mmmi = '<' . $1 . '>'; }
elsif($mmmi !~ /\<[^\>]+\>/) { $mmmi = '<' . $mmmi . '>'; }
mmtd($mma,"RCPT TO: $mmmi"); my $mmcd = <$mma>; unless($mmcd =~ /^250.+/) {
mmtc('Send Error: ' . $mmcd, \$mmhw); } while($mmcd =~ /^\d\d\d\-/) {
$mmcd = <$mma>; } } mmtd($mma,"DATA"); my $mmcd = <$mma>;
unless($mmcd =~ /^354.+/) { mmtc('Send Error: ' . $mmcd, \$mmhw); }
while($mmcd =~ /^\d\d\d\-/) { $mmcd = <$mma>; } my($mmmo) =
defined($ENV{'TZ'}) ? $ENV{'TZ'} : 'GMT';
my(@mmmp) = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
my(@mmih) = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep',
'Oct','Nov','Dec'); my($mmhy,$mmhz,$mmia,$mmib,$mmic,$mmid,$mmie) =
($mmmo eq 'GMT') ? gmtime(time) : localtime(time); $mmie = $mmmp[$mmie];
$mmic = $mmih[$mmic]; $mmia = sprintf("%2.2d",$mmia);
$mmhz = sprintf("%2.2d",$mmhz); $mmhy = sprintf("%2.2d",$mmhy);
if(length($mmid) == 2) { $mmid = mmui($mmid); }
elsif(length($mmid) == 3) { $mmid += 1900; }
my($mmcn) = "$mmie, $mmib $mmic $mmid $mmia:$mmhz:$mmhy $mmmo";
my($mmmq) = $mmie.$mmib.$mmic.$mmid.$mmia.$mmhz.$mmhy; $mailman::mmay = $mmay;
my $mmmr = qq|To: ${mmay}${mmbv}|; if($mmcl) { $mmmr .= qq|Cc: ${mmcl}${mmbv}|; }
$mailman::mmcm = $mailman::in{'FROM'}; $mmmr .= qq|From: ${mmcm}${mmbv}|;
my $mmcp = $mailman::in{'SUBJECT'}; $mmmr .= qq|Subject: ${mmcp}${mmbv}|;
$mmmr .= qq|Date: ${mmcn}${mmbv}|; $mmmr .= "X-Mailer: Endymion MailMan " .
"$mailman::strMailManEdition $mailman::strMailManVersion$mmbv";
if($mailman::in{'USERFILE1'} || $mailman::in{'USERFILE2'} || $mmlx) {
unless($mmir){ $mmir = 'MailMan_Boundary'; } $mmmr .= "MIME-Version: 1.0$mmbv";
$mmmr .=  "Content-Type: multipart/mixed; boundary=\"$mmir\"$mmbv$mmbv"; $mmmr .= 
"This is a multi-part message in MIME format.$mmbv$mmbv";
$mmmr .= "--$mmir$mmbv"; $mmmr .= "Content-Type: text/plain$mmbv$mmbv"; } else {
$mmmr .= "$mmbv"; } mmtd($mma,$mmmr . $mmhw); my($mmel) = new FileHandle();
my($mmdc) = ''; my($mmms) = $mailman::mmaf; my($mmmt) = 0; if($mailman::mmas) {
$mailman::mmaf = 'SENT'; $mmdc = $mailman::mmt . '/' .
mmtn($mailman::mmaf); mmqy(); mmqz();
my($mmei) = $mmdc . '/' . mmtn( $mailman::mmm . '@' .
$mailman::strIncomingServer . '@' . $mmmq); if(open($mmel,">$mmei")) {
$mmmr =~ s/\015\012/\n/g; $mmhw =~ s/\015\012/\n/g; print {$mmel} $mmmr . $mmhw;
$mmmt += length($mmmr) + length($mmhw); } else {
mmtc("There was a problem storing the outgoing " .
"message in the 'SENT' folder.  The send was " . "aborted."); } }
if(defined($mailman::strOutgoingBannerText)) { if($mailman::mmas) {
print {$mmel} $mailman::strOutgoingBannerText;
$mmmt += length($mailman::strOutgoingBannerText); }
$mailman::strOutgoingBannerText =~ s/\015//sg;
$mailman::strOutgoingBannerText =~ s/([^\012]{1,90})\s/$1\012/sg;
$mailman::strOutgoingBannerText =~ s/\012/\015\012/sg; mmtd($mma,
$mailman::strOutgoingBannerText); } my($mmjl) = '';
foreach $mmjl ('USERFILE1','USERFILE2') { unless($mailman::in{$mmjl}){next;}
my($mmek) = ''; $mmek = $mailman::incfn{$mmjl}; my($mmew) = $mailman::inct{$mmjl};
my $mmmu .= $mailman::in{$mmjl}; my($mmmv) = $mmek;
$mmmv =~ s/^.*[\\\/]([^\\\/]+)$/$1/; my($mmmw) = '--' . $mmir . $mmbv; $mmmw .= 
"Content-Type: ${mmew}; name=\"" . $mmmv . "\"$mmbv";
$mmmw .= "Content-Transfer-Encoding: base64$mmbv"; $mmmw .=
"Content-Disposition: attachment; filename=\"" . $mmmv . "\"$mmbv";
$mmmw .= $mmbv; $mmmw .= mmuk($mmmu,$mmbv); mmtd($mma,$mmmw);
if($mailman::mmas) { $mmmw =~ s/\015\012/\n/g; print {$mmel} $mmmw;
$mmmt += length($mmmw); } } if($mmlw) { mmtd($mma,$mmlw); if($mailman::mmas) {
$mmlw =~ s/\015\012/\n/g; print {$mmel} $mmlw; $mmmt += length($mmlw); } } else {
if($mmir) { my($mmmx) = '--' . $mmir . '--'; mmtd($mma,$mmmx);
if($mailman::mmas) { print {$mmel} $mmmx; $mmmt += length($mmmx); } } }
mmtd($mma,''); mmtd($mma,'.'); my $mmcd = <$mma>;
unless($mmcd =~ /^250.+/) { mmtc('Send Error: ' . $mmcd, \$mmhw); }
while($mmcd =~ /^\d\d\d\-/) { $mmcd = <$mma>; } mmtd($mma,"QUIT");
close $mma; if($mailman::mmlu) { close $mailman::mmlv; waitpid($mmly, 0); }
if($mailman::mmas) { close($mmel); my($mmdx) = new FileHandle();
my($mmkz) = new FileHandle(); my($mmdy) = "${mmdc}/msglist"; retry:
if(!open($mmdx,"+<$mmdy")) { if(!open($mmdx,"+>$mmdy")) {
mmqr("Could not open message index for modification."); return; }
print {$mmdx} "0 0\n"; seek($mmdx,0,0); } if(!open($mmkz,">$mmdy.tmp")) {
mmqr("Could not create backup message index."); return; } flock($mmdx,2);
if(<$mmdx> =~ /^(\d+)\s/) { $mailman::mmfb = $1; $mailman::mmfb++;
print {$mmkz} "$mailman::mmfb 0\n"; } else { close($mmdx); close($mmkz);
mmug($mmdc); goto retry; } while(defined($_ = <$mmdx>)) { print {$mmkz} $_; }
my($mmej) = ''; $mmej .= mmtn(
$mailman::mmm . '@' . $mailman::strIncomingServer . '@' . $mmmq) . '|'; $mmej .=
mmtn($mailman::mmm) . '|'; $mmej .=
mmtn($mailman::strIncomingServer) . '|'; $mmej .=
mmtn($mailman::mmay) . '|'; $mmej .=
mmtn($mailman::in{'CC'}) . '|'; $mmej .= mmtn($mmcm) . '|';
$mmej .= mmtn($mmcn) . '|'; $mmej .=
mmtn(mmtu($mmcn)) . '|'; $mmej .=
mmtn($mmcp) . '|'; $mmej .= mmtn($mmcm) . '|';
$mmej .= $mmmt . '|'; $mmej .= (($mmir eq '') ? 0 : 1) . '|';
$mmej .= (($mmir eq '') ? 0 : 1) . '|'; $mmej .= ''; print {$mmkz} $mmej . "\n";
close($mmdx); close($mmkz); use File::Copy; copy("$mmdy.tmp", $mmdy);
$mailman::mmaf = $mmms; } my($mmbp) = ''; $mmbp = 't_sendconfirm.htm';
$mailman::mmbg{'USERNAME'} = $mailman::mmm;
$mailman::mmbg{'USERNAMEHIDDEN'} = $mailman::mmn;
$mailman::mmbg{'SERVER'} = $mailman::strIncomingServer;
$mailman::mmbg{'SERVERHIDDEN'} = $mailman::mmq;
$mailman::mmbg{'PASSWORDHIDDEN'} = $mailman::mmp;
$mailman::mmbg{'CHECKSUM'} = $mailman::mmy;
$mailman::mmbg{'SUBJECT'} = mmrj($mailman::in{'SUBJECT'});
$mailman::mmbg{'TO'} = mmrj($mailman::in{'TO'});
$mailman::mmbg{'OUTGOING'} = mmrj($mailman::strOutgoingServer);
mmtk($mmbp,\%mailman::mmbg); exit(0); } sub mmtf { my($mmmy) = @_;
my($mmmz) = mmtm($ENV{SERVER_NAME},42); my($mmna) = '';
if($mailman::bUseHijackTest) {
$mmna = mmtm($ENV{REMOTE_HOST} . $ENV{REMOTE_ADDR},69); }
unless($mmmz){ $mmmz = 'NO SERVER'; } unless($mmna){ $mmna = 'NO HOST'; }
my($key) = $mmmz ^ $mmna; if(length($key)==$mmmy) { return($key); }
elsif(length($key)>$mmmy) { return(substr($key,0,$mmmy)); } else {
while(length($key)<$mmmy) { $key = "$key$key"; } return(substr($key,0,$mmmy)); } }
sub mmtg { my($mmnb,$mmnc) = @_; my($mmnd) = '';
unless($mmnc->{'ME'}){ $mmnc->{'ME'} = $mailman::mmz; }
while($mmnb =~ /MailMan\(([^\)]+)\)/) { $mmnd = $mmnc->{$1};
$mmnb =~ s/MailMan\($1\)/$mmnd/g; } return $mmnb; } sub mmth {
my($mmek, $mmnc) = @_; print "Content-type: text/html\n\n"; if(defined($mmnc)) {
my $mmc; foreach $mmc (sort keys %$mmnc) {
print qq|<!-- $mmc: "| . $mmnc->{$mmc} . qq|" -->\n|; } } if(-e $mmek) { print
qq|<html><title>MailMan: Template Can't Be Read</title>\n| .
qq|<body bgcolor="#ffffff">\n| .
qq|<center><h1>MailMan Configuration Error</h1></center>\n| .
qq|<p>The output template "$mmek" exists and was found by the MailMan\n| .
qq|script, but the script does not have permission to read it.</p>\n| .
qq|<p>On most Unix systems, you can go to the directory where MailMan is\n| .
qq|installed and type "chmod 644 $mmek" to solve this problem.  If\n| .
qq|your HTTP server is running in a different operating in a different\n| .
qq|operating system, consult your HTTP server and operating system \n| .
qq|documentation for more information.</p>\n| . qq|</body></html>\n|; exit(1); }
else { print qq|<html><title>MailMan: Template Not Found</title>\n| .
qq|<body bgcolor="#ffffff">\n| .
qq|<center><h1>MailMan Configuration Error</h1></center>\n| .
qq|<p>The output template "$mmek" could not be found by the MailMan \n| .
qq|script.</p><p> Make sure that this template is located where MailMan can \n| .
qq|find it (in the same directory as the script itself on most web servers,\n| .
qq|but not necessarily) and make sure that the web server process has\n| .
qq|permission to read the file.  Consult your HTTP server and operating\n| .
qq|system documentation for more information.</p>\n| . qq|</body></html>\n|;
exit(1); } } sub mmti { my($mmek,$mmne) = @_; my($mmju) = '';
my($mmnf) = new FileHandle(); if(defined($mailman::mmae)) {
$mmek = $mailman::mmae . $mmek; } if(open($mmnf,
"<" . $mailman::strLocalTemplateLocation . $mmek)) { my($mmng) = '';
while(defined($_ = <$mmnf>)) { $mmng .= $_; } close($mmnf); if($mmng =~ 
/MailManSnippet\($mmne\)\s*(.+)\s*EndSnippet\($mmne\)/si) { $mmju = $1;
$mmju =~ s/^\s+(\S.*)$/$1/; $mmju =~ s/^(.*\S)\s+$/$1/; return $mmju; } } $mmju = 
qq|<i><b>Template Error:</b> Snippet "$mmne" not found in | .
qq|template "$mmek"</i>|; return  $mmju; } sub mmtj {
my($mmek,@mmnh) = @_; my(@mmni); my($mmnf) = new FileHandle();
if(defined($mailman::mmae)) { $mmek = $mailman::mmae . $mmek; } if(open($mmnf,
"<" . $mailman::strLocalTemplateLocation . $mmek)) { my($mmng) = '';
while(defined($_ = <$mmnf>)) { $mmng .= $_; } close($mmnf); my($mmne) = '';
foreach $mmne (@mmnh) { if($mmng =~ 
/MailManSnippet\($mmne\)\s*(.+)\s*EndSnippet\($mmne\)/si) { my($mmju) = $1;
$mmju =~ s/^\s+(\S.*)$/$1/; $mmju =~ s/^(.*\S)\s+$/$1/; push(@mmni,$1); } else {
mmqr( qq|<i><b>Template Error:</b> Snippet "$mmne" not found in | .
qq|template "$mmek"</i>|); } } return @mmni; } } sub mmtk {
my($mmek,$mmnc,$mmbo) = @_; my($mmnj) = 0; my($mmnf) = new FileHandle();
if(defined($mailman::mmae)) { $mmek = $mailman::mmae . $mmek; }
unless($mmnc->{'ME'}){ $mmnc->{'ME'} = $mailman::mmz; }
my($mmiy) = localtime(time); $mmnc->{'UNIQUE'} = mmtr($mmiy);
$mmnc->{'EDITION'} = $mailman::strMailManEdition;
$mmnc->{'VERSION'} = $mailman::strMailManVersion; if(open($mmnf,
"<" . $mailman::strLocalTemplateLocation . $mmek)) {
print "Content-type: text/html\n"; my($mmk) = ''; if(defined($mailman::mmn)) {
$mmk .= 'USERNAME' . '#' . $mailman::mmn . '&'; } if(defined($mailman::mmq)) {
$mmk .= 'SERVER' . '#' . $mailman::mmq . '&'; } if(defined($mailman::mmp)) { $mmk .=
'PASSWORD' . '#' . $mailman::mmp . '&'; } if(defined($mailman::mmy)) { $mmk .=
'CHECKSUM' . '#' . $mailman::mmy; }
if(defined($mailman::mmm) && $mailman::mmm ne '') {
print "Set-cookie: MailManAuth=$mmk;" . "$mailman::mmab\n"; } my($mmnk) =
mmtn($mailman::mmaf); if($mailman::mmaf ne '') {
print "Set-cookie: MailManDir=$mmnk;" . "$mailman::mmab\n"; }
if(defined($mailman::mmn)) { $mmnc->{'AUTHENTICATION'} =
qq|<input type="hidden" name="USERNAME" value="$mailman::mmn">|; }
if(defined($mailman::mmq)) { $mmnc->{'AUTHENTICATION'} .=
qq|<input type="hidden" name="SERVER" value="$mailman::mmq">|; }
if(defined($mailman::mmp)) { $mmnc->{'AUTHENTICATION'} .=
qq|<input type="hidden" name="PASSWORD" value="$mailman::mmp">|; }
if(defined($mailman::mmy)) { $mmnc->{'AUTHENTICATION'} .=
qq|<input type="hidden" name="CHECKSUM" value="$mailman::mmy">|; }
$mmnc->{'SETTINGS'} = ''; my($mmnl) = mmtn($mailman::mmaf);
$mmnc->{'SETTINGS'} .= qq|<input type="hidden" name="FOLDER" value="$mmnl">|;
if($mailman::mmac) { $mmnc->{'SETTINGS'} .=
qq|<input type="hidden" name="NOFRAMES" value="TRUE">|; } if($mailman::mmad) {
$mmnc->{'SETTINGS'} .= qq|<input type="hidden" name="NOCACHE" value="TRUE">|; }
if(defined($mailman::mmae)) { $mmnc->{'SETTINGS'} .=
qq|<input type="hidden" name="ALTERNATE_TEMPLATES" | .
qq|value="$mailman::mmae">|; } if($mailman::mmlp) { my($mmnm) = 
mmtn($mailman::mmlp); $mmnc->{'SETTINGS'} .=
qq|<input type="hidden" name="FORWARDATTACHMENTS" | . qq|value="$mmnm">|; }
my($mmb) = 0; my($mmnn) = ''; my($mmah) = ''; foreach $mmah (keys(%mailman::in)) {
if($mmah ne 'USERNAME' && $mmah ne 'SERVER' && $mmah ne 'PASSWORD' &&
$mmah ne 'CHECKSUM' && $mmah ne 'SEND' && $mmah ne 'TEXT' && $mmah ne 'ATTACH' &&
$mmah !~ /^FOLDER/ && $mmah !~ /^PREF\_/ && $mmah !~ /^ADDRESSITEM\_/ &&
$mmah !~ /USERFILE/) { $mmnn .= $mmah . '#' . $mailman::in{$mmah} . '&'; } }
chop($mmnn); if($mailman::mmac) { print "Set-cookie: MailManCmds=$mmnn; " .
"path=$mailman::mmaa;\n"; } if($mailman::mmad) {
print "Expires: Sun, 03 May 1998 16:00:00 GMT\n";
print "Cache-control: no-cache\n"; } print "\n";
if(defined($mailman::strDebug) && ($mmek !~ /t\_f\_frameset/)) { print
qq|<center>\n| . qq|<table bgcolor="#000000" border="2" | .
qq|bordercolor="#000000">\n | .
qq|<tr><td bgcolor="#00FF00" align="center"><font | . qq|color="#000000">\n| .
qq|<b>DEBUG OUTPUT</b></font></td></tr>\n| . qq|<tr><td>\n| .
qq|<font color="#00FF00"><pre>$mailman::strDebug</pre>| .
qq|</font></td></tr></table>\n| . qq|</center>\n|; } while(defined($_ = <$mmnf>)) {
while(/\<\!\-\-\s*MMPRO/i) { s/\<\!\-\-\s*MMPRO//ig; } while(/MMPRO\s*\-\-\>/i) {
s/MMPRO\s*\-\-\>//ig; } while(!$mailman::bKioskMode && /\<\!\-\-\s*NOKIOSKMODE/i) {
s/\<\!\-\-\s*NOKIOSKMODE//ig; }
while(!$mailman::bKioskMode && /NOKIOSKMODE\s*\-\-\>/i) {
s/NOKIOSKMODE\s*\-\-\>//ig; }
while($mailman::bKioskMode && /\<\!\-\-\s*KIOSKMODE/i) {
s/\<\!\-\-\s*KIOSKMODE//ig; }
while($mailman::bKioskMode && /\bKIOSKMODE\s*\-\-\>/i) {
s/\bKIOSKMODE\s*\-\-\>//ig; } while(/MailMan\(([^\)]+)\)/i) { my($mmno) = '';
$mmno = $mmnc->{$1}; if(($1 eq 'TO') or ($1 eq 'SUBJECT') or ($1 eq 'CC')) {
$mmno =~ s/\"/\&quot\;/g; } if(defined($mmno)) { s/MailMan\($1\)/$mmno/ig; } else {
s/MailMan\($1\)//ig; } } if(defined($mailman::strURLImageLocation)) {
s/([\"\`\'])(i\_[^\.]+\.gif[\"\'])/$1${mailman::strURLImageLocation}$2/ig; }
print; $mmnj = 1; } close($mmnf); } else { mmth($mmek, $mmnc); } unless($mmbo) {
exit(0); } } sub mmtl { $mailman::mmr =
"316361365359288371370355317290360372372368314303303375375375302357366" .
"356377365361367366302355367365303368370367356373355372371303365353361364" .
"365353366303365365368370367307351304351304302359361358290288353364372317" .
"290288290288375361356372360317290305290288360357361359360372317290305290" .
"288353364361359366317290364357358372290318"; $mailman::mmr =
pack('C109',grep($_ && ($_ -= 256),split(/(\d\d\d)/, $mailman::mmr)));
$mailman::mmnp = "Unix"; if((defined $^O and $^O =~ /MSWin32/i ||
$^O =~ /Windows_95/i || $^O =~ /Windows_NT/i) || (defined $ENV{OS} and
$ENV{OS} =~ /MSWin32/i || $ENV{OS} =~ /Windows_95/i || $ENV{OS} =~ /Windows_NT/i))
{ $mailman::mmnp = "Windows"; $| = 1; $mailman::mmdm = 1; } if((defined $^O and
$^O =~ /MacOS/i) || (defined $ENV{OS} and $ENV{OS} =~ /MacOS/i)) {
$mailman::mmnp = "Mac" } if (defined $^O and $^O =~ /VMS/i) { $mailman::mmnp = "VMS";
} if($mailman::mmnp eq 'Unix') { } elsif($mailman::mmnp eq 'Mac') { }
elsif($mailman::mmnp eq 'NT') { } } sub mmtm { my($mmnq,$mmnr) = @_;
if($mailman::bUseCrypt) { return crypt($mmnq,$mmnr); } else { return $mmnq; } }
sub mmtn { my($mmnb) = shift;
$mmnb =~ s/(\W)/sprintf("%%%02x", ord($1))/eg; return $mmnb; } sub mmto {
my($mmnb) = shift; $mmnb =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
return $mmnb; } sub mmtp { my($mmnb) = @_; $mmnb =~ s/([^A-Za-z0-9 ])/\\$1/g;
return($mmnb); } sub mmtq { my($mmns) = $ENV{'HTTP_USER_AGENT'}; $_ = $mmns;
if(/(MSIE)\D*(\d+)\.?(\d*)\D?/i) { return ($1,$2,$3); }
elsif(/(Mozilla)\D*(\d+)\.?(\d*)\D?/i) { return ($1,$2,$3); } } sub mmtr {
my($mmnq) =  @_; local $^W = 0; unless(defined($mmnq)){ return; }
my($key) = mmtf(length($mmnq)); my($mmnt) = $mmnq ^ $key;
$mmnt = pack("u*",$mmnt); chop($mmnt);
$mmnt =~ s/(\W)/sprintf("%%%x", ord($1))/eg;
@mailman::mmg = split(/X*/,'!dnoh>0Epe9o86l.7w:ab5y<4Mm3i5C/gfr1-cs2"t \;Tu,v');
$mailman::mmh = join('',@mailman::mmg[
8,34,28,2,41,42,40,23,0,36,36,42,45,4,28,38,42,
8,19,32,9,42,17,19,38,42,8,34,11,1,46,37,9,1,42,
20,22,42,25,19,28,14,25,19,2,42,48,27,8,47,42,
33,34,11,26,42,7,2,1,22,26,28,11,2,42,30,11,34,
8,11,34,19,41,28,11,2,15,42,36,36,5,43,2,40,44]); return "%%%%$mmnt%%%%"; }
sub mmts { my($mmnt) =  @_; unless(defined($mmnt)){ return; }
if($mmnt =~ /\%\%\%\%(.+)\%\%\%\%/) { $mmnt = $1; } else { return $mmnt; }
$mmnt =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$mmnt = unpack("u*",$mmnt); my($key) = mmtf(length($mmnt));
my($mmnq) = $mmnt ^ $key; return $mmnq; } sub mmtt {
my($mmax,$mmnu) = @_; unless(chmod($mmnu, $mmax)) {
mmqr("Could not change the permissions of " .
"\"$mmax\" for unknown reasons."); } } sub mmtu { my($mmcn) = shift;
mmtw(); my($mmnv,$mmnw,$mmnx) = (60, 60, 24);
my($mmny) = ($mmnw * $mmnv); my($mmnz) = ($mmnx * $mmnw * $mmnv);
my($mmoa) = [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]; if($mmcn =~ /
\s*                             (\S+\,?\s+)?                   
($mailman::mmob)\s+  (\d+)\s+                        (\d\d?)\:(\d\d?)\:(\d\d?)\s+
(\S+)\s+                        (\d{2}|\d{4})\s+               
\s*                             /xi) { $mmcn = "$1 $3 $2 $8 $4:$5:$6 $7"; }
my($mmev) = 0; if($mmcn =~ / \s*                            
(\S+\,?\s+)?                    (\d+)\s+                       
($mailman::mmob)\s+  (\d{2}|\d{4})\s+                (\d\d?)\:(\d\d?)\:(\d\d?)\s+
(.*)                            \s*                             /xi) {
my($mmoc) = $4; my($mmod) = $mailman::mmoe{lc($3)}; my($mmof) = $2;
my($mmog,$mmoh,$mmoi) = ($5, $6, $7); my($mmoj) = $8; if(length($mmoc) == 2) {
$mmoc = mmui($mmoc); } my($mmok) = 0;
for($mmok = 1996; $mmok < $mmoc; $mmok++) { if(mmtv($mmok)) {
$mmev += (366 * $mmnz); } else { $mmev += (365 * $mmnz); } } my($mmol) = 0;
for($mmol = 0; $mmol < $mmod; $mmol++) { my($mmom) = $mmoa->[$mmol];
if(($mmol == 1) && mmtv($mmoc)) { $mmom = 29; } $mmev += $mmom * $mmnz; }
$mmev += ($mmof -1) * $mmnz; $mmev += ($mmog - 1) * $mmny;
if($mmoj =~ /([\+\-]\d\d\d\d)/) { $mmoj = $1; } elsif($mmoj =~ /($mailman::mmon)/i) {
$mmoj = $mailman::mmoo{lc($1)}; } else { $mmoj = '+0000'; } if($mmoj =~ /^\-(\d\d)/) {
$mmev += $1 * $mmny; } elsif($mmoj =~ /^\+(\d\d)/) { $mmev -= $1 * $mmny; }
$mmev += $mmoh * $mmnv; $mmev += $mmoi; return $mmev; } return (-1); } sub mmtv {
my($mmoc) = @_; return 0 unless $mmoc % 4 == 0; return 1 unless $mmoc % 100 == 0;
return 0 unless $mmoc % 400 == 0; return 1; } sub mmtw {
return if ($mailman::mmop); $mailman::mmop = 1; my($mmoq) =
[['january','february','march','april','may','june','july',
'august','september','october','november','december'],
['jan','feb','mar','apr','may','jun','jul','aug','sep', 'oct','nov','dec'],
['','','','','','','','','sept']]; mmtx('inorder', $mmoq,
\%mailman::mmoe, \$mailman::mmob); my($mmor) = [[ 'idlw'  => '-1200',  
'nt'    => '-1100',   'hst'   => '-1000',   'cat'   => '-1000',  
'ahst'  => '-1000',   'yst'   => '-0900',   'hdt'   => '-0900',  
'ydt'   => '-0800',   'pst'   => '-0800',   'pdt'   => '-0700',  
'mst'   => '-0700',   'mdt'   => '-0600',   'cst'   => '-0600',  
'cdt'   => '-0500',   'est'   => '-0500',   'edt'   => '-0400',  
'ast'   => '-0400',   'nft'   => '-0330',   'adt'   => '-0300',  
'ndt'   => '-0230',   'at'    => '-0200',   'wat'   => '-0100',  
'gmt'   => '+0000',   'ut'    => '+0000',   'utc'   => '+0000',  
'wet'   => '+0000',   'cet'   => '+0100',   'fwt'   => '+0100',  
'met'   => '+0100',   'mewt'  => '+0100',   'swt'   => '+0100',  
'bst'   => '+0100',   'gb'    => '+0100',   'eet'   => '+0200',  
'cest'  => '+0200',   'fst'   => '+0200',   'mest'  => '+0200',  
'metdst'=> '+0200',   'sst'   => '+0200',   'bt'    => '+0300',  
'eest'  => '+0300',   'eetedt'=> '+0300',   'it'    => '+0330',  
'zp4'   => '+0400',   'zp5'   => '+0500',   'ist'   => '+0530',  
'zp6'   => '+0600',   'nst'   => '+0630',   'hkt'   => '+0800',  
'sgt'   => '+0800',   'cct'   => '+0800',   'awst'  => '+0800',  
'wst'   => '+0800',   'kst'   => '+0900',   'jst'   => '+0900',  
'rok'   => '+0900',   'cast'  => '+0930',   'east'  => '+1000',  
'gst'   => '+1000',   'cadt'  => '+1030',   'eadt'  => '+1100',  
'idle'  => '+1200',   'nzst'  => '+1200',   'nzt'   => '+1200',  
'nzdt'  => '+1300',   'z' => '+0000', 'a' => '-0100', 'b' => '-0200',
'c' => '-0300', 'd' => '-0400', 'e' => '-0500', 'f' => '-0600', 'g' => '-0700',
'h' => '-0800', 'i' => '-0900', 'k' => '-1000', 'l' => '-1100', 'm' => '-1200',
'n' => '+0100', 'o' => '+0200', 'p' => '+0300', 'q' => '+0400', 'r' => '+0500',
's' => '+0600', 't' => '+0700', 'u' => '+0800', 'v' => '+0900', 'w' => '+1000',
'x' => '+1100', 'y' => '+1200' ]]; mmtx('', $mmor, \%mailman::mmoo,
\$mailman::mmon); } sub mmtx { my($mmos,$mmot,$mmou,$mmov) = @_;
my($mmow,$mmox,$mmoy,@mmoz) = (); for($mmow = 0; $mmow <= $#{$mmot}; $mmow++) {
for($mmox = 0; $mmox <= $#{$mmot->[$mmow]}; $mmox++) {
$mmoy = $mmot->[$mmow]->[$mmox]; if($mmoy ne '') { if($mmos =~ /inorder/) {
%{$mmou}->{$mmoy} = $mmox; } else { my($mmpa) = $mmot->[$mmow]->[++$mmox];
%{$mmou}->{$mmoy} = $mmpa; } push(@mmoz,$mmoy); } } } $$mmov = join('|', @mmoz); }
sub mmty { my(@mmpb,@mmpc,@mmpd); opendir(USERDIR, $mailman::mmt);
my(@mmaw) = readdir(USERDIR); closedir(USERDIR); my($mmax) = '';
foreach $mmax (@mmaw) { if($mmax ne '.' && $mmax ne '..' &&
(-d "${mailman::mmt}/${mmax}")) { if($mmax =~ /^INBOX$/i || $mmax =~ /^SENT$/i ||
$mmax =~ /^TRASH$/i) { push(@mmpc,mmto($mmax)); } else {
push(@mmpd,mmto($mmax)); } } } @mmpc = sort(@mmpc); @mmpd =  sort(@mmpd);
@mmpb = (@mmpc, @mmpd); return(@mmpb); } sub mmtz { my($mmfn) = shift;
my($mmdc) =  $mailman::mmt . '/' . mmtn($mmfn);
my($mmdy) = "${mmdc}/msglist"; if(open(MESSAGEINDEX,"<$mmdy")) {
flock(MESSAGEINDEX,2); my($mmbx) = ''; $mmbx = <MESSAGEINDEX>;
if($mmbx =~ /^(\d+)\s+(\d+)\s/) { return($1,$2); } if($mmbx =~ /^(\d+)/) {
return($1,'?'); } close(MESSAGEINDEX); } return(0,0); } sub mmua {
my($mmpe) = @_; unless(defined($mmpe)) { $mmpe = ''; } my($mmcd) = '';
my(@mmfl) = mmty(); unless(defined($mmpe) && length($mmpe)) { $mmcd .=
"<option value=\"MAILMANSPECIALSELECT\">Select Folder\n"; } my($mmfn) = '';
foreach $mmfn (@mmfl) { if(($mmfn ne $mailman::mmaf) || length($mmpe)) {
my($mmpf) = mmrj($mmfn); my($mmpg) = $mmfn; if($mmfn eq $mmpe) { $mmcd .=
"<option value=\"$mmpg\" selected>" . "$mmpf\n"; } else { $mmcd .=
"<option value=\"$mmpg\">" . "$mmpf\n"; } } } return($mmcd); } sub mmub {
use File::Find; $mailman::mmdk = 0;
find(\&mmuc,$mailman::mmt); return $mailman::mmdk; }
sub mmuc { $mailman::mmdk += -s $_; } sub mmud {
use File::Find; $mailman::mmph = 0; $mailman::mmpi = 0; $mailman::mmpj = 0;
find(\&mmue,$mailman::strLocalLocationUsers);
unless($mailman::mmpk){ $mailman::mmpk = '0'; }
print "\nThis installation has a total of:\n".
"Users:         $mailman::mmph\n" . "Messages:      $mailman::mmpi\n" .
"Message bytes: $mailman::mmpj\n" .
"\nTotal message database errors: $mailman::mmpk\n"; return; } sub mmue {
unless(-d $_) { return; } if($_ eq '.') { return; }
my($mmpl) = my($mmpm) = "$mmpn::Find::dir/$_";
$mmpl =~ s/$mailman::strLocalLocationUsers//g; my(@mmpo) = split(/[\/\\]/,$mmpl);
if($#mmpo == 0) { $mailman::mmph++;
print "\n########################################\n";
print "Verifying user \"" .  mmto($mmpo[0]) . "\"\n"; } else {
print "Verifying folder \"" . mmto($mmpo[$#mmpo]) . "\" for user \"" . 
mmto($mmpo[0]) . "\"\n"; my($mmfn) = $_; if(mmuf($mmfn)) {
$mailman::mmpk++; if($mailman::mmpp) { print "Problems detected, fixing...\n";
mmug($mmfn); } } } } sub mmuf { my($mmfn) = @_;
my($mmdx) = new FileHandle(); my($mmdy) = "$mmfn/msglist";
unless(open($mmdx,"<$mmdy")) { opendir(USERDIR, $mmfn);
my(@mmaw) = readdir(USERDIR); closedir(USERDIR); my($mmax) = ''; my($mmpq) = 0;
foreach $mmax (@mmaw) { if($mmax ne '.' && $mmax ne '..') { $mmpq++; }    } if($mmpq) {
print "ERROR: Could not find or could not open index file.\n"; return 1; } else {
print "  No messages in this folder.\n"; return 0; } } flock($mmdx,2); my($mmcg) = 0;
if(<$mmdx> =~ /^(\d+)\s/) { $mmcg = $1; } else {
print "ERROR: Your message index file appears to be corrupt,\n" .
"       the total number of messages is missing.\n"; return 1; } my($mmdu) = 0;
my($mmpr) = 0; my($mmps) = 0; my($mmpt) = 0; while(defined($_ = <$mmdx>)) { chomp;
if(/^([^\|]+)\|/ && mmqx($_)) { my($mmax) = $1;
unless(-f "$mmfn/$mmax") { print "ERROR: The file for the message\n" .
"       \"$mmax\" does not exist.\n"; close($mmdx); return 1; } my($mmpu) = 0;
$mmpu = (-s "$mmfn/$mmax"); unless($mmpu) {
print "ERROR: The file for the message\n" .
"       \"$mmax\" exists, but is zero bytes.\n"; close($mmdx); return 1; } else {
$mmpt += $mmpu; } $mmdu++; } elsif(/^DELETED\:\s+(\S+)\s*$/) { $mmpr++; }
elsif(/^\S+\:\s+(\S+)\s*$/) { $mmps++; } } if($mmdu != $mmcg) {
print "ERROR: The message index file appears to be corrupt,\n" .
"       the number of messsages in the file\n" .
"       ($mmdu) does not match\n" .
"       the number given in the total message number\n" .
"       field ($mmcg).\n"; return 1; } close($mmdx);
print "  Folder contains $mmdu messages that consume\n" .
"    a total of $mmpt bytes, all verified to exist and\n" .
"    contain data.\n";
print "  Folder also contains markers for $mmpr deleted\n" .
"    messages and $mmps moved or otherwise marked messages.\n";
$mailman::mmpi += $mmdu; $mailman::mmpj += $mmpt; return 0; } sub mmug {
my($mmfn) = @_; my($mmpv) = ''; my($mmdx) = new FileHandle(); my(%mmpw);
my($mmpx) = 0; my($mmdy) = "$mmfn/msglist"; if(open($mmdx,"<$mmdy")) {
flock($mmdx,2); <$mmdx>; while(defined($_ = <$mmdx>)) { chomp;
if(/^([^\|]+)\|/ && mmqx($_)) { my($mmdz) = mmto($1);
$mmpw{$mmdz} = $mailman::mmct; if($mailman::mmct =~ /R/i) { $mmpx++; } }
elsif(/^DELETED\:\s+(\S+)\s*$/) { $mmpv .= $_ . "\n"; } elsif(/^\S+\:\s+(\S+)\s*$/) {
$mmpv .= $_ . "\n"; } } close($mmdx); } opendir(USERDIR, $mmfn);
my(@mmaw) = readdir(USERDIR); closedir(USERDIR); my($mmax) = ''; my($mmpq) = 0;
my($mmel) = new FileHandle; my(%mmpy) = (); file: foreach $mmax (@mmaw) {
if($mmax ne '.' && $mmax ne '..') { my($mmpz) = 0; $mmpz = (-s "$mmfn/$mmax");
if(open($mmel,"<$mmfn/$mmax")) { mmrg($mmel); close($mmel);
if($mailman::mmay eq 'Unknown' && $mailman::mmcm eq 'Unknown' &&
$mailman::mmcn eq 'Unknown') { next file; } $mailman::mmck = mmto($mmax);
$mailman::mmcf = $mmpz; if(defined($mmpw{$mailman::mmck})) { $mailman::mmct =
$mmpw{$mailman::mmck}; } else { $mailman::mmct = ''; } my($mmej) =
mmqw(undef,undef); my($mmea) = $mailman::mmco; my($mmeb) = 0;
while(defined($mmpy{$mmea})) { if($mmea =~ s/^([^\_]*)\_(\d+)/$1/) { $mmeb++; }
$mmea .= "_$mmeb"; } $mmpy{$mmea} = $mmej; $mmpq++; } } } if(open($mmdx,">$mmdy")) {
flock($mmdx,2); print {$mmdx} $mmpq . " " . ($mmpq - $mmpx) . "\n"; my($mmev) = 0;
foreach $mmev (sort keys %mmpy) { print {$mmdx} "$mmpy{$mmev}\n"; }
print {$mmdx} $mmpv; close($mmdx); } } sub mmuh { my $mmqa = '';
my $mmqb = 1; if(defined($mailman::strUsernameMappingFileName)) {
my($mmqc) = new FileHandle();
if(open($mmqc, "<$mailman::strUsernameMappingFileName")) {
while(defined($_ = <$mmqc>)) { if(/^([^\#]\S+)\s+(\S+)$/) { my $mmm = $1;
my $mmqd = $2; if($mmm eq $mailman::mmm) { $mmqa = $mmqd; $mmqb = 0; close($mmqc);
break; } } } } } if($mmqb && defined($mailman::bUsernameIsEmailAddress)) {
$mmqa = $mailman::mmm; } elsif($mmqb && defined($mailman::strFromDomainName)) {
$mmqa = $mailman::mmm . '@' . mmul($mailman::strFromDomainName); }
elsif($mmqb) { $mmqa = $mailman::mmm . '@' .
mmul($mailman::strIncomingServer); } return $mmqa; }
sub mmui { my($mmqe) = shift;
my($mmhy,$mmhz,$mmia,$mmib,$mmic,$mmid,$mmie,$mmif,$mmig) = gmtime(time);
$mmid += 1900; my($mmqf) = $mmid-50; my($mmqg) = $mmqf+99; my($mmqh) = "19$mmqe";
while($mmqh < $mmqf) { $mmqh += 100; } while($mmqh > $mmqg) { $mmqh -= 100; }
return $mmqh; } sub mmuj { use File::Path; my($mmqi) = 0;
$mmqi = rmtree($mailman::mmu,0,1); } sub mmuk { my($mmqj,$mmbv) = @_;
my($mmqk); pos($mmqj) = 0; while($mmqj =~ /(.{1,45})/gs) {
$mmqk .= substr(pack('u', $1), 1); chop($mmqk); } $mmqk =~ tr/` -_/AA-Za-z0-9+\//;
my($mmql) = (3 - length($mmqj) % 3) % 3;
$mmqk =~ s/.{$mmql}$/'=' x $mmql/e if $mmql; $mmqk =~ s/(.{1,76})/$1$mmbv/g;
return $mmqk; } sub InitializeVars {
 @mailman::mmg = (); @mailman::mmai = ();
@mailman::mmik = (); @mailman::mmdn = (); @mailman::mmcj = (); $mailman::mmw = 0;
$mailman::mmcs = 0; $mailman::mmi = 0; $mailman::mmop = 0;
$mailman::bKioskMode = 0; $mailman::mmbl = 0; $mailman::mmcr = 0;
$mailman::mmad = 0; $mailman::mmac = 0; $mailman::mmap = 1; $mailman::mmaq = 0;
$mailman::mmar = 0; $mailman::mmas = 0; $mailman::mmat = 0;
$mailman::bUseAlarm = 0; $mailman::bUseCrypt = 0; $mailman::bUseHijackTest = 0;
%mailman::mmbe = (); %mailman::mmba = (); %mailman::mmoe = (); %mailman::mmoo = ();
%mailman::mmbg = (); $mailman::mmfy = 0; $mailman::mmfu = 0; $mailman::mmep = 0;
$mailman::mmce = 0; $mailman::mmcf = 0; $mailman::iMessagesPerPage = 0;
$mailman::mmfb = 0; $mailman::mmao = 0; $mailman::iTimeoutDurationInSeconds = 0;
$mailman::mmdk = 0; $mailman::mmnp = 0; $mailman::mmr = ''; $mailman::mmcx = '';
$mailman::mmcw = ''; $mailman::mmh = ''; $mailman::mmcl = ''; $mailman::mmkx = '';
$mailman::mmx = ''; $mailman::mmy = ''; $mailman::mmab = ''; $mailman::mmaf = '';
$mailman::mml = ''; $mailman::mmcn = ''; $mailman::mmqm = ''; $mailman::mmlp = '';
$mailman::mmcm = ''; $mailman::mmex = ''; $mailman::mmdb = ''; $mailman::mmcz = '';
$mailman::mmda = ''; $mailman::mmcy = ''; $mailman::mmen = ''; $mailman::mmq = '';
$mailman::strLocalLocationUsers = ''; $mailman::strLocalScriptLocation = '';
$mailman::strLocalTemplateLocation = ''; $mailman::mmz = ''; $mailman::mmaa = '';
$mailman::mmbj = ''; $mailman::mmbk = ''; $mailman::mmct = ''; $mailman::mmp = '';
$mailman::mmal = ''; $mailman::mmfs = ''; $mailman::mman = ''; $mailman::mmak = '';
$mailman::mmam = ''; $mailman::mmau = ''; $mailman::mmob = ''; $mailman::mmon = '';
$mailman::mmcq = ''; $mailman::mmco = ''; $mailman::mmeo = ''; $mailman::mmcp = '';
$mailman::mmbq = ''; $mailman::mmay = ''; $mailman::mmck = ''; $mailman::mmt = '';
$mailman::mmn = ''; unless(defined($ENV{'HTTP_COOKIE'})){$ENV{'HTTP_COOKIE'}='';}
unless(defined($ENV{'HTTP_USER_AGENT'})){$ENV{'HTTP_USER_AGENT'}='Debug';}
unless(defined($ENV{'OS'})){$ENV{'OS'}='';}
unless(defined($ENV{'REMOTE_HOST'})){$ENV{'REMOTE_HOST'}='Debug';}
unless(defined($ENV{'REMOTE_ADDR'})){$ENV{'REMOTE_ADDR'}='Debug';}
unless(defined($ENV{'SCRIPT_NAME'})){$ENV{'SCRIPT_NAME'}='Debug';}
unless(defined($ENV{'SERVER_NAME'})){$ENV{'SERVER_NAME'}='Debug';} }
sub mmul { my($mmqn) = shift; my($mmb);
for($mmb=0;$mmb<$mailman::iFromDomainTrim;$mmb++) { $mmqn =~ s/^[^\.]+\.(.*)$/$1/;
} return $mmqn; }