#!/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, Standard Edition, version 3.2.9
#
# 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:  6/20/2002 Version 3.2.9
############################################################################

# 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.2.9';
$mailman::strMailManEdition = 'Standard 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.
############################################################################

# 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";
#    "-----------------------------------------------\n" .
#    "This message was sent using Pulcinella MailMan.\n" .
#    "http://www.pulcinella.it\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 = 'itb.it';

# Outgoing Mail Server:
# Same deal, different server.
$mailman::strOutgoingServer = 'itb.it';

# 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 = "itb.it";

# 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.
$mailman::iMessagesPerPage = 50;

# 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.endymion.com/';

# 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/";
$mailman::strLocalTemplateLocation = "/home/pulcinella/mailman/";

# 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/';
$mailman::strURLImageLocation = 'http://www.pulcinella.it/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 = '%m/%d/%Y %H:%M';

# 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.
# This value will only matter if you set
# $mailman::strLocalLocationAttachments and 
# $mailman::strURLLocationAttachments, of course.
$mailman::iLocalFilePermissions = 0600;

# Local Directory Permissions
# Same as above, used for directories created by MailMan.
# This value will only matter if you set
# $mailman::strLocalLocationAttachments and 
# $mailman::strURLLocationAttachments, of course.
$mailman::iLocalDirectoryPermissions = 0700;

# 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 = 30;

############################################################################
# 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="([^"]+)"/i; #";   # find boundary
    ($boundary) = $type =~ /boundary=(\S+)/i 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} = mmmv($2); } else {
$mailman::in{$mmd} = 'MAILMANSPECIALTRUE'; } delete($mailman::in{$mmc}); } else {
if($mmc =~ /^([^\#]+)\#(.*)$/) { $mailman::in{$1} = mmmv($2); } } } }
if($mailman::in{'INTERFACE'}) { my(@mme) = split(/\&/,$mailman::in{'INTERFACE'});
my($mmf) = ''; foreach $mmf (@mme) { if($mmf =~ /^([^\=]+)\=(.*)$/) {
$mailman::in{$1} = mmmv($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; } } } } }
$mailman::mml = mmmz($mailman::in{'USERNAME'});
$mailman::mml =~ s/^\s*([^\s]+)\s*$/$1/;  if($mailman::mmm) {
$mailman::mml =~ tr/[A-Z]/[a-z]/; } $mailman::mmn = mmmy($mailman::mml);
$mailman::mmo = mmmz($mailman::in{'PASSWORD'});
$mailman::mmo =~ s/^\s*([^\s]+)\s*$/$1/; 
$mailman::mmp = mmmy($mailman::mmo); unless($mailman::strIncomingServer) {
$mailman::strIncomingServer =  mmmz($mailman::in{'SERVER'});
$mailman::strIncomingServer =~ s/^\s*([^\s]+)\s*$/$1/; 
$mailman::strIncomingServer =~ tr/[A-Z]/[a-z]/;  }
$mailman::mmq = mmmy($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 = '';
if(defined($mailman::strLocalLocationAttachments) &&
defined($mailman::strURLLocationAttachments)) {
unless($mailman::strLocalLocationAttachments =~ /[\/\\]$/) {
$mailman::strLocalLocationAttachments .= '/'; }
unless($mailman::strURLLocationAttachments =~ /[\/\\]$/) {
$mailman::strURLLocationAttachments .= '/'; } $mailman::mms =
$mailman::strLocalLocationAttachments . mmmu($mailman::mml .
'@' . $mailman::strIncomingServer); $mailman::mmt =
$mailman::strURLLocationAttachments . mmmu(
mmmu($mailman::mml . '@' . $mailman::strIncomingServer));
$mailman::mmu = 1; } $mailman::mmv = mmmt($ENV{SERVER_NAME},42);
$mailman::mmv .= mmmt($ENV{REMOTE_HOST} . $ENV{REMOTE_ADDR},69);
$mailman::mmw = mmmy($mailman::mmv); mmms();
$mailman::mmx = $ENV{SCRIPT_NAME}; unless($mailman::mmx =~ /^\//) {
$mailman::mmx = "/$mailman::mmx"; } $mailman::mmy = $mailman::mmx;
$mailman::mmy =~ s/^(.*[\\\/])[^\\\/]+$/$1/; if($mailman::mmy eq '/') {
$mailman::mmz = ''; } else { $mailman::mmz = "path=$mailman::mmy; "; }
sub mmla { if($mailman::in{'NOFRAMES'}) { $mailman::mmaa = 1; }
if($mailman::in{'NOCACHE'}) { $mailman::mmab = 1; }
if(defined($mailman::in{'ALTERNATE_TEMPLATES'})) { $mailman::mmac = 
$mailman::in{'ALTERNATE_TEMPLATES'}; $mailman::mmac =~ s/^[\\\/](.+)$/$1/;
$mailman::mmac =~ s/\.\.[\/\\]//; $mailman::mmac =~ s/\x00//g; } }
sub mmlb { my($mmad) = shift; my($mmb) = 0; my($mmc);
foreach $mmc (keys(%mailman::in)) { if($mmc =~ /^$mmad\:(.*)$/) { return $1; } }
return; } mmla(); mmlc(); { my($mmh) = '';
@mailman::mmg = split(/\;/,$ENV{'HTTP_COOKIE'});
foreach $mailman::mmh (@mailman::mmg) { if($mailman::mmh =~ /MailManCmds\=(\S+)/) {
my($mmae) = ''; @mailman::mmaf = split(/\&/,$1); foreach $mmae (@mailman::mmaf) {
$mmae =~ /^(.+)\#(.+)$/; unless($mailman::in{$1}) { $mailman::in{$1} = $2; } } } } }
mmla(); mmlc(); mmlf();
sub mmlc { my($mmag) = ''; if($mailman::in{'BLANK'}) {
mmmr('t_blank.htm'); } if($mailman::in{'MENU'}) {
mmmr('t_f_menu.htm'); } if($mailman::in{'LOGOUT'}) { if($mailman::mmu) {
mmnh(); } if($mailman::bKioskMode) {
print "Set-cookie: MailManAuth=;$mailman::mmz" .
"expires=Sun, 03-May-1998 16:00:00 GMT\n";
print "Set-cookie: MailManCmds=;$mailman::mmz" .
"expires=Sun, 03-May-1998 16:00:00 GMT\n";
print "Set-cookie: MailManDir=;$mailman::mmz" .
"expires=Sun, 03-May-1998 16:00:00 GMT\n"; $mailman::mml = '';
mmmr('t_closewindow.htm'); } else { if($mailman::strURLRedirectLocation) {
print "Set-cookie: MailManAuth=;$mailman::mmz" .
"expires=Sun, 03-May-1998 16:00:00 GMT\n";
print "Set-cookie: MailManCmds=;$mailman::mmz" .
"expires=Sun, 03-May-1998 16:00:00 GMT\n";
print "Set-cookie: MailManDir=;$mailman::mmz" .
"expires=Sun, 03-May-1998 16:00:00 GMT\n";
print "Location: $mailman::strURLRedirectLocation\n\n"; } else { mmlf(); }
} } if($mailman::in{'START'}) { mmlf(); } if($mailman::in{'LOGIN'}) {
my($mmah) = ''; if($mmah = mmlh()) { if(defined($mmah)) {
$mmah =~ s/\-ERR//; } $mailman::bKioskMode = 0; $mailman::mmai{'GREETING'} = 
qq|<div align="center"><b>Log In Error: | . qq|</b><i>$mmah</i></div>|;
mmmr('t_login.htm',\%mailman::mmai); }
 if($mailman::mmu) {
mmnh(); } if($mailman::mmaa) { mmlr(); } else {

 mmmr('t_f_frameset.htm');
 } }
if($mailman::bUseHijackTest &&  $mailman::in{'CHECKSUM'} && 
$mailman::in{'CHECKSUM'} ne '') {
if(mmmz($mailman::in{'CHECKSUM'}) ne $mailman::mmv) { mmld(
qq|Your MailMan session was initiated from a different | .
qq|network address than your current location.  For | .
qq|security reasons, MailMan will not continue. | .
qq|You must <a href="MailMan(ME)?LOGOUT=TRUE" | .
qq|target="_top">log in again</a> from this location | . qq|to continue.|); } }
if($mailman::in{'RELOAD'}) { if($mailman::mmaa) { mmlr(); } else {
mmmr('t_f_frameset.htm'); } } if($mmag = mmlb('LIST')) {
mmlr($mmag); } if($mailman::in{'LIST'}) { mmlr(); }
my($mmaj) = $mailman::in{'BACKGROUND'}; if($mmaj) { if($mailman::mmaa) {
print "Location: $mmaj\n\n"; exit(0); } else { mmlq($mmaj); } }
if($mmaj = $mailman::in{'BACKGROUNDFRAME'}) {
mmmr('t_backgroundframe.htm'); } if($mmag = mmlb('SHOW')) {
my($mmak) = -1; if($mmag =~ /^(.+)mimepart\:(.+)$/) { $mmak = $1;
$mailman::mmal = $2; $mailman::mmal =~ s/%(..)/pack("c",hex($1))/ge; }
elsif($mmag =~ /^(.+)cid\:(.+)$/) { $mmak = $1; $mailman::mmam = $2;
$mailman::mmam = mmmv($2); } else { $mmak = $mmag; }
$mmak = mmmv($mmak); $mmak = mmlo($mmak); mmme($mmak,0); }
if($mmag = mmlb('SOURCE')) { my($mmak) = mmmv($mmag);
$mmak = mmlo($mmak); mmmf($mmak); }
if($mmag = mmlb('PREV')) { my($mmak) = mmmv($mmag);
$mmak = mmlo($mmak); mmme($mmak,-1); }
if($mmag = mmlb('NEXT')) { my($mmak) = mmmv($mmag);
$mmak = mmlo($mmak); mmme($mmak,1); }
if($mmag = mmlb('DELETE')) { my($mmah) = mmlh(); if($mmah) {
mmld($mmah); } my($mmak) = mmmv($mmag); $mmak = mmlo($mmak);
mmmh($mmak); mmlg($mma,"QUIT"); close $mma; $mailman::mman = 0;
if($mailman::mmaa) { mmlr(); } else { mmmr('t_f_frameset.htm');
} } if($mailman::in{'DELETEMARKED'}) { my($mmah) = ''; if($mmah = mmlh())
{ mmld($mmah); } my($mmb) = 0; my($mmc); foreach $mmc (keys(%mailman::in)) {
if($mmc =~ /^MARK\:(.*)$/) { my($mmak) = mmmv($1);
$mmak = mmlo($mmak); mmmh($mmak); } } mmlg($mma,"QUIT");
close $mma; $mailman::mman = 0; if($mailman::mmaa) { mmlr(); } else {
mmmr('t_f_frameset.htm'); } } if($mmag = mmlb('MOVE')) {
my($mmao) =  mmmu($mailman::in{'FOLDERTRANSFERLIST'});
if($mmao eq 'MAILMANSPECIALSELECT' || $mmao eq '') { mmlr(); }
my($mmah) = ''; if($mmah = mmlh()) { mmld($mmah); }
my($mmak) = mmmv($mmag); $mmak = mmlo($mmak);
if(CopyMessageToFolder($mmak,$mmao)) { RemoveMessageFromFolder($mmak,'MOVED'); }
mmlg($mma,"QUIT"); close $mma; $mailman::mman = 0; if($mailman::mmaa) {
mmlr(); } else { mmmr('t_f_frameset.htm'); } }
if($mailman::in{'MOVEMARKED'}) { my($mmao) =
mmmu($mailman::in{'FOLDERTRANSFERLIST'});
if($mmao eq 'MAILMANSPECIALSELECT' || $mmao eq '') { mmlr(); }
my($mmah) = ''; if($mmah = mmlh()) { mmld($mmah); } my($mmb) = 0;
my($mmc); foreach $mmc (keys(%mailman::in)) { if($mmc =~ /^MARK\:(.*)$/) {
my($mmak) = mmmv($1); $mmak = mmlo($mmak);
if(CopyMessageToFolder($mmak,$mmao)) { RemoveMessageFromFolder($mmak,'MOVED'); } } }
mmlg($mma,"QUIT"); close $mma; $mailman::mman = 0; if($mailman::mmaa) {
mmlr(); } else { mmmr('t_f_frameset.htm'); } }
if($mailman::in{'NEW'}) { $mailman::in{'ATTACH'} = 0;
my $mmap = ($mailman::in{'MAILTO'}) ?
mmmv($mailman::in{'MAILTO'}) : undef;
mmmi('NEW', 0, 0, $mmap); } if($mailman::in{'USEATTACH'}) {
$mailman::in{'ATTACH'} = 1; mmmj(''); }
if($mmag = mmlb('REPLY')) { my($mmak) = mmmv($mmag);
$mmak = mmlo($mmak); mmmi($mmak,0,0); }
if($mmag = mmlb('REPLYALL')) { my($mmak) = mmmv($mmag);
$mmak = mmlo($mmak); mmmi($mmak,1,0); }
if($mmag = mmlb('FORWARD')) { my($mmak) = mmmv($mmag);
$mmak = mmlo($mmak); mmmi($mmak,0,1); } if($mailman::in{'SEND'}) {
mmml(); } if($mailman::in{'HELP'}) { mmmr('t_help.htm'); } }
sub mmld { my($mmaq,$mmar) =  @_; my($mmas) = ''; if($mmaq eq "ALRM") {
if($mailman::bUseAlarm){ alarm(0); } $mmaq = $mailman::mmat;
mmlg($mma,"QUIT"); close $mma; } if($mailman::mmaa) {
$mmas = 't_nf_error.htm'; } else { $mmas = 't_f_error.htm'; } my(%mmai);
$mmai{'ERROR'} = $mmaq; mmmr($mmas,\%mmai); unless($mmar) { exit(1); } }
sub mmle { my($mmau) =  @_; my($mmas) = ''; print CGI->multipart_start();
if($mailman::mmaa) { $mmas = 't_nf_status.htm'; } else { $mmas = 't_f_status.htm'; }
my(%mmai); $mmai{'STATUS'} = $mmau; mmmr($mmas,\%mmai);
print CGI->multipart_end(); } sub mmlf {
print "Set-cookie: MailManAuth=;$mailman::mmz" .
"expires=Sun, 03-May-1998 16:00:00 GMT\n";
print "Set-cookie: MailManCmds=;$mailman::mmz" .
"expires=Sun, 03-May-1998 16:00:00 GMT\n";
print "Set-cookie: MailManDir=;$mailman::mmz" .
"expires=Sun, 03-May-1998 16:00:00 GMT\n";
print "Expires: Sun, 03 May 1998 16:00:00 GMT\n"; $mailman::mml = '';
$mailman::mmav = ''; if($mailman::bKioskMode) { my($mmaw) = '';
($mailman::mmai{'GREETING'},$mmaw) = mmmq('t_login.htm',
('GREETING','KIOSKMODESCRIPT')); $mailman::mmai{'HTMLCOMMENTBEGIN'} = '<!-- ';
$mailman::mmai{'HTMLCOMMENTEND'} = ' -->'; $mailman::mmai{'KIOSKMODESCRIPT'} =
mmmn($mmaw,\%mailman::mmai);
$mailman::mmai{'HTMLCOMMENTBEGIN'} = ''; $mailman::mmai{'HTMLCOMMENTEND'} = ''; }
else { $mailman::mmai{'GREETING'} =
mmmp('t_login.htm','GREETING'); }


mmmr('t_login.htm',\%mailman::mmai);
 } sub mmlg {
my($mmaz) = "\015\012"; my($mmba, $mmbb) = @_; my($mmbc) = length($mmbb . $mmaz);
syswrite($mmba,$mmbb . $mmaz,$mmbc); } sub mmlh {
if($mailman::mman){ return; } my($mmbd); unless(defined($mailman::mml) &&
$mailman::mml 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::mmat =
"Connection to server timed out."; $SIG{'ALRM'} = \&mmld;
alarm($mailman::iTimeoutDurationInSeconds); } my($mmbe) = 0;
$mmbe = getprotobyname('tcp'); socket($mma,PF_INET,SOCK_STREAM,$mmbe);
my($mmbf) = 0; $mmbf = gethostbyname($mailman::strIncomingServer); unless($mmbf) {
return("Could not find an IP address for the host " .
"\"$mailman::strIncomingServer\"."); } my($mmbg) = '';
$mmbg = sockaddr_in(110, $mmbf); unless(connect($mma, $mmbg)) {
return("Could not connect to server " .
"\"$mailman::strIncomingServer\", \"$!\""); } select($mma); $|=1; select(STDOUT);
binmode($mma); $mailman::mmat = "The server connected, but will not respond.";
if($mailman::bUseAlarm){ alarm($mailman::iTimeoutDurationInSeconds); }
unless(<$mma> =~ /^\+OK/) { return("The server does not respond appropriately."); }
$mailman::mmat = "The server timed out during login.";
if($mailman::bUseAlarm){ alarm($mailman::iTimeoutDurationInSeconds); }
mmlg($mma,"USER $mailman::mml"); my($mmbh) = ''; $mmbh = <$mma>;
unless($mmbh =~ /^\+OK/) { return($mmbh); } mmlg($mma,"PASS $mailman::mmo");
$mmbh = <$mma>; unless($mmbh =~ /^\+OK/) { if((($mmbh =~ /another session/i) ||
($mmbh =~ /another POP3 session/i) || ($mmbh =~ /mailbox in use/i) ||
($mmbh =~ /unable to lock/i) || ($mmbh =~ /mailbox busy/i)) && $mmbd < 12) {
mmlg($mma,"QUIT"); close $mma; $mmbd++; sleep(5); goto retrylogin; } else {
return "Access denied: $mmbh"; } return($mmbh); } if($mailman::bUseAlarm) { alarm(0); }
mmlg($mma,'STAT'); $mmbh = <$mma>; $mmbh =~ /^\+OK\s+(\d+)\s+/i;
$mailman::mmbi = $1; if($mailman::mmbi == 0) { $mailman::mman = 1; return; }
mmlg($mma,"LIST"); $mmbh = <$mma>; unless($mmbh =~ /^\+OK/) { return($mmbh);
} $mailman::mmbi = 0; while(<$mma> =~ /(\d+) (\d+)/) { $mailman::mmbj[$1] = $2;
$mailman::mmbi++; } $mailman::mman = 1; return; } sub mmli {
my($mmbk) =  @_; $mailman::mmat = "The server timed out fetching a header.";
if($mailman::bUseAlarm){ alarm($mailman::iTimeoutDurationInSeconds); }
mmlg($mma,"TOP $mmbk 0"); my($mmbh) = ''; $mmbh = <$mma>;
unless($mmbh =~ /^\+OK/) { mmlg($mma,"RETR $mmbk"); my($mmbh) = '';
$mmbh = <$mma>; unless($mmbh =~ /^\+OK/) { mmld($mmbh); } }
mmlj($mma); $mailman::mmbl = $mmbk . 'H' . $mailman::mmbm;
$mailman::mmbn = $mmbk; } sub mmlj { my($mmba) = shift;
$mailman::mmbo = ''; $mailman::mmbp = ''; $mailman::mmbq = ''; $mailman::mmbr = '';
$mailman::mmbs = '0'; $mailman::mmbt = ''; $mailman::mmbu = '';
$mailman::mmbm = ''; $mailman::mmbv = 0; $mailman::mmbw = 0; my($mmbx) = 0;
my($mmby) = 0; my($mmbz) = 0; my($mmca) = 0; my($mmcb) = 1; my($mmcc) = '';
my($mmcd) = -1; while(defined($_ = <$mmba>)) { if(/^[\r\n]+$/){ $mmbx = 1; }
if(/^\.[\r\n]*$/){ last; } if(/^Content-type\:\s+([^\;\s]+)[\;\s]/i) {
my($mmce) = $1; if( ($mmce !~ /multipart\/alternative/i) && ($mmce !~ /text\//i)) {
$mailman::mmbw = 1; } } if(/^begin \d\d\d (\S+)\s*$/i) { $mailman::mmbw = 1; }
if(/^X\-Mailer\: Crescent Internet ToolPak ActiveX Mail Control/i) {
$mailman::mmbw = 1; } unless($mmbx) { $mmcb = 1;
if(/^To\:\s*(.+)$/i || ((/^\s(.+)$/) && $mmby)) { $mailman::mmbo .= $1;
$mailman::mmbo =~ s/^(.*)[\r\n]+$/$1/;
$mailman::mmbo = mmlk($mailman::mmbo); $mmcc .= $_; $mmby = 1; $mmca = 0;
$mmbz = 0; $mmcb = 0; } if(/^CC\:\s*(.+)$/i || ((/^\s(.+)$/) && $mmca)) {
$mailman::mmbp .= $1; $mailman::mmbp =~ s/^(.*)[\r\n]+$/$1/;
$mailman::mmbp = mmlk($mailman::mmbp); $mmcc .= $_; $mmby = 0; $mmca = 1;
$mmbz = 0; $mmcb = 0; } if(/^From\:\s*(.+)$/i || ((/^\s(.+)$/) && $mmbz)) {
$mailman::mmbq .= $1; $mailman::mmbq =~ s/^(.*)[\r\n]+$/$1/;
$mailman::mmbq = mmlk($mailman::mmbq); $mmcc .= $_; $mmby = 0; $mmca = 0;
$mmbz = 1; $mmcb = 0; } if(/^Date\:\s*(.+)$/i) { $mailman::mmbr = $1;
$mailman::mmbr =~ s/^(.*)[\r\n]+$/$1/; $mmcc .= $_; } if(/^Subject\:\s*(.+)$/i) {
$mailman::mmbt = $1; $mailman::mmbt =~ s/^(.*)[\r\n]+$/$1/;
$mailman::mmbt = mmlk($mailman::mmbt); $mmcc .= $_; }
if(/^Reply-To\:\s*(.+)$/i) { $mailman::mmbu = $1;
$mailman::mmbu =~ s/^(.*)[\r\n]+$/$1/; $mmcc .= $_; } if(/^Message-ID\:\s*(.+)$/i) {
$mailman::mmbm = $1; $mailman::mmbm =~ s/^(.*)[\r\n]+$/$1/; }        if($mmcb) {
$mmby = 0; $mmca = 0; $mmbz = 0; } } if(/^MIME-Version\:\s*1\.0/i) { if(!$mmbx) {
$mailman::mmbv = 1; } } } if($mailman::mmbm eq "") { $mailman::mmbm = $mmcc;
while(length($mailman::mmbm)>20) {
$mailman::mmbm = (substr($mailman::mmbm,0,20) ^  substr($mailman::mmbm,20)); }
$mailman::mmbm = pack("u*",$mailman::mmbm); }
$mailman::mmbm =~ s/(\W)/sprintf("%%%x", ord($1))/eg;
unless($mailman::mmbo){ $mailman::mmbo = "Unknown";}
unless($mailman::mmbq){ $mailman::mmbq = "Unknown";}
unless($mailman::mmbr){ $mailman::mmbr = "Unknown";}
unless($mailman::mmbt){ $mailman::mmbt = "Unspecified";}
unless($mailman::mmbl){ $mailman::mmbl = "0";}
$mailman::mmcf = mmlm($mailman::mmbo);
$mailman::mmcg = mmlm($mailman::mmbq);
$mailman::mmch = mmlm($mailman::mmbp);
$mailman::mmci = mmlm($mailman::mmbt);
$mailman::mmcj = mmlm($mailman::mmbr); } sub mmlk { my $mmck = shift;
$mmck =~ s/\=\?(iso-8859-\d|us-ascii)\?q\?([^\?]+)\?\=/
mmlz(mmly($2))/xeig; $mmck =~
s/\=\?(iso-8859-\d|us-ascii)\?b\?([^\?]+)\?\=/
mmma(mmly($2))/xeig; return $mmck; } sub mmll {
my($mmak) = @_; $mmak =~ /^(\d+)H(.+)$/; my($mmcl) = $1; my($mmcm) = $2;
if($1 eq '' || $2 eq '') { mmld('The message ID string "' . $mmak . 
'" is poorly formed.'); } $mmcm =~ s/%(..)/pack("c",hex($1))/ge; $mailman::mmat =
"The server timed out during message listing.";
if($mailman::bUseAlarm){ alarm($mailman::iTimeoutDurationInSeconds); }
mmlg($mma,"LIST"); my($mmbh) = ''; $mmbh = <$mma>; unless($mmbh =~ /^\+OK/)
{ mmld($mmbh); } $mailman::mmcn = 0; while(<$mma> =~ /(\d+) (\d+)/) {
$mailman::mmbj[$1] = $2; $mailman::mmcn++; } my($mmb) = $mmcl; my($mmco) = 0;
while($mmb>0) { mmli($mmb);
$mailman::mmbm =~ s/%(..)/pack("c",hex($1))/ge; if($mailman::mmbm eq  $mmcm) {
$mmco = 1; last; } $mmb--; } if(!$mmco) { $mailman::mmbo = ''; $mmb = $mmcl;
mmli($mmb); } if($mailman::mmbo eq '') {
mmld('Could not find the specified message.'); } return ($mmb); } sub mmlm
{ my($mmcp) = @_; $mmcp =~ s/\&/\&amp\;/g; $mmcp =~ s/\</\&lt\;/g;
$mmcp =~ s/\>/\&gt\;/g; $mmcp =~ s/\%mmcq/\</g; $mmcp =~ s/\%mmcr/\>/g;
my($mmcs) = '(http://|https://|ftp://)' .
q%(?:&(?![gl]t;)|[^\s\(\)\|<>,"'\&])+% . q%[^\.?!;,"'\|\[\]\(\)\s<>\&]%;
my($mmct) = "\<a target=\"_top\" href\=\"$mailman::mmx?BACKGROUND="; $mmcp =~
s/($mmcs)/$mmct.mmmu($1)."\"\>$1\<\/a\>"/eig; if($mailman::mmaa) {
$mmcp =~ s/(href\=\"[^\"]*)(BACKGROUND\=)/${1}NOFRAMES\=TRUE&$2/g; } return $mmcp;
} sub mmln { my($mmcu) = shift; $mmcu =~ s/([\w\W])/sprintf("%02x",ord($1))/eg;
return $mmcu; } sub mmlo { my($mmcu) = shift;
$mmcu =~ s/([a-fA-F0-9]{2})/pack("C",hex($1))/eg; return $mmcu; }
sub mmlp { my $mmcv = shift; $mmcv =~
s/([0-9a-z\.\-\+\&_]+\@[0-9a-z\.\-]+)/\<a
href\=\"$mailman::mmx?NEW=TRUE&MAILTO=$1\" target=\"_top\"\>$1\<\/a\>/ig;
return $mmcv; } sub mmlq { my($mmcw) = shift;
$mailman::mmai{'URL'} = $mmcw;
mmmr('t_backgroundframeset.htm',\%mailman::mmai); }
sub mmlr {  my($mmcx) = @_; unless(defined($mmcx)) { $mmcx = 0; }
my($mmcy, $mmcz) = (0, 0); my($mmas) = ''; if($mailman::mmaa) {
if($mailman::mmav eq 'SENT') { my($mmda) = 't_nf_messagelistsent.htm';
if(defined($mailman::mmac)) { $mmda = $mailman::mmac . $mmda; } if(-e
"${mailman::strLocalTemplateLocation}$mmda") { $mmas = 't_nf_messagelistsent.htm';
} else { $mmas = 't_nf_messagelist.htm'; } } else { $mmas = 't_nf_messagelist.htm'; } }
else { if($mailman::mmav eq 'SENT') { my($mmda) = 't_f_messagelistsent.htm';
if(defined($mailman::mmac)) { $mmda = $mailman::mmac . $mmda; } if(-e
"${mailman::strLocalTemplateLocation}$mmda") { $mmas = 't_f_messagelistsent.htm'; }
else { $mmas = 't_f_messagelist.htm'; } } else { $mmas = 't_f_messagelist.htm'; } }
my($mmdb, $mmdc, $mmdd, $mmde) = ('','','',''); ($mmdb, $mmdc, $mmde, $mmdd) =
mmmq($mmas, ('MESSAGE_EVEN', 'MESSAGE_ODD',
'ATTACHMENT_IMAGE', 'UNREAD_IMAGE')); my($mmah) = '';
if($mmah = mmlh()) { mmld($mmah); }
$mailman::mmai{'USERNAME'} = $mailman::mml;
$mailman::mmai{'USERNAMEHIDDEN'} = $mailman::mmn;
$mailman::mmai{'SERVERHIDDEN'} = $mailman::mmq;
$mailman::mmai{'PASSWORDHIDDEN'} = $mailman::mmp;
$mailman::mmai{'CHECKSUM'} = $mailman::mmw;
$mailman::mmai{'NUM'} = $mailman::mmbi; if(defined($mailman::strFromDomainName)) {
$mailman::mmai{'SERVER'} = mmnj($mailman::strFromDomainName); } else {
$mailman::mmai{'SERVER'} = mmnj($mailman::strIncomingServer); }
if($mailman::mmbi > 0) { $mailman::mmat =
"The server timed out during message listing.";
if($mailman::bUseAlarm){ alarm($mailman::iTimeoutDurationInSeconds); }
mmlg($mma,"LIST"); my($mmbh) = ''; $mmbh = <$mma>; unless($mmbh =~ /^\+OK/)
{ mmld($mmbh); } $mailman::mmbi = 0; while(<$mma> =~ /(\d+) (\d+)/) {
$mailman::mmbj[$1] = $2; $mailman::mmbi++; } }    if($mailman::mmbi > 0) {
if($mmcx == 0) { $mmcx = $mailman::mmbi; } my($mmdf); if($mailman::mmbi > 1) {
my($mmdg) = 0; for($mmdg=$mailman::mmbi; $mmdg>0;
$mmdg-=$mailman::iMessagesPerPage) { my($mmdh) = $mmdg;
my($mmdi) = $mmdg-$mailman::iMessagesPerPage+1; my($mmdj) = ''; if($mmdi<1) {
$mmdi = 1; } if($mmcx <= $mmdh && $mmcx >= $mmdi) { $mmdf = 1; $mmcy = $mmdh;
$mmcz = $mmdi; } else { $mmdf = 0; } if($mmdh == $mmdi) { $mmdj = "$mmdh"; } else {
$mmdj = "$mmdh-$mmdi"; } if($mailman::mmaa) { if($mmdf) {
$mailman::mmai{'PAGELINKS'} .=  "<b>[$mmdj]</b> "; } else {
$mailman::mmai{'PAGELINKS'} .=  qq|<input type="submit" class="pagebutton" | .
qq|name="LIST:$mmdh" | . qq|value="$mmdj"> |; } } else { if($mmdf) {
$mailman::mmai{'PAGELINKS'} .=  "<b>[$mmdj]</b> "; } else {
$mailman::mmai{'PAGELINKS'} .= qq|<a href="$mailman::mmx?LIST:$mmdh=TRUE">| .
qq|[$mmdj]</a> |; } } } } else { $mailman::mmai{'PAGELINKS'} = ''; $mmcy = 1; $mmcz = 1; }
} if($mailman::mmbi > 0) { $mailman::mmai{'MESSAGELIST'} = ''; my($mmdg) = 0;
for($mmdg=$mmcy;$mmdg>=$mmcz;$mmdg--) { mmli($mmdg);
$mailman::mmai{'TO'} = $mailman::mmcf; $mailman::mmai{'MESSAGENUM'} = $mmdg;
$mailman::mmai{'DATE'} = $mailman::mmcj;
$mailman::mmai{'SUBJECT'} = $mailman::mmci;
if(defined($mailman::iSubjectTruncationLength)) { if(length($mailman::mmbt) >
$mailman::iSubjectTruncationLength) { $mailman::mmai{'SUBJECT'} = mmlm(
substr($mailman::mmbt, 0, $mailman::iSubjectTruncationLength - 3) . '...'); } }
$mailman::mmai{'SIZE'} = int($mailman::mmbj[$mmdg] / 1024);
if($mailman::mmai{'SIZE'} == 0) { $mailman::mmai{'SIZE'} = "1"; }
$mailman::mmai{'ID'} = mmln($mailman::mmbl);
$mailman::mmai{'FROM'} = $mailman::mmcg; if($mailman::mmbq =~ /^([^\<]+)\s?\</) {
$mailman::mmai{'FROM'} = mmlm(mmlk($1)); }
if($mailman::mmbq =~ /\"([^\"]+)\"/) { $mailman::mmai{'FROM'} =
mmlm(mmlk($1)); } if(defined($mailman::strDateFormat)) { my $mmdk = q!
use Date::Manip; Date_Init();!; eval($mmdk); $mmdk = q!
my $mmdl = ParseDate($mailman::mmbr); if($mmdl) { $mailman::mmai{'DATE'} =
mmlm(UnixDate($mmdl, $mailman::strDateFormat)); }!; eval($mmdk); }
if($mailman::mmbw) { $mailman::mmai{'ATTACHMENT_IMAGE'} = $mmde; } else {
$mailman::mmai{'ATTACHMENT_IMAGE'} = ''; } $mailman::mmai{'OPENIMAGE'} = $mmdd;
my($mmdm); if($mmdg%2==0) { $mmdm = mmmn($mmdb,\%mailman::mmai); }
else { $mmdm = mmmn($mmdc,\%mailman::mmai); }
$mailman::mmai{'MESSAGELIST'} .= $mmdm; } } mmlg($mma,"QUIT"); close $mma;
if($mailman::mmai{'MESSAGELIST'} eq '') { $mailman::mmai{'MESSAGELIST'} =
mmmp($mmas,'NOMESSAGES'); }
$mailman::mmai{'FROM'} = mmnf();

 mmmr($mmas,\%mailman::mmai);
 }
sub mmls { my($mmak,$mmdy) =  @_; my($mmdz) = 0; my($mmbb) = '';
my($mmah) = ''; if($mmah = mmlh()) { mmld($mmah); }
my($mmbk) = mmll($mmak); $mmbk += $mmdy; if($mmbk > $mailman::mmcn) {
if($mailman::mmaa) { mmlr(); } else { mmld("No next message."); } }
if($mmbk < 1) { if($mailman::mmaa) { mmlr(); } else {
mmld("No previous message."); } } if($mmdy != 0) { mmli($mmbk); }
$mailman::mmat = "The server timed out retrieving a message.";
if($mailman::bUseAlarm){ alarm($mailman::iTimeoutDurationInSeconds); }
my($mmea) = $mmbk; mmlg($mma,"RETR $mmea"); my($mmbh) = ''; $mmbh = <$mma>;
unless($mmbh =~ /^\+OK/) { mmld($mmbh); } $mmdz = 0; $mmbb = '';
while(defined($mmbb = <$mma>)) { if($mmbb =~ /^\.\r$/){ last; }
$mailman::mmeb[$mmdz++] = $mmbb; } mmlg($mma,"QUIT"); close $mma; }

sub mmlu { my($mmec,$mmed) = @_; my($mmdm) = ''; my($mmee) = '';
my($mmef) = ''; my($mmeg) = 0; my($mmeh) = 0; my($mmei) = 0; my($mmej) = '';
my($mmek) = ''; my($mmel) = localtime(time); $mmel = mmmy($mmel);
my(@mmem,@mmen,@mmeo, $mmep,@mmeq,@mmer); my($mmes); my(@mmet,@mmeu,$mmev,@mmew); {
my($mmbx)=0; $mmep=0; my($mmck)= ''; headerline: foreach $_ (@$mmec) { $mmck .= $_;
if(/^[\r\n]+$/){ last headerline; } }        $mmck =~ s/[\r\n]/ /g; if(($mmck =~
/Content-type\:\s+multipart\/mixed\s?;.*boundary\=\"([^\"\;]+)\"\;?\s/si) ||
($mmck =~
/Content-type\:\s+multipart\/signed\s?;.*boundary\=\"([^\"\;]+)\"\;?\s/si) ||
($mmck =~
/Content-type\:\s+multipart\/report\s?;.*boundary\=\"([^\"\;]+)\"\;?\s/si)) {
$mmes = 'multipart/mixed'; $mmee = $1; $mmek = mmmw($mmee);
$mailman::mmex = 1; } elsif(($mmck =~
/Content-type\:\s+multipart\/mixed\s?;.*boundary\=\"?([^\"\;]+)\"?\;?\s/si) ||
($mmck =~
/Content-type\:\s+multipart\/signed\s?;.*boundary\=\"?([^\"\;]+)\"?\;?\s/si) ||
($mmck =~
/Content-type\:\s+multipart\/report\s?;.*boundary\=\"?([^\"\;]+)\"?\;?\s/si)) {
$mmes = 'multipart/mixed'; $mmee = $1; $mmek = mmmw($mmee);
$mailman::mmex = 1; } elsif($mmck =~
/Content-type\:\s+multipart\/alternative\s?;.*boundary\=\"?([^\"\;]+)\"?\;?\s/si)
{ $mmes = 'multipart/alternative'; $mmee = $1; $mmek = mmmw($mmee); }
elsif($mmck =~
/Content-type\:\s+multipart\/related\s?;.*boundary\=\"?([^\"\;]+)\"?\;?\s/si) {
$mmes = 'multipart/related'; $mmee = $1; $mmek = mmmw($mmee); }
elsif($mmck =~ /Content-type\:\s+([^\;]+);.*name\=\"?([^\"\;]+)\"?\;?\s/si) {
$mmes = $mmen[0] = $1; $mmef = $mmeq[0] = $2; $mmeg = 0; $mmem[0][$mmeh++] = 
"Content-type: $1; name=\"$2\"\n"; } elsif($mmck =~ /Content-type\:\s+([^\;]+)/si)
{ $mmes = $mmen[0] = $1; $mmef = $mmeq[0] = 'messagebody'; $mmeg = 0;
$mmem[0][$mmeh++] =  "Content-type: $1\n"; } if($mmck =~
/Content-transfer-encoding\:\s+(\S+)\s/si) { $mmem[0][$mmeh++] = 
"Content-transfer-encoding: $1\n"; } $mmem[0][$mmeh++] = "\n"; $mmbx=0; $mmep=0;
messageline: foreach $_ (@$mmec) { if($mmbx) {  if(/^\-\-$mmek\-\-/) {
last messageline; } if(/^\-\-$mmek/) { $mmep++; $mmeh=0; $mmei=0; $mmeo[$mmep] =
$mmee . 'P' . $mmep; next messageline; } $mmem[$mmep][$mmeh++] = $_; if(/^[\r\n]+$/)
{ if(!$mmei) { $mmei = 1; unless(defined($mmeq[$mmep])) { $mmeq[$mmep] = 'Untitled'; } } }
if(!$mmei) { if(/name\=\"?([^\"]+)\"?/i) { my($mmey) = $1; $mmeq[$mmep] =
mmlk($mmey); } if(/^Content-type\:\s+([^\;]+)\;?/i) { $mmej = $1;
$mmen[$mmep] = $mmej; } if(/^Content-ID\:\s+([^\;]+)\;?/i) { my($mmez) = $1;
$mmez =~ s/\<([^\>]+)\>/$1/g; $mmez =~ s/\s*(\S+)\s*/$1/g; $mmer[$mmep] = $mmez; } }
} if(/^[\r\n\s]+$/) { $mmbx = 1; } } } if($mailman::mmal eq '0') {
mmlx($mmem[0]); } my($mmfa)=1; if($mailman::mmal ne '') {
for(;$mmfa<=$mmep;$mmfa++) { if($mmeo[$mmfa] eq $mailman::mmal) {
mmlx($mmem[$mmfa]); } } } elsif($mailman::mmam ne '') {
for(;$mmfa<=$mmep;$mmfa++) { if($mmer[$mmfa] eq $mailman::mmam) {
mmlx($mmem[$mmfa]); } } } if($mailman::mmbv) { if($mmes =~ /text\/plain/i) {
$mmdm .= mmmc($mmec, $mmed); return $mmdm; }
elsif($mmes =~ /text\/html/i) { $mmdm .= mmmd($mmec, $mmed);
return $mmdm; } elsif($mmes !~ /multipart\/mixed/i &&
$mmes !~ /multipart\/alternative/i && $mmes !~ /multipart\/related/i) { if($mmed) {
$mmdm .= mmmc($mmec, $mmed); } else {
my $mmfb = mmln($mailman::mmbl); if(($mmen[0] =~ /message\/rfc822/i) ||
$mmen[0] =~ /message\/delivery\-status/i) { $mmdm .=
qq|<table border="1"><tr><td>\n| . qq|<pre>\n|; my($mmbb) = '';
my($mmfc) = $mmem[0]; foreach $mmbb (@$mmfc) { $mmdm .= mmlm($mmbb); } $mmdm .=
qq|</pre>\n| . qq|</td></tr></table>\n|; } elsif($mailman::mmaa) { $mmdm .= 
qq|<p>\n| . qq|<input type="hidden" name="UNIQUE" value="$mmel">\n| .
qq|<input type="submit" | . qq|name="SHOW:${mmfb}mimepart:0" | .
qq|value="$mmef">\n| . qq|</p>\n|; } else { if($mmef =~ /\.(jpg)|(gif)|(png)\s*$/i) {
$mmdm .= 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::mmx?SHOW:${mmfb}mimepart:0=TRUE">\n| .
qq|$mmef</a></td></tr>\n| . qq|<tr><td>\n| .
qq|<a href="$mailman::mmx?SHOW:${mmfb}mimepart:0=TRUE">\n| .
qq|<img src="$mailman::mmx?SHOW:${mmfb}mimepart:0=TRUE"></a>\n| .
qq|</td></tr>\n| . qq|</table></center></p>\n|; } else { $mmdm .=
qq|<p><b>Attachment 1:</b>\n| .
qq|<a href="$mailman::mmx?SHOW:${mmfb}mimepart:0=TRUE">\n| . qq|$mmef</a></p>\n|;
} } } return $mmdm; } my($mmfa)=1; if($mmes =~ /multipart\/mixed/i) {
if($mmen[1] =~ /multipart\/alternative/i || $mmen[1] =~ /multipart\/mixed/i) {
$mmdm .= mmlu($mmem[1], $mmed); } elsif($mmen[1] =~ /text\/plain/i) {
$mmdm .= mmmc($mmem[1], $mmed); }
elsif($mmen[1] =~ /text\/html/i) { if($mmed) {
$mmdm .= mmmc($mmem[1], $mmed); } else {
$mmdm .= mmmd($mmem[1]); } } else { $mmfa = 0; } }
elsif($mmes =~ /multipart\/alternative/i) { my($mmfd) = 1;
for(;$mmfd<=$mmep;$mmfd++) { if($mmen[$mmfd] =~ /text\/html/i && !$mmed) { $mmdm .= 
mmmd($mmem[$mmfd]); return $mmdm; } } $mmfd = 1;
for(;$mmfd<=$mmep;$mmfd++) { if($mmen[$mmfd] =~ /text\/plain/i) { $mmdm .=
mmmc($mmem[$mmfd], $mmed); return $mmdm; } } }
elsif($mmes =~ /multipart\/related/i) { $mmdm .= mmlu($mmem[1],$mmed); }
else { $mmdm .= mmmc($mmec, $mmed); return($mmdm); } if($mmed) {
return($mmdm); } if($mmes eq 'multipart/mixed') { for(;$mmfa<$mmep;$mmfa++) {
my($mmfe) = $mmeo[$mmfa+1]; $mmfe =  mmmu($mmfe);
my $mmfb = mmln($mailman::mmbl); if(!defined($mmem[$mmfa+1])) { ; }
elsif(($mmen[$mmfa+1] =~ /message\/rfc822/i) || ($mmen[$mmfa+1] =~
/message\/delivery\-status/i) || ($mmen[$mmfa+1] eq '')) { $mmdm .=
qq|<table border="1"><tr><td>\n| . qq|<pre>\n|; my($mmbb) = '';
my($mmfc) = $mmem[$mmfa+1]; foreach $mmbb (@$mmfc) { $mmdm .= $mmbb; } $mmdm .=
qq|</pre>\n| . qq|</td></tr></table><br><br>\n|; } elsif($mailman::mmaa) { $mmdm .= 
qq|<p>\n| . qq|<input type="hidden" name="UNIQUE" value="$mmel">\n| .
qq|<input type="submit" | . qq|name="SHOW:${mmfb}mimepart:$mmfe" | .
qq|value="$mmeq[$mmfa+1]">\n| . qq|</p>\n|; } else { if($mmeq[$mmfa+1] =~
/\.(jpg)|(gif)|(png)\s*$/i) { $mmdm .= qq|<p>\n| . qq|<center>\n| .
qq|<table cellspacing=0 cellpadding=0 border=0>\n| .
qq|<tr><td align="center"><b>Attachment #$mmfa:</b>\n| .
qq|<a href="$mailman::mmx?SHOW:${mmfb}mimepart:$mmfe=TRUE">\n| .
qq|$mmeq[$mmfa+1]</a></td></tr>\n| . qq|<tr><td align="center">\n| .
qq|<a href="$mailman::mmx?SHOW:${mmfb}mimepart:$mmfe=TRUE">\n| .
qq|<img src="$mailman::mmx?SHOW:${mmfb}mimepart:$mmfe=TRUE"></a>\n| .
qq|</td></tr>\n| . qq|</table></center></p>\n|; } else { $mmdm .=
qq|<p><b>Attachment #$mmfa:</b>\n| .
qq|<a href="$mailman::mmx?SHOW:${mmfb}mimepart:$mmfe=TRUE">\n| .
qq|$mmeq[$mmfa+1]</a></p>\n|; } } } } } else { $mmev=0;
plaintextline: foreach $_ (@$mmec) { if(/^begin \d\d\d (\S+)\s*$/i) { $mmev++;
$mmeh=0; $mmew[$mmev] = $1; $mmeu[$mmev] = $1 . 'P' . $mmev; next plaintextline; }
elsif($mmev>0 && /^end\s*$/i) { $mmev++; $mmeh=0; $mmet[$mmev] .= "Fake Header\n\n";
next plaintextline; } $mmet[$mmev][$mmeh++] = $_; } if($mailman::mmal ne '') {
my($mmff) = 0; for(;$mmff<=$mmev;$mmff++) { if($mmeu[$mmff] eq $mailman::mmal) {
if($mmew[$mmff] eq '') { $mmdm .= mmmc($mmet[$mmff], $mmed);
return $mmdm; } else { mmmb($mmet[$mmff],$mmew[$mmff]); } } } } else {
my($mmff) = 0; for(;$mmff<=$mmev;$mmff++) {
if(!defined($mmew[$mmff]) || $mmew[$mmff] eq '') {
$mmdm .= mmmc($mmet[$mmff], $mmed); } elsif(!$mmed) {
my($mmfg) = $mmeu[$mmff]; $mmfg =  mmmu($mmfg);
my $mmfb = mmln($mailman::mmbl); if($mailman::mmaa) { $mmdm .=
'<form method="post" action="' . $mailman::mmx .
'"><input type="submit" name="' . 'SHOW:' . $mmfb . 'mimepart:' . $mmfg . 
"\" value=\"$mmew[$mmff]\"></form><br>\n"; } else { if($mmew[$mmff] =~
/\.(jpg)|(gif)|(png)\s*$/i) { $mmdm .= qq|<p>\n| . qq|<center>\n| .
qq|<table cellspacing=0 cellpadding=0 border=0>\n| .
qq|<tr><td align="center"><b>Attachment #$mmff:</b>\n| .
qq|<a href="$mailman::mmx?SHOW:${mmfb}mimepart:$mmfg=TRUE">\n| .
qq|$mmew[$mmff]</a></td></tr>\n| . qq|<tr><td align="center">\n| .
qq|<a href="$mailman::mmx?SHOW:${mmfb}mimepart:$mmfg=TRUE">\n| .
qq|<img src="$mailman::mmx?SHOW:${mmfb}mimepart:$mmfg=TRUE"></a>\n| .
qq|</td></tr>\n| . qq|</table></center></p>\n|; } else { $mmdm .=
qq|<p><b>Attachment #$mmff:</b>\n| .
qq|<a href="$mailman::mmx?SHOW:${mmfb}mimepart:$mmfg=TRUE">\n| .
qq|$mmew[$mmff]</a></p>\n|; } } } } } if($mmen[0] =~ /text\/html/i) {
$mmdm = mmmd($mmec); } return($mmdm); } return($mmdm); }

 sub mmlx { my($mmfi) = @_; my($mmfj,$mmfk) = (0, 0);
my($mmfl) = 0; my($mmei) = 0; my($mmbb) = ''; my($mmfm) = ''; my($mmck) = '';
my($mmcv) = ''; my($mmfn) = 'Untitled'; foreach $mmbb (@$mmfi) {
if($mmbb =~ /^Content-transfer-encoding\: base64/i) { $mmfj = 1; }
elsif($mmbb =~ /^Content-transfer-encoding\: quoted-printable/i) { $mmfk = 1; }
elsif($mmbb =~ /^Content-transfer-encoding\: x-uuencode/i) { $mmfl = 1; } else {
if($mmei && $mmfj) { $mmfm .= $mmbb; } elsif($mmei && $mmfk) { $mmfm .= $mmbb; }
elsif($mmei) { $mmfm .= $mmbb; } else { $mmck .= $mmbb; } } if($mmbb =~ /^[\r\n]+$/) {
$mmei = 1; $mmck =~ s/[\r\n]+[ \t]+(\S)/ $1/gs; if($mmfl) { my $mmfo; do {
$mmfo = shift(@$mmfi); } while($mmfo !~ /^begin \d\d\d (\S+)\s*$/i); $mmfn = $1;
mmmb($mmfi, $mmfn); exit(0); } } if(!$mmei &&
$mmbb =~ /name\=\"?([^\"\;]+)\"?\;?\s/si) { $mmfn = $1; } } if($mmfj) {
$mmcv = mmma($mmfm); } elsif($mmfk) { $mmcv = mmlz($mmfm); }
else { $mmcv = $mmfm; } print "Expires: Sun, 03 May 1998 16:00:00 GMT\n"; 
my($mmfp,$mmfq,$mmfr) = mmmx(); if($mmfp !~ /MSIE/i) {
print "Cache-control: no-cache\n"; } unless($mailman::mmu) { print $mmck;
print $mmcv; exit(0); } else { unless(-d $mailman::mms) {
unless(mkdir($mailman::mms,0755)) {
mmld("Could not create temporary directory for " .
"storing the attachment file.  Make sure that " . "the directory " .
"\"$mailman::mms\" exists " . "and is writable by the web user. The " .
"specific error was \"$!\"."); } if(defined($mailman::iLocalDirectoryPermissions))
{ mmna($mailman::mms, $mailman::iLocalDirectoryPermissions); } }
my $mmfs = $mmfn; if($mmfn =~ /^(.+)(\.[^\.]+)$/) { my $mmft = $1; my $mmfu = $2;
$mmfn = mmmu(mmmu($mmft)) . $mmfu; } else {
$mmfn = mmmu(mmmu($mmfn)); } my($mmfv) = new FileHandle();
my($mmfw) = $mailman::mms . '/' . $mmfn; unless(open($mmfv,">$mmfw")) {
mmld("Could not create temporary attachment file in \"" .
$mmfw ."\".  Make sure that the  " .
"directory is writable by the web user. The " . "specific error was \"$!\"."); }
binmode($mmfv); print {$mmfv} $mmcv; close($mmfv); if ($mmfs =~ /^(.+)(\.[^\.]+)$/)
{ my($mmfx) = $mailman::mmt . '/' .
mmmu(mmmu(mmmu($1))) . $2;
print "Location: $mmfx\n\n"; } else { my($mmfx) = $mailman::mmt . '/' . $mmfn;
print "Location: $mmfx\n\n"; } exit(0); } } sub mmly { my $mmfm = shift;
$mmfm =~ tr/\_/\ /; return $mmfm; } sub mmlz { my($mmfm) = @_;
my($mmfy); $mmfm =~ s/\s+(\r?\n)/$1/g; $mmfm =~ s/=\r?\n//g; $mmfy = $mmfm;
$mmfy =~ s/=([\da-fA-F]{2})/pack("C", hex($1))/ge; return($mmfy); }
sub mmma { my($mmfm) = @_; my($mmfy);
$mmfm =~ tr|A-Za-z0-9+=/||cd;             if(length($mmfm)%4) { return($mmfm); }
$mmfm =~ s/=+$//; $mmfm =~ tr|A-Za-z0-9+/| -_|; while($mmfm =~ /(.{1,60})/gs) {
my($mmfz) = chr(32+length($1)*3/4); $mmfy .= unpack("u",$mmfz . $1 ); }
return($mmfy); } sub mmmb { my($mmga,$mmgb) = @_;
print "Expires: Sun, 03 May 1998 16:00:00 GMT\n";  my($mmfp,$mmfq,$mmfr) =
mmmx(); if($mmfp !~ /MSIE/i) { print "Cache-control: no-cache\n";  }
unless($mailman::mmu) { print
qq|Content-Type: application\/octet-stream; name="$mmgb"\n\n|; my($mmdm) = '';
my($mmbb) = ''; foreach $mmbb (@$mmga) { $mmdm .= unpack('u',$mmbb); } print $mmdm;
exit(0); } else { unless(-d $mailman::mms) { unless(mkdir($mailman::mms,0755)) {
mmld("Could not create temporary directory for " .
"storing the attachment file.  Make sure that " . "the directory " .
"\"$mailman::mms\" exists " . "and is writable by the web user. The " .
"specific error was \"$!\"."); } if(defined($mailman::iLocalDirectoryPermissions))
{ mmna($mailman::mms, $mailman::iLocalDirectoryPermissions); } }
my($mmfv) = new FileHandle(); my($mmfw) = $mailman::mms . '/' . $mmgb;
unless(open($mmfv,">$mmfw")) {
mmld("Could not temporary attachment file in \"" .
$mmfw ."\".  Make sure that the  " .
"directory is writable by the web user. The " . "specific error was \"$!\"."); }
binmode($mmfv); my($mmbb) = ''; foreach $mmbb (@$mmga) {
print {$mmfv} unpack('u',$mmbb); } close($mmfv); my($mmfx) =
$mailman::mmt . '/' . $mmgb; print "Location: $mmfx\n\n"; exit(0); } }
sub mmmc { my($mmec,$mmed) = @_; my($mmfj,$mmfk); my($mmdm) = '';
my($mmbx) = 0; my($mmfm) = ''; if(!$mmed) { $mmdm = "<pre>\n"; } $mmbx=0;
foreach $_ (@$mmec) { if(!$mmbx) { if(/^Content-transfer-encoding\: base64/i) {
$mmfj = 1; } elsif(/^Content-transfer-encoding\: quoted-printable/i) { $mmfk = 1; } }
if($mmbx) { my($mmgc) = ''; if($mmfk || $mmfj) { $mmfm = $_; if($mmfj) {
$mmgc = mmma($mmfm); } elsif($mmfk) { $mmgc = mmlz($mmfm); }
} else { $mmgc = $_; } my($mmgd) = length($mmgc); my($mmge) = ''; if($mmed) {
$mmge = $mmgc; } else { $mmge = mmlp(mmlm($mmgc)); }
my($mmgf) = 90 + (length($mmge) - $mmgd); $mmge =~ s/([^\n]{1,$mmgf})\s/$1\n/g;
$mmge =~ s/\015//g; if($mmed) { $mmge = '> ' . $mmge; } $mmdm .= $mmge ; }
if(/^[\r\n]+$/){ $mmbx = 1; } } if($mmfj) { $mmdm .= mmma($mmfm); }
elsif($mmfk) { $mmdm .= mmlz($mmfm); } if(!$mmed) {
$mmdm .= "</pre>\n"; } return $mmdm; } sub mmmd { my($mmec) = @_;
my($mmfj,$mmfk); my($mmfm) = ''; my($mmdm) = ''; my($mmbx) = 0; foreach $_ (@$mmec) {
if(!$mmbx) { if(/^Content-transfer-encoding\: base64/i) { $mmfj = 1; }
elsif(/^Content-transfer-encoding\: quoted-printable/i) { $mmfk = 1; } } if($mmbx) { 
if($mmfk || $mmfj) { $mmfm .= $_; } else { my($mmge) = $_; $mmge =~ s/\r//g;
$mmdm .= $mmge; } } if(/^[\r\n\s]+$/){ $mmbx = 1; } } if($mmfj) {
$mmdm .= mmma($mmfm); } elsif($mmfk) {
$mmdm .= mmlz($mmfm); }
$mmdm =~ s/\<\/?(html|head|body|title)[^\>]*\>//sig;
my $mmfb = mmln($mailman::mmbl); $mmdm =~
s/(src\s*\=\s*\")cid\:([^\"]+)(\")/$1 . "${mailman::mmx}?SHOW:${mmfb}cid:" .
mmmu($2) . '=TRUE' . $3/egi; return $mmdm; } sub mmme {
my($mmak,$mmdy) =  @_; mmls($mmak,$mmdy); my($mmas) = ''; if($mailman::mmaa)
{ $mmas = 't_nf_message.htm'; } else { $mmas = 't_f_message.htm'; }
$mailman::mmai{'USERNAME'} = $mailman::mml;
$mailman::mmai{'USERNAMEHIDDEN'} = $mailman::mmn;
$mailman::mmai{'SERVER'} = $mailman::strIncomingServer;
$mailman::mmai{'SERVERHIDDEN'} = $mailman::mmq;
$mailman::mmai{'PASSWORDHIDDEN'} = $mailman::mmp;
$mailman::mmai{'CHECKSUM'} = $mailman::mmw;
$mailman::mmai{'NUM'} = $mailman::mmcn; $mailman::mmai{'TO'} = $mailman::mmcf;
$mailman::mmai{'FROM'} = $mailman::mmcg; $mailman::mmai{'DATE'} = $mailman::mmbr;
$mailman::mmai{'SUBJECT'} = $mailman::mmci;
$mailman::mmai{'MESSAGENUM'} = $mailman::mmbn;
$mailman::mmai{'MESSAGE'} = mmlu(\@mailman::mmeb);
$mailman::mmai{'ID'} = mmln($mailman::mmbl);
$mailman::mmai{'CC'} = $mailman::mmch; $mailman::mmgg = 
mmmp($mmas,'CCLINE'); if($mailman::mmbp eq '') {
$mailman::mmgg = ''; } else { $mailman::mmgg =
mmmn($mailman::mmgg,\%mailman::mmai); }
$mailman::mmai{'CCLINE'} = $mailman::mmgg; mmmr($mmas,\%mailman::mmai);
} sub mmmf { my($mmak,$mmdy) =  @_;
mmls(mmmu($mmak),$mmdy); my($mmas) = ''; if($mailman::mmaa) {
$mmas = 't_nf_message.htm'; } else { $mmas = 't_f_message.htm'; }
$mailman::mmai{'USERNAME'} = $mailman::mml;
$mailman::mmai{'USERNAMEHIDDEN'} = $mailman::mmn;
$mailman::mmai{'SERVER'} = $mailman::strIncomingServer;
$mailman::mmai{'SERVERHIDDEN'} = $mailman::mmq;
$mailman::mmai{'PASSWORDHIDDEN'} = $mailman::mmp;
$mailman::mmai{'CHECKSUM'} = $mailman::mmw;
$mailman::mmai{'NUM'} = $mailman::mmcn;
$mailman::mmai{'MESSAGENUM'} = $mailman::mmbn;
$mailman::mmai{'TO'} = $mailman::mmcf; $mailman::mmai{'FROM'} = $mailman::mmcg;
$mailman::mmai{'DATE'} = $mailman::mmbr;
$mailman::mmai{'SUBJECT'} = $mailman::mmci;
$mailman::mmai{'ID'} = mmln($mailman::mmbl);
$mailman::mmai{'CC'} = $mailman::mmch; $mailman::mmgg = 
mmmp($mmas,'CCLINE'); if($mailman::mmbp eq '') {
$mailman::mmgg = ''; } else {
$mailman::mmgg = mmmn($mailman::mmgg,\%mailman::mmai); }
$mailman::mmai{'CCLINE'} = $mailman::mmgg; $mailman::mmai{'MESSAGE'} = "<pre>\n";
my($mmbb) = ''; foreach $mmbb (@mailman::mmeb) { $mmbb =~ s/\015//g;
$mmbb =~ s/\&/\&amp\;/g; $mmbb =~ s/\</\&lt\;/g; $mmbb =~ s/\>/\&gt\;/g;
$mailman::mmai{'MESSAGE'} .= $mmbb; } $mailman::mmai{'MESSAGE'} .= "</pre>\n";
mmmr($mmas,\%mailman::mmai); } sub mmmg { my($mmak) =  @_;
$mailman::mmbi = mmll($mmak); mmlg($mma,"DELE $mailman::mmbi");
my($mmbh) = ''; $mmbh = <$mma>; unless($mmbh =~ /^\+OK/) { mmld($mmbh); } }
sub mmmh { my($mmak) =  @_; mmmg($mmak); }
sub mmmi { my($mmak,$mmgh,$mmgi, $mmbo) =  @_; my($mmdm) = '';
my($mmgj) = ''; my($mmgk) = ''; my($mmgl) = '';
$mailman::mmai{'ATTACH'} = $mailman::in{'ATTACH'}; my($mmas) = '';
$mmas = 't_messageform.htm'; if($mmak ne 'NEW') {
mmls(mmmu($mmak),0); $mmgj = $mailman::mmbo;
$mmgk = $mailman::mmbq; $mmgl = $mailman::mmbt; if($mailman::mmbu) {
$mailman::mmbo = $mailman::mmbu; } else { $mailman::mmbo = $mailman::mmbq; } if($mmgh)
{ $mailman::mmbo .= ", $mmgj";
if($mailman::mmbp){ $mailman::mmbo .= ", $mailman::mmbp"; } } if($mmgi) {
unless($mailman::mmbt =~ /^fwd\:/i) { $mailman::mmbt = "Fwd: $mailman::mmbt"; }
$mailman::mmbo = ""; } else { unless($mailman::mmbt =~ /^re\:/i) {
$mailman::mmbt = "Re: $mailman::mmbt"; } } $mailman::mmbp = ''; }
$mailman::mmbo =~ s/\"/&quot;/g; $mailman::mmbt =~ s/\"/&quot;/g;
if($mmak ne 'NEW') { $mailman::mmex = 0; $mmdm = mmlu(\@mailman::mmeb,1);
if($mmgi) { my($mmgm) = mmmp($mmas, 'FORWARDHEADER');
$mailman::mmai{'ORIGINALTO'} = $mmgj; $mailman::mmai{'ORIGINALFROM'} = $mmgk;
$mailman::mmai{'ORIGINALSUBJECT'} = $mmgl;
$mailman::mmai{'ORIGINALDATE'} = $mailman::mmbr;
$mmdm = mmmn($mmgm, \%mailman::mmai) . $mmdm; if($mailman::mmex) {
$mailman::mmgn = $mmak; $mailman::mmai{'ERROR'} = 
'The original message attachment(s) ' . 'will be included in this message.'; } } }
$mailman::mmai{'USERNAME'} = $mailman::mml;
$mailman::mmai{'USERNAMEHIDDEN'} = $mailman::mmn;
$mailman::mmai{'SERVER'} = $mailman::strIncomingServer;
$mailman::mmai{'SERVERHIDDEN'} = $mailman::mmq;
$mailman::mmai{'PASSWORDHIDDEN'} = $mailman::mmp;
$mailman::mmai{'CHECKSUM'} = $mailman::mmw;
$mailman::mmai{'NUM'} = $mailman::mmbi; $mailman::mmai{'MESSAGE'} = $mmdm;
$mailman::mmai{'TO'} = $mailman::mmbo; $mailman::mmai{'CC'} = $mailman::mmbp;
$mailman::mmai{'SUBJECT'} = $mailman::mmbt;
$mailman::mmai{'FROM'} = mmnf(); my($mmfp,$mmfq,$mmfr) =
mmmx(); my($mmgo) = 0; if(($mmfp =~ /MSIE/i    && $mmfq >= 4) ||
($mmfp =~ /Mozilla/i && $mmfq >= 2) || ($mmfp =~ /Opera/i   && $mmfq >= 5)) {
if(!$mmgi) { if($mailman::in{'ATTACH'}) { $mailman::mmai{'UPLOAD'} =
mmmp($mmas, 'UPLOAD'); $mmgo = 1; } else {
$mailman::mmai{'UPLOAD'} = mmmp($mmas, 'BENIGNUPLOAD'); } }
else { $mailman::mmai{'UPLOAD'} = ''; } } else { $mailman::mmai{'UPLOAD'} = ''; }
if($mmgo) { $mailman::mmai{'MULTIPARTTAG'} =
mmmp($mmas,'MULTIPARTTAG');
$mailman::mmai{'ENCTYPE'} = "multipart/form-data"; } else {
$mailman::mmai{'ENCTYPE'} = "application/x-www-form-urlencoded"; }
mmmr($mmas,\%mailman::mmai); } sub mmmj { my($mmah,$mmgp) = @_;
my($mmgi) = 0; $mailman::mmai{'ATTACH'} = $mailman::in{'ATTACH'}; my($mmas) = '';
$mmas = 't_messageform.htm'; $mailman::mmai{'USERNAME'} = $mailman::mml;
$mailman::mmai{'USERNAMEHIDDEN'} = $mailman::mmn;
$mailman::mmai{'SERVER'} = $mailman::strIncomingServer;
$mailman::mmai{'SERVERHIDDEN'} = $mailman::mmq;
$mailman::mmai{'PASSWORDHIDDEN'} = $mailman::mmp;
$mailman::mmai{'CHECKSUM'} = $mailman::mmw;
$mailman::mmai{'NUM'} = $mailman::in{'NUM'};
$mailman::mmai{'TO'} = $mailman::in{'TO'};
$mailman::mmai{'CC'} = $mailman::in{'CC'};
$mailman::mmai{'FROM'} = $mailman::in{'FROM'};
$mailman::mmai{'SUBJECT'} = $mailman::in{'SUBJECT'};
$mailman::mmai{'OUTGOING'} = $mailman::strOutgoingServer;
$mailman::mmai{'ERROR'} = $mmah; unless(defined($mmgp) && length($$mmgp)) {
$mailman::mmai{'MESSAGE'} = $mailman::in{'TEXT'}; } else {
$mailman::mmai{'MESSAGE'} = $$mmgp; }
if(defined($mailman::in{'FORWARDATTACHMENTS'})) { $mailman::mmgn =
mmmv($mailman::in{'FORWARDATTACHMENTS'}); $mmgi = 1; }
my($mmfp,$mmfq,$mmfr) = mmmx(); my($mmgo) = 0;
if(($mmfp =~ /MSIE/i    && $mmfq >= 4) || ($mmfp =~ /Mozilla/i && $mmfq >= 2) ||
($mmfp =~ /Opera/i   && $mmfq >= 5)) { if(!$mmgi) { if($mailman::in{'ATTACH'}) {
$mailman::mmai{'UPLOAD'} = mmmp($mmas, 'UPLOAD'); $mmgo = 1; }
else { $mailman::mmai{'UPLOAD'} = mmmp($mmas, 'BENIGNUPLOAD');
} } else { $mailman::mmai{'UPLOAD'} = ''; } } else { $mailman::mmai{'UPLOAD'} = ''; }
if($mmgo) { $mailman::mmai{'MULTIPARTTAG'} =
mmmp($mmas,'MULTIPARTTAG');
$mailman::mmai{'ENCTYPE'} = "multipart/form-data"; } else {
$mailman::mmai{'ENCTYPE'} = "application/x-www-form-urlencoded"; }
mmmr($mmas,\%mailman::mmai); } sub mmmk { my($mmaz) = "\015\012";
my($mmba, $mmbb) = @_; if($mailman::mmgq) { print $mailman::mmgr $mmbb . $mmaz; }
else { my($mmbc) = length($mmbb . $mmaz); syswrite($mmba,$mmbb . $mmaz,$mmbc); } }
sub mmml { my($mmaz) = "\015\012"; my($mmdm) = ''; my($mmee) = '';
my($mmgs) = ''; my($mmbo) = ''; my($mmah) = ''; if($mmah = mmlh()) {
if(defined($mmah)) { $mmah =~ s/^\-ERR(.*)$/$1/; } $mailman::bKioskMode = 0;
$mailman::mmai{'GREETING'} = 
"<center><b>Log In Error: </b><i>$mmah</i></center>";
mmmr('t_login.htm',\%mailman::mmai); mmlg($mma,"QUIT");
close $mma; $mailman::mman = 0; } my($mmgt) =  $mailman::in{'FORWARDATTACHMENTS'};
if($mmgt) { $mmgt = $mmgt; mmls($mmgt,0); my($mmep) = 0; my($mmbb) = '';
foreach $mmbb (@mailman::mmeb) { if($mmbb =~ /boundary\=\"?([^\"]+)\"?\;?/i &&
$mmee eq '') { $mmee = $1; } if($mmee ne '' && $mmbb =~ /^\-\-$mmee\s*$/) { $mmep++; }
if($mmep > 0) { $mmbb =~ s/[\r\n]+/$mmaz/; $mmgs .= $mmbb; } } }
$mmdm = $mailman::in{'TEXT'}; $mmdm =~ s/\015//sg;
$mmdm =~ s/([^\012]{1,90})\s/$1\012/sg; $mmdm =~ s/\012/\015\012/sg;
my $mmbq = $mailman::in{'FROM'}; my $mmgu = 0; local *Reader, *Writer;
if(defined($mailman::strLocalLocationSendmail)) { $mailman::mmgq = 1;
use IPC::Open2; $mmgu = open2(\*Reader, \*Writer,
"$mailman::strLocalLocationSendmail -bs"); $mma = \*Reader;
select($mma); $|=1; select(STDOUT); binmode($mma); $mailman::mmgr = \*Writer;
select($mailman::mmgr); $|=1; select(STDOUT); binmode($mailman::mmgr); } else {
unless($mailman::strOutgoingServer) {
mmmj("Send Error: No server provided, cannot proceed.", \$mmdm); }
my($mmbe) = 0; $mmbe = getprotobyname('tcp');
socket($mma,PF_INET,SOCK_STREAM,$mmbe); my($mmbf) = 0;
$mmbf = gethostbyname($mailman::strOutgoingServer); unless($mmbf) {
mmmj("Could not find an IP address for the host " .
"\"$mailman::strOutgoingServer\".", \$mmdm); } my($mmbg) = '';
$mmbg = sockaddr_in(25, $mmbf); unless(connect($mma, $mmbg)) {
mmmj("Send Error: Could not connect to server " .
"$mailman::strOutgoingServer", \$mmdm); } select($mma); $|=1; select(STDOUT);
binmode($mma); } $mailman::mmat = "The server connected, but will not respond.";
if($mailman::bUseAlarm){ alarm($mailman::iTimeoutDurationInSeconds); }
my($mmbh) = ''; $mmbh = <$mma>; unless($mmbh =~ /^220.+/) { if($mailman::mmgq) {
mmmj("Could not invoke local Sendmail instance at \"" .
$mailman::strLocalLocationSendmail . "\""); } else {
mmmj("Send Error: The server does not respond " .
"appropriately.  It responded: \"$mmbh\"", \$mmdm); } } while($mmbh =~ /^\d\d\d\-/) {
$mmbh = <$mma>; } my($mmgv) = $ENV{REMOTE_HOST};
unless($mmgv){ $mmgv = 'mailman.endymion.com';} mmmk($mma,"HELO $mmgv");
$mmbh = <$mma>; unless($mmbh =~ /^250.+/) {
mmmj('Send Error: ' . $mmbh, \$mmdm); } while($mmbh =~ /^\d\d\d\-/) {
$mmbh = <$mma>; } $mailman::mmat =
"The server timed out while accepting a message.";
if($mailman::bUseAlarm){ alarm($mailman::iTimeoutDurationInSeconds); }
my($mmgw) = $mmbq; if($mmgw =~ /(\<[^\>]+\>)/) { $mmgw = $1; } else {
$mmgw = '<' . $mmgw . '>'; } mmmk($mma,"MAIL FROM: $mmgw"); $mmbh = <$mma>;
unless($mmbh =~ /^250.+/) { mmmj('Send Error: ' . $mmbh, \$mmdm); }
while($mmbh =~ /^\d\d\d\-/) { $mmbh = <$mma>; } { $mmbo = $mailman::in{'TO'};
$mmbo =~ s/\;/\,/g;  $mailman::in{'TO'} = $mmbo; } my($mmgx) = $mailman::in{'TO'};
$mmgx =~ s/\"[^\"]+\"//g; my(@mmgy) = split(/[\,\;]/,$mmgx); my($mmgz) = '';
my(@mmha) = ();; my($mmbp) = ''; if($mailman::in{'CC'}) {
$mmgz .= $mailman::in{'CC'}; @mmha = split(/[\,\;]/,$mmgz);
$mmbp = $mailman::in{'CC'}; } my(@mmhb) = (); { my($mmdg);
for($mmdg=0;$mmdg<($#mmgy+1);$mmdg++) { my($mmhc) = $mmgy[$mmdg];
$mmhc =~ s/^\s+(.*)$/$1/; $mmhc =~ s/^(.*)\s+$/$1/; push(@mmhb,$mmhc); }
for($mmdg=0;$mmdg<($#mmha+1);$mmdg++) { my($mmhc) = $mmha[$mmdg];
$mmhc =~ s/^\s+(.*)$/$1/; $mmhc =~ s/^(.*)\s+$/$1/; push(@mmhb,$mmhc); } }
my($mmhc) = ''; while($mmhc = shift(@mmhb)) { $mmhc =~ s/^\s+(.*)$/$1/;
$mmhc =~ s/^(.*)\s+$/$1/; unless($mmhc =~ /@/) {
if(defined($mailman::strOutgoingDomainName)) {
$mmhc .= "\@$mailman::strOutgoingDomainName"; } } if($mmhc =~ /(\S+)\s+\([^\)]\)/) {
$mmhc = '<' . $1 . '>'; } elsif($mmhc =~ /\<([^\>]+)\>/) { $mmhc = '<' . $1 . '>'; }
elsif($mmhc !~ /\<[^\>]+\>/) { $mmhc = '<' . $mmhc . '>'; }
mmmk($mma,"RCPT TO: $mmhc"); my $mmbh = <$mma>; unless($mmbh =~ /^250.+/) {
mmmj('Send Error: ' . $mmbh, \$mmdm); } while($mmbh =~ /^\d\d\d\-/) {
$mmbh = <$mma>; } } mmmk($mma,"DATA"); $mmbh = <$mma>;
unless($mmbh =~ /^354.+/) { mmmj('Send Error: ' . $mmbh, \$mmdm); }
while($mmbh =~ /^\d\d\d\-/) { $mmbh = <$mma>; } my($mmhd) =
defined($ENV{'TZ'}) ? $ENV{'TZ'} : 'GMT';
my(@mmhe) = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
my(@mmdx) = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep',
'Oct','Nov','Dec'); my($mmdo,$mmdp,$mmdq,$mmdr,$mmds,$mmdt,$mmdu) =
($mmhd eq 'GMT') ? gmtime(time) : localtime(time); $mmdu = $mmhe[$mmdu];
$mmds = $mmdx[$mmds]; $mmdq = sprintf("%2.2d",$mmdq);
$mmdp = sprintf("%2.2d",$mmdp); $mmdo = sprintf("%2.2d",$mmdo);
if(length($mmdt) == 2) { $mmdt = mmng($mmdt); }
elsif(length($mmdt) == 3) { $mmdt += 1900; }
my($mmbr) = "$mmdu, $mmdr $mmds $mmdt $mmdq:$mmdp:$mmdo $mmhd";
$mailman::mmbo = $mmbo; my $mmhf = qq|To: ${mmbo}${mmaz}|; if($mmbp) {
$mmhf .= qq|Cc: ${mmbp}${mmaz}|; } $mailman::mmbq = $mailman::in{'FROM'};
$mmhf .= qq|From: ${mmbq}${mmaz}|; my $mmbt = $mailman::in{'SUBJECT'};
$mmhf .= qq|Subject: ${mmbt}${mmaz}|; $mmhf .= qq|Date: ${mmbr}${mmaz}|;
$mmhf .= qq|X-Posting-IP: $ENV{'REMOTE_ADDR'}|;
if(defined($ENV{'HTTP_X_FORWARDED_FOR'})) { $mmhf .=
qq| via $ENV{'HTTP_X_FORWARDED_FOR'}|;  } $mmhf .= $mmaz;
$mmhf .= "X-Mailer: Endymion MailMan " .
"$mailman::strMailManEdition $mailman::strMailManVersion$mmaz";
if($mailman::in{'USERFILE1'} || $mailman::in{'USERFILE2'} || $mmgt) {
unless($mmee){ $mmee = 'MailMan_Boundary'; } $mmhf .= "MIME-Version: 1.0$mmaz";
$mmhf .=  "Content-Type: multipart/mixed; boundary=\"$mmee\"$mmaz$mmaz"; $mmhf .= 
"This is a multi-part message in MIME format.$mmaz$mmaz";
$mmhf .= "--$mmee$mmaz"; $mmhf .= "Content-Type: text/plain$mmaz$mmaz"; } else {
$mmhf .= "$mmaz"; } mmmk($mma,$mmhf . $mmdm);
if(defined($mailman::strOutgoingBannerText)) {
$mailman::strOutgoingBannerText =~ s/\015//sg;
$mailman::strOutgoingBannerText =~ s/([^\012]{1,90})\s/$1\012/sg;
$mailman::strOutgoingBannerText =~ s/\012/\015\012/sg; mmmk($mma,
$mailman::strOutgoingBannerText); } my($mmey) = '';
foreach $mmey ('USERFILE1','USERFILE2') { unless($mailman::in{$mmey}){next;}
my($mmfn) = ''; $mmfn = $mailman::incfn{$mmey}; my($mmce) = $mailman::inct{$mmey};
my $mmhg .= $mailman::in{$mmey}; my($mmhh) = $mmfn;
$mmhh =~ s/^.*[\\\/]([^\\\/]+)$/$1/; my($mmhi) = '--' . $mmee . $mmaz; $mmhi .= 
"Content-Type: ${mmce}; name=\"" . $mmhh . "\"$mmaz";
$mmhi .= "Content-Transfer-Encoding: base64$mmaz"; $mmhi .=
"Content-Disposition: attachment; filename=\"" . $mmhh . "\"$mmaz";
$mmhi .= $mmaz; $mmhi .= mmni($mmhg,$mmaz); mmmk($mma,$mmhi); }
if($mmgs) { mmmk($mma,$mmgs); } else { if($mmee) {
my($mmhj) = '--' . $mmee . '--'; mmmk($mma,$mmhj); } }
mmmk($mma,''); mmmk($mma,'.'); my $mmbh = <$mma>;
unless($mmbh =~ /^250.+/) { mmmj('Send Error: ' . $mmbh, \$mmdm); }
while($mmbh =~ /^\d\d\d\-/) { $mmbh = <$mma>; } mmmk($mma,"QUIT");
close $mma; if($mailman::mmgq) { close $mailman::mmgr; waitpid($mmgu, 0); }
my($mmas) = ''; $mmas = 't_sendconfirm.htm';
$mailman::mmai{'USERNAME'} = $mailman::mml;
$mailman::mmai{'USERNAMEHIDDEN'} = $mailman::mmn;
$mailman::mmai{'SERVER'} = $mailman::strIncomingServer;
$mailman::mmai{'SERVERHIDDEN'} = $mailman::mmq;
$mailman::mmai{'PASSWORDHIDDEN'} = $mailman::mmp;
$mailman::mmai{'CHECKSUM'} = $mailman::mmw;
$mailman::mmai{'SUBJECT'} = mmlm($mailman::in{'SUBJECT'});
$mailman::mmai{'TO'} = mmlm($mailman::in{'TO'});
$mailman::mmai{'OUTGOING'} = mmlm($mailman::strOutgoingServer);
mmmr($mmas,\%mailman::mmai); exit(0); } sub mmmm { my($mmhk) = @_;
my($mmhl) = mmmt($ENV{SERVER_NAME},42); my($mmhm) = '';
if($mailman::bUseHijackTest) {
$mmhm = mmmt($ENV{REMOTE_HOST} . $ENV{REMOTE_ADDR},69); }
unless($mmhl){ $mmhl = 'NO SERVER'; } unless($mmhm){ $mmhm = 'NO HOST'; }
my($key) = $mmhl ^ $mmhm; if(length($key)==$mmhk) { return($key); }
elsif(length($key)>$mmhk) { return(substr($key,0,$mmhk)); } else {
while(length($key)<$mmhk) { $key = "$key$key"; } return(substr($key,0,$mmhk)); } }
sub mmmn { my($mmhn,$mmho) = @_; my($mmhp) = '';
unless($mmho->{'ME'}){ $mmho->{'ME'} = $mailman::mmx; }
while($mmhn =~ /MailMan\(([^\)]+)\)/) { $mmhp = $mmho->{$1};
$mmhn =~ s/MailMan\($1\)/$mmhp/g; } return $mmhn; } sub mmmo {
my($mmfn, $mmho) = @_; print "Content-type: text/html\n\n"; if(defined($mmho)) {
my $mmc; foreach $mmc (sort keys %$mmho) {
print qq|<!-- $mmc: "| . $mmho->{$mmc} . qq|" -->\n|; } } if(-e $mmfn) { 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 "$mmfn" 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 $mmfn" 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 "$mmfn" 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 mmmp { my($mmfn,$mmhq) = @_; my($mmfh) = '';
my($mmhr) = new FileHandle(); if(defined($mailman::mmac)) {
$mmfn = $mailman::mmac . $mmfn; } if(open($mmhr,
"<" . $mailman::strLocalTemplateLocation . $mmfn)) { my($mmhs) = '';
while(defined($_ = <$mmhr>)) { $mmhs .= $_; } close($mmhr); if($mmhs =~ 
/MailManSnippet\($mmhq\)\s*(.+)\s*EndSnippet\($mmhq\)/si) { $mmfh = $1;
$mmfh =~ s/^\s+(\S.*)$/$1/; $mmfh =~ s/^(.*\S)\s+$/$1/; return $mmfh; } } $mmfh = 
qq|<i><b>Template Error:</b> Snippet "$mmhq" not found in | .
qq|template "$mmfn"</i>|; return  $mmfh; } sub mmmq {
my($mmfn,@mmht) = @_; my(@mmhu); my($mmhr) = new FileHandle();
if(defined($mailman::mmac)) { $mmfn = $mailman::mmac . $mmfn; } if(open($mmhr,
"<" . $mailman::strLocalTemplateLocation . $mmfn)) { my($mmhs) = '';
while(defined($_ = <$mmhr>)) { $mmhs .= $_; } close($mmhr); my($mmhq) = '';
foreach $mmhq (@mmht) { if($mmhs =~ 
/MailManSnippet\($mmhq\)\s*(.+)\s*EndSnippet\($mmhq\)/si) { my($mmfh) = $1;
$mmfh =~ s/^\s+(\S.*)$/$1/; $mmfh =~ s/^(.*\S)\s+$/$1/; push(@mmhu,$1); } else {
mmld( qq|<i><b>Template Error:</b> Snippet "$mmhq" not found in | .
qq|template "$mmfn"</i>|); } } return @mmhu; } } sub mmmr {
my($mmfn,$mmho,$mmar) = @_; my($mmhv) = 0; my($mmhr) = new FileHandle();
if(defined($mailman::mmac)) { $mmfn = $mailman::mmac . $mmfn; }
unless($mmho->{'ME'}){ $mmho->{'ME'} = $mailman::mmx; }
my($mmel) = localtime(time); $mmho->{'UNIQUE'} = mmmy($mmel);
$mmho->{'EDITION'} = $mailman::strMailManEdition;
$mmho->{'VERSION'} = $mailman::strMailManVersion; if(open($mmhr,
"<" . $mailman::strLocalTemplateLocation . $mmfn)) {
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::mmw)) { $mmk .=
'CHECKSUM' . '#' . $mailman::mmw; }
if(defined($mailman::mml) && $mailman::mml ne '') {
print "Set-cookie: MailManAuth=$mmk;" . "$mailman::mmz\n"; }
if(defined($mailman::mmn)) { $mmho->{'AUTHENTICATION'} =
qq|<input type="hidden" name="USERNAME" value="$mailman::mmn">|; }
if(defined($mailman::mmq)) { $mmho->{'AUTHENTICATION'} .=
qq|<input type="hidden" name="SERVER" value="$mailman::mmq">|; }
if(defined($mailman::mmp)) { $mmho->{'AUTHENTICATION'} .=
qq|<input type="hidden" name="PASSWORD" value="$mailman::mmp">|; }
if(defined($mailman::mmw)) { $mmho->{'AUTHENTICATION'} .=
qq|<input type="hidden" name="CHECKSUM" value="$mailman::mmw">|; }
$mmho->{'SETTINGS'} = ''; if($mailman::mmaa) { $mmho->{'SETTINGS'} .=
qq|<input type="hidden" name="NOFRAMES" value="TRUE">|; } if($mailman::mmab) {
$mmho->{'SETTINGS'} .= qq|<input type="hidden" name="NOCACHE" value="TRUE">|; }
if(defined($mailman::mmac)) { $mmho->{'SETTINGS'} .=
qq|<input type="hidden" name="ALTERNATE_TEMPLATES" | .
qq|value="$mailman::mmac">|; } if($mailman::mmgn) { my($mmhw) = 
mmmu($mailman::mmgn); $mmho->{'SETTINGS'} .=
qq|<input type="hidden" name="FORWARDATTACHMENTS" | . qq|value="$mmhw">|; }
my($mmb) = 0; my($mmhx) = ''; my($mmae) = ''; foreach $mmae (keys(%mailman::in)) {
if($mmae ne 'USERNAME' && $mmae ne 'SERVER' && $mmae ne 'PASSWORD' &&
$mmae ne 'CHECKSUM' && $mmae ne 'SEND' && $mmae ne 'TEXT' && $mmae ne 'ATTACH' &&
$mmae !~ /USERFILE/) { $mmhx .= $mmae . '#' . $mailman::in{$mmae} . '&'; } }
chop($mmhx); if($mailman::mmaa) { print "Set-cookie: MailManCmds=$mmhx; " .
"path=$mailman::mmy;\n"; } if($mailman::mmab) {
print "Expires: Sun, 03 May 1998 16:00:00 GMT\n";
print "Cache-control: no-cache\n"; } print "\n";
if(defined($mailman::strDebug) && ($mmfn !~ /t\_f\_frameset/)) { print
qq|<center>\n| . qq|<table bgcolor="#CCCCFF" border="2" | .
qq|bordercolor="#000000">\n | . qq|<tr><td align="center"><font | .
qq|color="#000000">\n| . qq|<b>DEBUG OUTPUT</b></font></td></tr>\n| .
qq|<tr><td>\n| . qq|<span style="color: #000033">| .
qq|<pre>$mailman::strDebug</pre>| . qq|</span></td></tr></table>\n| .
qq|</center>\n|; } while(defined($_ = <$mmhr>)) { while(/\<\!\-\-\s*MMSTD/i) {
s/\<\!\-\-\s*MMSTD//ig; } while(/MMSTD\s*\-\-\>/i) { s/MMSTD\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($mmhy) = '';
$mmhy = $mmho->{$1}; if(($1 eq 'TO') or ($1 eq 'SUBJECT') or ($1 eq 'CC')) {
$mmhy =~ s/\"/\&quot\;/g; } if(defined($mmhy)) { s/MailMan\($1\)/$mmhy/ig; } else {
s/MailMan\($1\)//ig; } } if(defined($mailman::strURLImageLocation)) {
s/([\"\`\'])([si]\_[^\.]+\.\w\w\w[\"\'])/$1${mailman::strURLImageLocation}$2/ig;
} print; $mmhv = 1; } close($mmhr); } else { mmmo($mmfn, $mmho); } unless($mmar)
{ exit(0); } } sub mmms { $mailman::mmr =
"316361365359288371370355317290360372372368314303303375375375302357366" .
"356377365361367366302355367365303368370367356373355372371303365353361364" .
"365353366303365365371372356307351304351304302359361358290288353364372317" .
"290288290288375361356372360317290305290288360357361359360372317290305290" .
"288353364361359366317290364357358372290318"; $mailman::mmr =
pack('C109',grep($_ && ($_ -= 256),split(/(\d\d\d)/, $mailman::mmr)));
$mailman::mmhz = "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::mmhz = "Windows"; $| = 1; $mailman::mmia = 1; } if((defined $^O and
$^O =~ /MacOS/i) || (defined $ENV{OS} and $ENV{OS} =~ /MacOS/i)) {
$mailman::mmhz = "Mac" } if (defined $^O and $^O =~ /VMS/i) { $mailman::mmhz = "VMS";
} if($mailman::mmhz eq 'Unix') { } elsif($mailman::mmhz eq 'Mac') { }
elsif($mailman::mmhz eq 'NT') { } } sub mmmt { my($mmib,$mmic) = @_;
if($mailman::bUseCrypt) { return crypt($mmib,$mmic); } else { return $mmib; } }
sub mmmu { my($mmhn) = shift;
$mmhn =~ s/(\W)/sprintf("%%%02x", ord($1))/eg; return $mmhn; } sub mmmv {
my($mmhn) = shift; $mmhn =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
return $mmhn; } sub mmmw { my($mmhn) = @_; $mmhn =~ s/([^A-Za-z0-9 ])/\\$1/g;
return($mmhn); } sub mmmx { my($mmid) = $ENV{'HTTP_USER_AGENT'}; $_ = $mmid;
if(/(MSIE)\D*(\d+)\.?(\d*)\D?/i) { return ($1,$2,$3); }
elsif(/(Mozilla)\D*(\d+)\.?(\d*)\D?/i) { return ($1,$2,$3); }
elsif(/(Opera)\D*(\d+)\.?(\d*)\D?/i) { return ($1,$2,$3); } } sub mmmy {
my($mmib) =  @_; local $^W = 0; unless(defined($mmib)){ return; }
my($key) = mmmm(length($mmib)); my($mmie) = $mmib ^ $key;
$mmie = pack("u*",$mmie); chop($mmie);
$mmie =~ 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,38,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 "%%%%$mmie%%%%"; }
sub mmmz { my($mmie) =  @_; unless(defined($mmie)){ return; }
if($mmie =~ /\%\%\%\%(.+)\%\%\%\%/) { $mmie = $1; } else { return $mmie; }
$mmie =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$mmie = unpack("u*",$mmie); my($key) = mmmm(length($mmie));
my($mmib) = $mmie ^ $key; return $mmib; } sub mmna {
my($mmif,$mmig) = @_; unless(chmod($mmig, $mmif)) {
mmld("Could not change the permissions of " .
"\"$mmif\" for unknown reasons. " . "The specific error was \"$!\"."); } }
sub mmnb { my($mmbr) = shift; mmnd();
my($mmih,$mmii,$mmij) = (60, 60, 24); my($mmik) = ($mmii * $mmih); my($mmil) =
($mmij * $mmii * $mmih);
my($mmim) = [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]; if($mmbr =~ /
\s*                             (\S+\,?\s+)?                   
($mailman::mmin)\s+  (\d+)\s+                        (\d\d?)\:(\d\d?)\:(\d\d?)\s+
(\S+)\s+                        (\d{2}|\d{4})\s+               
\s*                             /xi) { $mmbr = "$1 $3 $2 $8 $4:$5:$6 $7"; }
my($mmcd) = 0; if($mmbr =~ / \s*                            
(\S+\,?\s+)?                    (\d+)\s+                       
($mailman::mmin)\s+  (\d{2}|\d{4})\s+                (\d\d?)\:(\d\d?)\:(\d\d?)\s+
(.*)                            \s*                             /xi) {
my($mmio) = $4; my($mmip) = $mailman::mmiq{lc($3)}; my($mmir) = $2;
my($mmis,$mmit,$mmiu) = ($5, $6, $7); my($mmiv) = $8; if(length($mmio) == 2) {
$mmio = mmng($mmio); } my($mmiw) = 0;
for($mmiw = 1996; $mmiw < $mmio; $mmiw++) { if(mmnc($mmiw)) {
$mmcd += (366 * $mmil); } else { $mmcd += (365 * $mmil); } } my($mmix) = 0;
for($mmix = 0; $mmix < $mmip; $mmix++) { my($mmiy) = $mmim->[$mmix];
if(($mmix == 1) && mmnc($mmio)) { $mmiy = 29; } $mmcd += $mmiy * $mmil; }
$mmcd += ($mmir -1) * $mmil; $mmcd += ($mmis - 1) * $mmik;
if($mmiv =~ /([\+\-]\d\d\d\d)/) { $mmiv = $1; } elsif($mmiv =~ /($mailman::mmiz)/i) {
$mmiv = $mailman::mmja{lc($1)}; } else { $mmiv = '+0000'; } if($mmiv =~ /^\-(\d\d)/) {
$mmcd += $1 * $mmik; } elsif($mmiv =~ /^\+(\d\d)/) { $mmcd -= $1 * $mmik; }
$mmcd += $mmit * $mmih; $mmcd += $mmiu; return $mmcd; } return (-1); } sub mmnc {
my($mmio) = @_; return 0 unless $mmio % 4 == 0; return 1 unless $mmio % 100 == 0;
return 0 unless $mmio % 400 == 0; return 1; } sub mmnd {
return if ($mailman::mmjb); $mailman::mmjb = 1; my($mmjc) =
[['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']]; mmne('inorder', $mmjc,
\%mailman::mmiq, \$mailman::mmin); my($mmjd) = [[ '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' ]]; mmne('', $mmjd, \%mailman::mmja,
\$mailman::mmiz); } sub mmne { my($mmje,$mmjf,$mmjg,$mmjh) = @_;
my($mmji,$mmjj,$mmjk,@mmjl) = (); for($mmji = 0; $mmji <= $#{$mmjf}; $mmji++) {
for($mmjj = 0; $mmjj <= $#{$mmjf->[$mmji]}; $mmjj++) {
$mmjk = $mmjf->[$mmji]->[$mmjj]; if($mmjk ne '') { if($mmje =~ /inorder/) {
%{$mmjg}->{$mmjk} = $mmjj; } else { my($mmjm) = $mmjf->[$mmji]->[++$mmjj];
%{$mmjg}->{$mmjk} = $mmjm; } push(@mmjl,$mmjk); } } } $$mmjh = join('|', @mmjl); }
sub mmnf { my $mmjn = ''; my $mmjo = 1;
if(defined($mailman::strUsernameMappingFileName)) { my($mmjp) = new FileHandle();
if(open($mmjp, "<$mailman::strUsernameMappingFileName")) {
while(defined($_ = <$mmjp>)) { if(/^([^\#]\S+)\s+(\S.*)$/) { my $mml = $1;
my $mmjq = $2; if($mml eq $mailman::mml) { $mmjn = $mmjq; $mmjo = 0; close($mmjp);
last; } } } } } if($mmjo && defined($mailman::bUsernameIsEmailAddress)) {
$mmjn = $mailman::mml; } elsif($mmjo && defined($mailman::strFromDomainName)) {
$mmjn = $mailman::mml . '@' . mmnj($mailman::strFromDomainName); }
elsif($mmjo) { $mmjn = $mailman::mml . '@' .
mmnj($mailman::strIncomingServer); } return $mmjn; }
sub mmng { my($mmjr) = shift;
my($mmdo,$mmdp,$mmdq,$mmdr,$mmds,$mmdt,$mmdu,$mmdv,$mmdw) = gmtime(time);
$mmdt += 1900; my($mmjs) = $mmdt-50; my($mmjt) = $mmjs+99; my($mmju) = "19$mmjr";
while($mmju < $mmjs) { $mmju += 100; } while($mmju > $mmjt) { $mmju -= 100; }
return $mmju; } sub mmnh { use File::Path; my($mmjv) = 0;
$mmjv = rmtree($mailman::mms,0,1); } sub mmni { my($mmjw,$mmaz) = @_;
my($mmjx); pos($mmjw) = 0; while($mmjw =~ /(.{1,45})/gs) {
$mmjx .= substr(pack('u', $1), 1); chop($mmjx); } $mmjx =~ tr/` -_/AA-Za-z0-9+\//;
my($mmjy) = (3 - length($mmjw) % 3) % 3;
$mmjx =~ s/.{$mmjy}$/'=' x $mmjy/e if $mmjy; $mmjx =~ s/(.{1,76})/$1$mmaz/g;
return $mmjx; } sub InitializeVars {
 @mailman::mmg = (); @mailman::mmaf = ();
@mailman::mmeb = (); @mailman::mmjz = (); @mailman::mmka = (); $mailman::mmu = 0;
$mailman::mmbw = 0; $mailman::mmi = 0; $mailman::mmjb = 0;
$mailman::bKioskMode = 0; $mailman::mman = 0; $mailman::mmbv = 0;
$mailman::mmab = 0; $mailman::mmaa = 0; $mailman::mmkb = 0; $mailman::mmkc = 0;
$mailman::mmkd = 0; $mailman::mmke = 0; $mailman::mmkf = 0;
$mailman::bUseAlarm = 0; $mailman::bUseCrypt = 0; $mailman::bUseHijackTest = 0;
%mailman::mmkg = (); %mailman::mmkh = (); %mailman::mmiq = (); %mailman::mmja = ();
%mailman::mmai = (); $mailman::mmki = 0; $mailman::mmkj = 0; $mailman::mmbn = 0;
$mailman::mmbi = 0; $mailman::mmbj = 0; $mailman::iMessagesPerPage = 0;
$mailman::mmcn = 0; $mailman::mmkk = 0; $mailman::iTimeoutDurationInSeconds = 0;
$mailman::mmkl = 0; $mailman::mmhz = 0; $mailman::mmr = ''; $mailman::mmkm = '';
$mailman::mmkn = ''; $mailman::mmh = ''; $mailman::mmbp = ''; $mailman::mmgg = '';
$mailman::mmv = ''; $mailman::mmw = ''; $mailman::mmz = ''; $mailman::mmav = '';
$mailman::mmko = ''; $mailman::mmbr = ''; $mailman::mmkp = ''; $mailman::mmgn = '';
$mailman::mmbq = ''; $mailman::mmch = ''; $mailman::mmcj = ''; $mailman::mmcg = '';
$mailman::mmci = ''; $mailman::mmcf = ''; $mailman::mmbl = ''; $mailman::mmq = '';
$mailman::mmkq = ''; $mailman::strLocalScriptLocation = '';
$mailman::strLocalTemplateLocation = ''; $mailman::mmx = ''; $mailman::mmy = '';
$mailman::mmal = ''; $mailman::mmam = ''; $mailman::mmkr = ''; $mailman::mmp = '';
$mailman::mmks = ''; $mailman::mmkt = ''; $mailman::mmku = ''; $mailman::mmkv = '';
$mailman::mmkw = ''; $mailman::mmkx = ''; $mailman::mmin = ''; $mailman::mmiz = '';
$mailman::mmbu = ''; $mailman::mmbs = ''; $mailman::mmbm = ''; $mailman::mmbt = '';
$mailman::mmat = ''; $mailman::mmbo = ''; $mailman::mmcu = ''; $mailman::mmky = '';
$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 mmnj { my($mmkz) = shift; my($mmb);
for($mmb=0;$mmb<$mailman::iFromDomainTrim;$mmb++) { $mmkz =~ s/^[^\.]+\.(.*)$/$1/;
} return $mmkz; }