#!/usr/bin/perl #!c:/perl/bin/perl.exe # The above line may need to be changed to reflect the location of # the perl interpreter on your system. Use "which perl" on a Unix system # to make a noble attempt to locate your perl interpreter. If you are # installing this on an NT IIS server then you probably do not need to # modify this line because it will most likely be ignored. Apache under # NT generally DOES require the top line to be configured. We have provided # two common paths above as examples, only the top line will be used, the # second line is just there to provide an example. ############################################################################ # MailMan, Professional Edition, version 3.1 # # Copyright (c) 1996 - 2002, Endymion Corporation. All rights reserved. # Endymion Corporation: http://www.endymion.com/ # by Ryan Alyn Porter, 1996 - 2002 # contributions by Stephen M Noa, 2001 # # This product is not free and is not in the public domain. # For detailed information on the licensing structure of MailMan, see # http://www.endymion.com/products/mailman/ # # Initiated: 9/07/1997 Version 1.1 # Re-awakened: 4/24/1998 Version 2.0 beta # Released: 7/20/1998 Version 2.0 # Last Modified: 2/05/2002 Version 3.1 ############################################################################ # If you are having problems with MailMan not working at all, please # take a look at the MailMan FAQ, stored online at # http://www.endymion.com/products/mailman/faq.htm. A version of the FAQ # should also have been in the distribution that contained this file. package mailman; # Enable these while you are working on modifications. Make absolutely # certain that 'use strict' is NOT enabled in production installations. # CGI.pm and 'use strict' are not compatible, if you have 'use strict' # enabled then your users will not be able to upload files because CGI.pm # provides uploaded files using a bizarre on-the-fly file handle that will # cause an error if you have 'use strict' enabled. We think that this is # ugly too, but there is no way around it at the moment. #use strict; #$^W = 1; # Warnings. # If you are getting mysterious "Internal Server Error" messages when # you try to run MailMan, then you might want to un-comment this line # to get a decent log of the error in a location that you can find. #BEGIN #{ # open(STDERR, 'c:/tmp/mailman_log.txt'); #} # Version information that might find its way into output. $mailman::strMailManVersion = 'v3.1'; $mailman::strMailManEdition = 'Professional Edition'; # Variable initialization. Clean and neat and all, but very necessary # for mod_perl. InitializeVars(); ############################################################################ # This section contains a few variables that you might need to set in order # to get MailMan functioning properly. If your installation is working, # then you don't need to worry about any of these. ############################################################################ # Local Location Users # IMPORTANT: Set this variable to point to a directory that you have # set up as the user storage area. Make sure that your web user has # read and write access to this directory. This needs to be a path # that makes sense at runtime for the web user, probably an absolute # path like '/something/somewhere/mailman/users/' or # "C\:\\mailman\\users\\". Note the terminal slash at the end. That's # important. It won't work without that slash. You probably shouldn't # be storing your user messages in publicly readable areas of your # web server for obvious security reasons, but some people don't have the # option. Just use your head, and ask us if you have any questions. # Also PLEASE remember that the data that MailMan writes to this # directory should be considered irreplacable user data and should be # handled and backed up appropriately. $mailman::strLocalLocationUsers = '/users/'; # User Disk Quota # This is fairly self-explanatory, it's the number of bytes that users # are allowed to use on your HTTP server for storing messages. If this # value is set to zero then no quota will be maintained and users will # never see quota status indicators. You can turn this on and off and # mess with the size at will, but note that if you decrease the quota # size after users have downloaded stuff then you could put some users # over quota. We have taken care to gracefully handle this situation # but your users might not think that things look very graceful when that # happens. Remember to set this in bytes. 1024*1024 bytes in a megabyte, # some common values are as follows: # 1 MB = 1048576 B # 2 MB = 2097152 B # 5 MB = 5242880 B # 10 MB = 10485760 B # Note that there are a couple of ways that a user can go slightly # over quota. MailMan allows this in cases like the storage of an # outgoing message and the like where recovery from a quota error # would be very difficult and un-graceful. Quotas are primarily # enforced when a user downloads new messages. If you notice that a # particular user has gone slightly over 100% of his/her quota, please # don't consider that a bug in MailMan. We have intentionally set things # up this way. This is a hint to administrators to allow for a little # more room on storage systems than the sum of all users' quotas. $mailman::iUserDiskQuota = 20971520; # Download Individual Accounts # Use this variable to tell MailMan that it should only download messages # from external accounts when the user explicitly issues a LOADACCOUNT # command. If this value is not set, MailMan will automatically download # messages from all of a user's accounts when they log in. #$mailman::bDownloadIndividualAccounts = 1; # Case Insensitive Accounts # This variable is used to indicate to MailMan that the POP3 account # names are case insensitive, so "BOB", "Bob" and "bob" are all considered # the same POP3 user. This is important in locating the user's persistent # information such as the message archive and the user's properties files. $mailman::bCaseInsensitiveAccounts = 1; # Outgoing Banner Text # This is the banner that is appended to the end of any message that # this MailMan installation sends. One reason why this is one of the # first configuration options is because we want to make it very # obvious that you can remove or modify this banner. Endymion places # no restrictions at all on this banner, so don't worry about leaving # credit to us in here or anything like that. Please feel free to # change this to whatever you like, or completely remove it. If this # value is not defined then it will simply append no banner. #$mailman::strOutgoingBannerText = # "\n" . # "---------------------------------------------\n" . # "This message was sent using RCC Mail.\n" . # # Incoming Mail Server: # The way that we originally intended to allow people to 'rig' the server # names for an installation was through simple template modifications, as # mentioned in the FAQ. A lot of people have asked about ways to rig the # server names in the script itself though, so we added this. We aim to # please... If you want to rig your incoming server name so that it makes # no difference at all what an incoming form specifies, just un-comment # this line and specify it. #$mailman::strIncomingServer = 'pop3.norton.antivirus'; $mailman::strIncomingServer = 'rcctvm.org'; # Outgoing Mail Server: # Same deal, different server. $mailman::strOutgoingServer = 'rcctvm.org'; # Sendmail Path: # If you would like your MailMan installation to use a local Sendmail # invocation when sending outbound mail instead of connecting to an # SMTP server, then you can un-comment this line and configure this to # point to the path of your Sendmail command. Use this if you do not # have an SMTP server running at all. # This might also work with some minor modification with other # command-line agents that support something like Sendmail's "-bs" # option, which instructs Sendmail to use the SMTP protocol via standard # input and standard output. If you have access to an SMTP server then # you are really probably better off using the wire connection instead # of this. #$mailman::strLocalLocationSendmail = '/usr/sbin/sendmail'; # Email Address Settings # The following few settings pertain to MailMan's need to infer a # user's email address. When a user logs in to MailMan, they provide # a POP3 username, server name, and password. That's not quite # enough information though. If the user ever wants to send mail, # then MailMan will need to know the user's email address for using # on the "FROM" line of the outgoing message. In many cases the # user's email address can be inferred by concatenating the user's # POP3 username with the POP3 server name. For example, the POP3 # user "sales" at the mail server "endymion.com" would result in the # email address "sales@endymion.com". This is the default behavior, # and if it is possible for you to configure your server name simply # like in this example so that it will result in functional and # attractive email addresses, then you don't need to do anything to # any of these options. # From Domain Trim: # If you have to specify a machine name for your POP3 server, then # such as "mail.endymion.com" rather than "endymion.com", then # MailMan will guess something dumb like "sales@mail.endymion.com" # when it needs to guess an email address. You can use this option # to have MailMan automatically trim one or more names from the # left side of a POP3 server's name. The number that you set here # represents the total number of names to shear off of the left-hand # side of the machine name. For instance, if the user's POP3 server # name is "mail.rex.endymion.com", and you set this value to 0, the # default, then when the user composes a message MailMan will guess # "sales@mail.rex.endymion.com" as the 'from' address. If you set # this value to 1 then it will guess "sales@rex.endymion.com", if # you set it to 2 then it will guess "sales@endymion.com", etc. This # can be helpful if you have a number of different virtual domains # and you want the email address to be inferred dynamically, rather # than by hard-coding it with the "From Domain Name" configuration value. #$mailman::iFromDomainTrim = 1; # From Domain Name: # In some cases, the POP3 server that your users check their mail from # doesn't have anything to do with the domain name portion of the # user's email address. You can use this option to manually set the # entire domain name portion of a user's email address. # For instance, consider the hyptothetical email address # "sales@endymion.com", which is served by a mailbox on the server # "mail5.it.endy-backoffice.com". When the user "sales" logs into # the POP3 server "mail5.it.endy-backoffice.com", MailMan will assume # that the email address is "sales@mail5.it.endy-backoffice.com". # If you set this variable to "endymion.com", then it will assume that # this user's email address is "sales@endymion.com" instead. $mailman::strFromDomainName = "rcctvm.org"; # Username is the Email Address # The above options hopefully helped you to configure the domain name # portion of your users' email addresses. In some cases you don't # want MailMan trying to guess a domain name at all because your users # log in to the POP3 server with their complete email address. For # instance, consider the hypothetical email address "sales@endymion.com" # that is served by a mailbox called "sales@endymion.com" on the # mail server "pop3.endymion.com". MailMan's default behavior would # be to infer the email address "sales@endymion.com@pop3.endymion.com", # which is obviously wrong. Un-comment the following line to instruct # MailMan to simply ignore the entire mail server name when inferring # the user's email address, using only the POP3 username. #$mailman::bUsernameIsEmailAddress = '1'; # Email Address Mapping File # This is a last option if all else fails. In an increasing number of # cases, the user's POP3 username has nothing to do with their email # address at all. For instance, you might have a user named "endy-sales" # on your mail server, but that mailbox actually corresponds to the # email address "sales@endymion.com". In these cases you either need # to make a custom code modification to MailMan that will allow your # user to log in with the name "sales" and have MailMan automatically # infer or look up the POP3 user name "endy-sales", which is hard and # may take some time. The simpler solution is to have your users log # in using their POP3 username as normal, and then provide a mapping # file that allows MailMan to look up each user's email address based # on their POP3 username, like a phone book. For instance, if you # provide a flat text file that contains a few lines like this: # endy-sales sales@endymion.com # endy-support support@endymion.com # (without the '#' marks at the beginning of the lines) # ...then MailMan will open the file and search for the POP3 user # name in the left column each time it needs to infer an email # address. If an entry is found, then it will use the email address # listed, if an entry is not found then MailMan will fall back on # the methods listed above. To enable this option, simply construct # a text file and provide the name of the text file here. The text # file can be automatically constructed if you like. #$mailman::strUsernameMappingFileName = "mapfile.txt"; # Outgoing Domain Name: # When a user specifies a recipient name without full domain qualification # ("rap" instead of "rap@endymion.com", for example) then the SMTP server # should provide configuration rules for determining how to deal with this # mail. It should not be the responsibility of the mail client to fill in # a complete address. We have had many requests for a feature to allow # an administrator to specify a default domain name, however, and we aim # to please. This configuration variable is the result. If you want # MailMan to assume a default domain name when it is given an incomplete # address, uncomment this line and set it to your domain name. We strongly # recommend against this, however, you should be looking into your SMTP # server's configuration options and not using this feature. #$mailman::strOutgoingDomainName = 'endymion.com'; # Messages Per Page: # This value controls the number of messages returned per page in a # message list. Adjust it if you like. # The user has the option of overriding this value in the user preferences # page. If you don't want them to be able to do this you can hide that # field in your templates. $mailman::iMessagesPerPage = 10; # Redirect Location # MailMan can redirect users to an alternate web page instead of the login # page when logging out. To redirect to an alternate location besides the # default login page you need to uncomment the line below and set it to the # URL location of the page you want to use. #$mailman::strURLRedirectLocation = 'http://www.rcctvm.org/'; # Local Template Location: # If you have a web server that sets the current directory to something # strange, you can set this to an absolute path to make it easier to # allow MailMan to find the templates. Just set this variable to an # absolute path like "C\:\\inetpub\\wwwroot\\mailman\\templates\\" # or '/usr/home/rap/mailman/' or whatever. Note the final slash, that's # important. If you leave it out then things won't work. If you need # to set this value, then un-comment the following line: #$mailman::strLocalTemplateLocation = "D:/inetpub/wwwroot/Endymion2/products/mailman/demo/"; # Local Script Location: # If your server is one of the ones that causes problems that require the # above value to be set, then you might also need to set this value. In # most cases your script location and your template location will be # identical, but if you move your templates to a different directory than # your script for whatever reason, then you will need to set this. If you # have no idea what I'm talking about, you should probably just leave this. $mailman::strLocalScriptLocation = $mailman::strLocalTemplateLocation; # URL Image Location: # Use this to rig the URLs that will be used to access the images that # the templates point to. This value will be prepended to any value in # the templates of the form ""i_*.gif"" (including the inner quotes). # If you have customized your templates and your own custom images are # not showing up in MailMan's output, it is probably because the custom # images that you are using are not named "i_*.gif". # To use this variable, set it to the exact value that you want prepended # to image names in order to make them into URLs that will point to your # image directory. For instance, if you bury your images in an "images" # directory under the directory where MailMan is installed, set this to # 'images/' (with the slash). If you put your images in a completely # different directory, something that is rooted, like '/mailman/images/' # might be what you are looking for. In the most extreme cases you can # do away with relative URLs entirely and provide a complete absolute URL # like the one below #$mailman::strURLImageLocation = 'http://www.endymion.com/images/'; # Use Perl 'alarm()' function: # Set this to true if your Perl interpreter supports "alarm". As of this # Writing, NT Perl does not. If this is not set, MailMan will not be able # to timeout when a server hangs. The OSSettings() routine will attempt # to set this variable, but you can override it here if you want. # The point of the "alarm" feature as used in MailMan is to allow MailMan # to detect when a mail server has not responded within a reasonable # amount of time. If your server's Perl interpreter does not support # "alarm", then MailMan will still work, but if a mail server ever does # not respond then the user will get no feedback to that effect. #$mailman::bUseAlarm = 1; # Timeout Duration: # The aforementioned timeout delay. Set this to something else to modify # how long MailMan will sit around waiting for a mail server to respond. # Only works if $mailman::bUseAlarm is set to something. $mailman::iTimeoutDurationInSeconds = 180; # Use Perl 'crypt()' function: # Some Perl impelentations apparently do not support the crypt() function. # We have never seen one, and there are plenty of implementations out there # that you should be able to find a good one, but we try to accomodate # anyway. Comment out this line if your Perl implementation is breaking # on the crypt() function. Be warned that if you do this your users' # usernames and passwords will be less obfuscated than they were before, # which admittedly wasn't much. This is a good place to repeat the # suggestion that MailMan is an excellent candidate for SSL and other # fancy HTTP security mechanisms. #$mailman::bUseCrypt = 1; # Use Hijack Test: # MailMan performs a test to determine if the current session has been # hijacked by a different user from a different address. On a few # systems this will not work because of the configuration. If your # MailMan installation sits behind a cluster of caching proxy servers # for load balancing, for instance. If you want to disable the hijack # checking functionality, just comment out this line. #$mailman::bUseHijackTest = 1; # Kiosk Mode: # If you are using MailMan in a kiosk environment, it will generally # be possible for a user to use a combination of "BACK" and "RELOAD" in # the kiosk web browser to intrude backwards into the mail sessions of # previous users. If you set this value then MailMan will operate in # kiosk mode, which means that when a user logs in, MailMan will create # a new browser window with that user's session. If the user logs out # then that window will close, and the user's history information will # go with the window so that intrusions with "BACK" and "RELOAD" aren't # possible. We recommend against using this feature for installations # that are not kiosk-based because it relies on Javascript and cookies, # which does not leave users with older browsers with a way in. If you # are in a kiosk environment then you have control over the browser an # that's not a problem. We strongly recommend against using the # Microsoft Internet Explorer for kiosk environments because it does not # properly respect the "Expires:" and "Cache-control:" HTTP headers, so # IE will cache user mail to the hard drive whether you want it to or # not. Microsoft appears to have no interest in fixing this problem. # IE 4 SP1 pretty consistently crashed during our tests of the # full-screen popup window kiosk mode, too, which is likely not exactly # the behavior that you are looking for in your kiosk browser. # The kiosk mode feature primarily activates and deactivates sections # of outbound templates, so if you have customized your templates before # you decided to use kiosk mode then it is entirely possible that you # broke this mode by removing vital Javascript. Consult the # out-of-the-box template set for examples of the Javascript snippets # necessary for this mode. #$mailman::bKioskMode = 1; # Date Format # By default, MailMan does not process dates as date objects, it handles # them as simple strings. If you want more control over the formatting # of your dates, then you can set this date format string and this format # will be used for the dates on message lists. The format for this string # is specified by the documentation for the Date::Manip Perl module, which # is included in most Unix Perl distributions now. If you get an error # when you try to use this, just make sure that you have Date::Manip # installed from CPAN, http://www.cpan.org Note also that date processing # is dependent on your time zone, so make sure that your 'TZ' environment # variable is set. If you get an error about this, then you can always # explicitly set the time zone by un-commenting the following: $ENV{'TZ'} = 'EST'; # Un-comment the following line to instruct MailMan to reformat dates. $mailman::strDateFormat = '%dd/%mm/%yy'; # Location Attachments # When a user selects an attachment from a message for downloading, # MailMan generates that attachment on-the-fly and sends it through the # HTTP server to the user's browser. MailMan includes the necessary # HTTP header information for the user's browser to determine the # file name, but many broswers, most notably Microsoft's Internet # Explorer, either ignore these headers or just don't handle them # very well. The result is that when a user downloads an attachment, # your browser may present the user with a "Save As" box with the # file name filled in as the name of this script, a string or random # characters, or any number of other un-graceful things. We think that # the best solution to this problem would be for browser makers to # pay attention to HTTP headers, but until then we provide a mechanism # for working around the problem. If you set up a directory that is # writable by MailMan and readable by your web server, then MailMan # will write out the attachment file to that directory temporarily, # and redirect the user's browser to that file. When the user logs # in or out MailMan will ensure that the user's files in this # temporary directory are removed. A user that exits MailMan without # logging out and never logs back in could potentially leave stale # attachment files on the server, so occasional monitoring of the # temporary directory for stale files would be appropriate. Also note # that this mechanism could be considered a privacy problem since a # user's attachments are deposited temporarily into a world-readable # directory rather than generated on-the-fly the way MailMan normally # would do. We have left the decision up to each individual # administrator as to whether or not to use this feature. Most people # seem to prefer allowing MailMan to generate attachments on-the-fly # for simplicity, ease of administration, and security/privacy, but # some people think that the attachment file name thing is a critical # issue. The decision is yours. # IMPORTANT SECURITY ADVISORY: # Make absolutely certain that the directory that you use for # attachments does *NOT* allow executable code. Do NOT use this # method of attachment handling if you are not absolutely certain # that executable code is not allowed in that directory. If your # temporary directory allows executable code then any attachments # that end in ".cgi", ".php", ".pl", etc, may be executed by your # server when they are accessed, rather than simply served. You do # *NOT* want this. # To use this feature, create a directory that is readable by your # web server and writable by the user that MailMan runs as. Set # $mailman::strLocalLocationAttachments to the local path name of # this directory, for instance # $mailman::strLocalLocationAttachments = '/public_html/attachtmp/'; # Then set $mailman::strURLLocationAttachments to the URL location # of this directory, for instance # $mailman::strURLLocationAttachments = '/attachtmp/'; # Note the terminal slashes at the end, those are necessary. Just # set and uncomment the following lines to use this feature: #$mailman::strLocalLocationAttachments = 'c:/www/public_html/mailman/tmp/'; #$mailman::strURLLocationAttachments = '/mailman/tmp/'; # Local File Permissions # Use this if you want to modify the permissions that files and # directories created by MailMan use. This will only make much sense # to Unix and Unix-like operating systems. If this value is not set, # nothing will happen. This should be an octal integer as in the # example below, not a string. $mailman::iLocalFilePermissions = 0666; # Local Directory Permissions # Same as above, used for directories created by MailMan. $mailman::iLocalDirectoryPermissions = 0777; # Subject Truncation Length # This is the maximum length allowed for a subject line in the message # list pages. If you set this then subject lines will be truncated at # this length, for predictable layout. If you don't set this, then # subjects will be left untouched. Subjects will always be left alone # on the message display page. $mailman::iSubjectTruncationLength = 20; ############################################################################ # You should not have to configure any values after this line. ############################################################################ # The following section of code is CGI manipulation routines # originally provided as a module called "cgi-lib.pl". This # code includes some very minor modifications to that code. # This is the original copyright notice from that code: # # Copyright (c) 1993-1999 Steven E. Brenner # Unpublished work. # # We have removed the original license notice to avoid confusion # over MailMan's license. If you are interested in this excellent # CGI handling code, then please see: # http://cgi-lib.stanford.edu/cgi-lib/ $cgi_lib'version = sprintf("%d.%02d", q$Revision: 2.18 $ =~ /(\d+)\.(\d+)/); # ReadParse # Reads in GET or POST data, converts it to unescaped text, and puts # key/value pairs in %in, using "\0" to separate multiple selections # Returns >0 if there was input, 0 if there was no input # undef indicates some failure. # Now that cgi scripts can be put in the normal file space, it is useful # to combine both the form and the script in one place. If no parameters # are given (i.e., ReadParse returns FALSE), then a form could be output. # If a reference to a hash is given, then the data will be stored in that # hash, but the data from $in and @in will become inaccessable. # If a variable-glob (e.g., *cgi_input) is the first parameter to ReadParse, # information is stored there, rather than in $in, @in, and %in. # Second, third, and fourth parameters fill associative arrays analagous to # %in with data relevant to file uploads. # If no method is given, the script will process both command-line arguments # of the form: name=value and any text that is in $ENV{'QUERY_STRING'} # This is intended to aid debugging and may be changed in future releases sub ReadParse { # Disable warnings as this code deliberately uses local and environment # variables which are preset to undef (i.e., not explicitly initialized) my ($perlwarn); $perlwarn = $^W; $^W = 0; # Parameters affecting cgi-lib behavior # User-configurable parameters affecting file upload. # $cgi_lib'maxdata = 131072; # maximum bytes to accept via POST - 2^17 $cgi_lib'maxdata = 5242880; # five megabytes $cgi_lib'writefiles = 0; # directory to which to write files, or # 0 if files should not be written $cgi_lib'filepre = "cgi-lib"; # Prefix of file names, in directory above # Do not change the following parameters unless you have special reasons $cgi_lib'bufsize = 8192; # default buffer size when reading multipart $cgi_lib'maxbound = 100; # maximum boundary length to be encounterd $cgi_lib'headerout = 0; # indicates whether the header has been printed (*mailman::in) = shift if @_; # CGI input (*mailman::incfn, # Client's filename (may not be provided) *mailman::inct, # Client's content-type (may not be provided) *mailman::insfn) = @_; # Server's filename (for spooled files) my ($len, $type, $meth, $errflag, $cmdflag, $got, $name); binmode(STDIN); # we need these for DOS-based systems binmode(STDOUT); # and they shouldn't hurt anything else binmode(STDERR); # Get several useful env variables $type = $ENV{'CONTENT_TYPE'}; $len = $ENV{'CONTENT_LENGTH'}; $meth = $ENV{'REQUEST_METHOD'}; if ($len > $cgi_lib'maxdata) { #' &CgiDie("cgi-lib.pl: Request to receive too much data: $len bytes\n"); } if (!defined $meth || $meth eq '' || $meth eq 'GET' || $meth eq 'HEAD' || $type eq 'application/x-www-form-urlencoded') { my ($key, $val, $i); # Read in text if (!defined $meth || $meth eq '') { $mailman::in = $ENV{'QUERY_STRING'}; $cmdflag = 1; # also use command-line options } elsif($meth eq 'GET' || $meth eq 'HEAD') { $mailman::in = $ENV{'QUERY_STRING'}; } elsif ($meth eq 'POST') { if (($got = read(STDIN, $mailman::in, $len) != $len)) {$errflag="Short Read: wanted $len, got $got\n";}; } else { &CgiDie("cgi-lib.pl: Unknown request method: $meth\n"); } @mailman::in = split(/[&;]/,$mailman::in); push(@mailman::in, @ARGV) if $cmdflag; # add command-line parameters foreach $i (0 .. $#mailman::in) { # Convert plus to space $mailman::in[$i] =~ s/\+/ /g; # Split into key and value. ($key, $val) = split(/=/,$mailman::in[$i],2); # splits on the first =. # Convert %XX from hex numbers to alphanumeric $key =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge; $val =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge; # Associate key and value $mailman::in{$key} .= "\0" if (defined($mailman::in{$key})); # \0 is the multiple separator $mailman::in{$key} .= $val; } } elsif ($ENV{'CONTENT_TYPE'} =~ m/^multipart\/form-data/) { # for efficiency, compile multipart code only if needed $errflag = !(eval <<'END_MULTIPART'); my ($buf, $boundary, $head, @heads, $cd, $ct, $fname, $ctype, $blen); my ($bpos, $lpos, $left, $amt, $fn, $ser); my ($bufsize, $maxbound, $writefiles) = ($cgi_lib'bufsize, $cgi_lib'maxbound, $cgi_lib'writefiles); # The following lines exist solely to eliminate spurious warning messages $buf = ''; ($boundary) = $type =~ /boundary="([^"]+)"/; #"; # find boundary ($boundary) = $type =~ /boundary=(\S+)/ unless $boundary; &CgiDie ("Boundary not provided: probably a bug in your server") unless $boundary; $boundary = "--" . $boundary; $blen = length ($boundary); if ($ENV{'REQUEST_METHOD'} ne 'POST') { &CgiDie("Invalid request method for multipart/form-data: $meth\n"); } if ($writefiles) { my($me); stat ($writefiles); $writefiles = "/tmp" unless -d _ && -w _; # ($me) = $0 =~ m#([^/]*)$#; $writefiles .= "/$cgi_lib'filepre"; } # read in the data and split into parts: # put headers in @in and data in %in # General algorithm: # There are two dividers: the border and the '\r\n\r\n' between # header and body. Iterate between searching for these # Retain a buffer of size(bufsize+maxbound); the latter part is # to ensure that dividers don't get lost by wrapping between two bufs # Look for a divider in the current batch. If not found, then # save all of bufsize, move the maxbound extra buffer to the front of # the buffer, and read in a new bufsize bytes. If a divider is found, # save everything up to the divider. Then empty the buffer of everything # up to the end of the divider. Refill buffer to bufsize+maxbound # Note slightly odd organization. Code before BODY: really goes with # code following HEAD:, but is put first to 'pre-fill' buffers. BODY: # is placed before HEAD: because we first need to discard any 'preface,' # which would be analagous to a body without a preceeding head. $left = $len; PART: # find each part of the multi-part while reading data while (1) { die $@ if $errflag; $amt = ($left > $bufsize+$maxbound-length($buf) ? $bufsize+$maxbound-length($buf): $left); $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt); die "Short Read: wanted $amt, got $got\n" if $errflag; $left -= $amt; $mailman::in{$name} .= "\0" if defined $mailman::in{$name}; $mailman::in{$name} .= $fn if $fn; $name=~/([-\w]+)/; # This allows $insfn{$name} to be untainted if (defined $1) { $mailman::insfn{$1} .= "\0" if defined $mailman::insfn{$1}; $mailman::insfn{$1} .= $fn if $fn; } BODY: while (($bpos = index($buf, $boundary)) == -1) { if ($left == 0 && $buf eq '') { my $value; foreach $value (values %mailman::insfn) { unlink(split("\0",$value)); } &CgiDie("cgi-lib.pl: reached end of input while seeking boundary " . "of multipart. Format of CGI input is wrong.\n"); } die $@ if $errflag; if ($name) { # if no $name, then it's the prologue -- discard if ($fn) { print FILE substr($buf, 0, $bufsize); } else { $mailman::in{$name} .= substr($buf, 0, $bufsize); } } $buf = substr($buf, $bufsize); $amt = ($left > $bufsize ? $bufsize : $left); #$maxbound==length($buf); $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt); die "Short Read: wanted $amt, got $got\n" if $errflag; $left -= $amt; } if (defined $name) { # if no $name, then it's the prologue -- discard if ($fn) { print FILE substr($buf, 0, $bpos-2); } else { $mailman::in {$name} .= substr($buf, 0, $bpos-2); } # kill last \r\n } close (FILE); last PART if substr($buf, $bpos + $blen, 2) eq "--"; substr($buf, 0, $bpos+$blen+2) = ''; $amt = ($left > $bufsize+$maxbound-length($buf) ? $bufsize+$maxbound-length($buf) : $left); $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt); die "Short Read: wanted $amt, got $got\n" if $errflag; $left -= $amt; undef $head; undef $fn; HEAD: while (($lpos = index($buf, "\r\n\r\n")) == -1) { if ($left == 0 && $buf eq '') { my $value; foreach $value (values %mailman::insfn) { unlink(split("\0",$value)); } &CgiDie("cgi-lib: reached end of input while seeking end of " . "headers. Format of CGI input is wrong.\n$buf"); } die $@ if $errflag; $head .= substr($buf, 0, $bufsize); $buf = substr($buf, $bufsize); $amt = ($left > $bufsize ? $bufsize : $left); #$maxbound==length($buf); $errflag = (($got = read(STDIN, $buf, $amt, length($buf))) != $amt); die "Short Read: wanted $amt, got $got\n" if $errflag; $left -= $amt; } $head .= substr($buf, 0, $lpos+2); push (@mailman::in, $head); @heads = split("\r\n", $head); ($cd) = grep (/^\s*Content-Disposition:/i, @heads); ($ct) = grep (/^\s*Content-Type:/i, @heads); ($name) = $cd =~ /\bname="([^"]+)"/i; #"; ($name) = $cd =~ /\bname=([^\s:;]+)/i unless defined $name; ($fname) = $cd =~ /\bfilename="([^"]*)"/i; #"; # filename can be null-str ($fname) = $cd =~ /\bfilename=([^\s:;]+)/i unless defined $fname; $mailman::incfn{$name} .= (defined $mailman::in{$name} ? "\0" : "") . (defined $fname ? $fname : ""); ($ctype) = $ct =~ /^\s*Content-type:\s*"([^"]+)"/i; #"; ($ctype) = $ct =~ /^\s*Content-Type:\s*([^\s:;]+)/i unless defined $ctype; $mailman::inct{$name} .= (defined $mailman::in{$name} ? "\0" : "") . $ctype; if ($writefiles && defined $fname) { $ser++; $fn = $writefiles . ".$$.$ser"; open (FILE, ">$fn") || &CgiDie("Couldn't open $fn\n"); binmode (FILE); # write files accurately } substr($buf, 0, $lpos+4) = ''; undef $fname; undef $ctype; } 1; END_MULTIPART if ($errflag) { my ($errmsg, $value); $errmsg = $@ || $errflag; foreach $value (values %mailman::insfn) { unlink(split("\0",$value)); } &CgiDie($errmsg); } else { # everything's ok. } } else { &CgiDie("cgi-lib.pl: Unknown Content-type: $ENV{'CONTENT_TYPE'}\n"); } # no-ops to avoid warnings $mailman::insfn = $mailman::insfn; $mailman::incfn = $mailman::incfn; $mailman::inct = $mailman::inct; $^W = $perlwarn; return ($errflag ? undef : scalar(@mailman::in)); } # PrintHeader # Returns the magic line which tells WWW that we're an HTML document sub PrintHeader { return "Content-type: text/html\n\n"; } # HtmlTop # Returns the of a document and the beginning of the body # with the title and a body

header as specified by the parameter sub HtmlTop { my ($title) = @_; return < $title

$title

END_OF_TEXT } # HtmlBot # Returns the , codes for the bottom of every HTML page sub HtmlBot { return "\n\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 "\n\n$msg[0]\n\n\n"; } print "

$msg[0]

\n"; foreach $i (1 .. $#msg) { print "

$msg[$i]

\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
\n"; foreach $key (sort keys(%in)) { foreach (split("\0", $mailman::in{$key})) { ($out = $_) =~ s/\n/
\n/g; $output .= "
$key\n
:$out:
\n"; } } $output .= "
\n"; return $output; } # PrintEnv # Nicely formats all environment variables and returns HTML string sub PrintEnv { &PrintVariables(*ENV); } # The following lines exist only to avoid warning messages $cgi_lib'writefiles = $cgi_lib'writefiles; $cgi_lib'bufsize = $cgi_lib'bufsize ; $cgi_lib'maxbound = $cgi_lib'maxbound; $cgi_lib'version = $cgi_lib'version; $cgi_lib'filepre = $cgi_lib'filepre; ############################################################################ # MailMan code begins here. ############################################################################ use Socket; use FileHandle; my($mma) = new FileHandle(); &ReadParse; { my($mmb) = 0; my($mmc); foreach $mmc (keys(%mailman::in)) { if($mmc =~ /^(.+)\.[xy]$/) { my($mmd) = $1; if($mmc =~ /^([^\#]+)\#(.*)\.[xy]$/) { $mmd = $1; $mailman::in{$mmd} = mmto($2); } else { $mailman::in{$mmd} = 'MAILMANSPECIALTRUE'; } } else { if($mmc =~ /^([^\#]+)\#(.*)$/) { $mailman::in{$1} = mmto($2); } } } } if($mailman::in{'INTERFACE'}) { my(@mme) = split(/\&/,$mailman::in{'INTERFACE'}); my($mmf) = ''; foreach $mmf (@mme) { if($mmf =~ /^([^\=]+)\=(.*)$/) { $mailman::in{$1} = mmto($2); } } unless($mailman::in{'INTERFACE'} =~ /ALTERNATE_TEMPLATES/) { $mailman::in{'ALTERNATE_TEMPLATES'} = ''; } } { @mailman::mmg = split(/\;/,$ENV{'HTTP_COOKIE'}); my($mmh) = ''; foreach $mailman::mmh (@mailman::mmg) { $mailman::mmi = 1; if($mailman::mmh =~ /MailManAuth\=(\S+)/) { my(@mmj) = split(/\&/,$1); my($mmk) = ''; foreach $mmk (@mmj) { $mmk =~ /^(.+)\#(.+)$/; unless($mailman::in{$1}) { $mailman::in{$1} = $2; } } } if($mailman::mmh =~ /MailManDir\=(\S+)/) { $mailman::mml = mmto($1); } } } $mailman::mmm = mmts($mailman::in{'USERNAME'}); $mailman::mmm =~ s/^\s*([^\s]+)\s*$/$1/; if($mailman::bCaseInsensitiveAccounts) { $mailman::mmm =~ tr/[A-Z]/[a-z]/; } $mailman::mmn = mmtr($mailman::mmm); $mailman::mmo = mmts($mailman::in{'PASSWORD'}); $mailman::mmo =~ s/^\s*([^\s]+)\s*$/$1/; $mailman::mmp = mmtr($mailman::mmo); unless($mailman::strIncomingServer) { $mailman::strIncomingServer = mmts($mailman::in{'SERVER'}); $mailman::strIncomingServer =~ s/^\s*([^\s]+)\s*$/$1/; $mailman::strIncomingServer =~ tr/[A-Z]/[a-z]/; } $mailman::mmq = mmtr($mailman::strIncomingServer); unless($mailman::strOutgoingServer) { $mailman::strOutgoingServer = $mailman::in{'OUTGOING'}; $mailman::strOutgoingServer =~ s/^\s*([^\s]+)\s*$/$1/; $mailman::strOutgoingServer =~ tr/[A-Z]/[a-z]/; } $mailman::mmr = ''; unless($mailman::strLocalLocationUsers =~ /[\/\\]$/) { $mailman::strLocalLocationUsers .= '/'; } $mailman::mms = $mailman::mmm . '@' . $mailman::strIncomingServer; $mailman::mms =~ tr/[A-Z]/[a-z]/; $mailman::mmt = $mailman::strLocalLocationUsers . mmtn($mailman::mms); if(defined($mailman::strLocalLocationAttachments) && defined($mailman::strURLLocationAttachments)) { unless($mailman::strLocalLocationAttachments =~ /[\/\\]$/) { $mailman::strLocalLocationAttachments .= '/'; } unless($mailman::strURLLocationAttachments =~ /[\/\\]$/) { $mailman::strURLLocationAttachments .= '/'; } $mailman::mmu = $mailman::strLocalLocationAttachments . mmtn($mailman::mmm . '@' . $mailman::strIncomingServer); $mailman::mmv = $mailman::strURLLocationAttachments . mmtn( mmtn($mailman::mmm . '@' . $mailman::strIncomingServer)); $mailman::mmw = 1; } $mailman::mmx = mmtm($ENV{SERVER_NAME},42); $mailman::mmx .= mmtm($ENV{REMOTE_HOST} . $ENV{REMOTE_ADDR},69); $mailman::mmy = mmtr($mailman::mmx); mmtl(); $mailman::mmz = $ENV{SCRIPT_NAME}; unless($mailman::mmz =~ /^\//) { $mailman::mmz = "/$mailman::mmz"; } $mailman::mmaa = $mailman::mmz; $mailman::mmaa =~ s/^(.*[\\\/])[^\\\/]+$/$1/; if($mailman::mmaa eq '/') { $mailman::mmab = ''; } else { $mailman::mmab = "path=$mailman::mmaa; "; } sub mmqo { if($mailman::in{'NOFRAMES'}) { $mailman::mmac = 1; } if($mailman::in{'NOCACHE'}) { $mailman::mmad = 1; } if(defined($mailman::in{'ALTERNATE_TEMPLATES'})) { $mailman::mmae = $mailman::in{'ALTERNATE_TEMPLATES'}; $mailman::mmae =~ s/^[\\\/](.+)$/$1/; $mailman::mmae =~ s/\.\.[\/\\]//; $mailman::mmae =~ s/\x00//g; } if(!defined($mailman::mmaf)) { $mailman::mmaf = mmto($mailman::in{'FOLDER'}); } if(($mailman::mmaf eq '') && ($mailman::mml ne '')) { $mailman::mmaf = $mailman::mml; } } sub mmqp { my($mmag) = shift; my($mmb) = 0; my($mmc); foreach $mmc (keys(%mailman::in)) { if($mmc =~ /^$mmag\:(.*)$/) { return $1; } } return; } mmqo(); mmqq(); { my($mmh) = ''; @mailman::mmg = split(/\;/,$ENV{'HTTP_COOKIE'}); foreach $mailman::mmh (@mailman::mmg) { if($mailman::mmh =~ /MailManCmds\=(\S+)/) { my($mmah) = ''; @mailman::mmai = split(/\&/,$1); foreach $mmah (@mailman::mmai) { $mmah =~ /^(.+)\#(.+)$/; unless($mailman::in{$1}) { $mailman::in{$1} = $2; } } } } } mmqo(); mmqq(); mmqt(); sub mmqq { my($mmaj) = ''; if($mailman::in{'BLANK'}) { mmtk('t_blank.htm'); } if($mailman::in{'MENU'}) { mmtk('t_f_menu.htm'); } if($mailman::in{'LOGOUT'}) { if($mailman::mmw) { mmuj(); } mmre(); if($mailman::bKioskMode) { print "Set-cookie: MailManAuth=;$mailman::mmab" . "expires=Sun, 03-May-1998 16:00:00 GMT\n"; print "Set-cookie: MailManCmds=;$mailman::mmab" . "expires=Sun, 03-May-1998 16:00:00 GMT\n"; print "Set-cookie: MailManDir=;$mailman::mmab" . "expires=Sun, 03-May-1998 16:00:00 GMT\n"; $mailman::mmm = ''; mmtk('t_closewindow.htm'); } else { if($mailman::strURLRedirectLocation) { print "Location: $mailman::strURLRedirectLocation\n\n"; } else { mmqt(); } } } if($mailman::in{'START'}) { mmqt(); } if($mailman::in{'PURGE'}) { mmre(); } if($mailman::in{'PREFERENCES'}) { mmrn(); } if($mailman::in{'SAVEPREFERENCES'}) { mmro(); $mailman::mmak = $mailman::in{'PREF_REALNAME'}; $mailman::mmal = $mailman::in{'PREF_EMAIL'}; $mailman::mmam = $mailman::in{'PREF_SIGNATURE'}; $mailman::mman = $mailman::in{'PREF_OUTGOING'}; if($mailman::in{'PREF_NUMPERPAGE'} =~ /^\s*(\d+)\s*$/) { $mailman::mmao = $1; } if($mailman::in{'PREF_DELETEDOWNLOAD'}) { $mailman::mmap = 1; } else { $mailman::mmap = 1; } if($mailman::in{'PREF_DELETEPROXY'}) { $mailman::mmaq = 1; } else { $mailman::mmaq = 0; } if($mailman::in{'PREF_DELETESAVE'}) { $mailman::mmar = 1; } else { $mailman::mmar = 0; } if($mailman::in{'PREF_SENDSAVE'}) { $mailman::mmas = 1; } else { $mailman::mmas = 0; } if($mailman::in{'PREF_PURGETRASH'}) { $mailman::mmat = 1; } else { $mailman::mmat = 0; } if($mailman::in{'PREF_STARTUP'}) { $mailman::mmau = $mailman::in{'PREF_STARTUP'}; } mmrp(); $mailman::in{'LOGIN'} = 1; } if($mailman::in{'FOLDERS'}) { mmrm(); } if($mailman::in{'FOLDERCHANGE'}) { if($mailman::in{'FOLDERCHANGE'} ne 'MAILMANSPECIALTRUE') { $mailman::mmaf = mmto( $mailman::in{'FOLDERCHANGE'}); } elsif(defined($mailman::in{'FOLDERCHANGELIST'}) && !($mailman::in{'FOLDERCHANGELIST'} eq 'MAILMANSPECIALSELECT')) { $mailman::mmaf = mmto($mailman::in{'FOLDERCHANGELIST'}); } if($mailman::in{'FRAMERELOAD'} && !($mailman::mmac)) { mmtk('t_f_frameset.htm'); } else { if($mailman::mmaf eq 'INBOX') { mmra(); } mmsf(); } } if($mailman::in{'FOLDERNEW'}) { if($mailman::in{'FOLDERNEWNAME'}) { $mailman::mmaf = $mailman::in{'FOLDERNEWNAME'}; mmqy(); mmqz(); } mmrm(); } if($mailman::in{'FOLDERDELETE'}) { my($mmav) = $mailman::mmt . '/' . mmtn($mailman::in{'FOLDERDELETE'}); if(mmtz($mmav) == 0 && -d $mmav) { opendir(DELETEDIR, $mmav); my(@mmaw) = readdir(DELETEDIR); closedir(DELETEDIR); my($mmax); foreach $mmax (@mmaw) { unlink("${mmav}/${mmax}"); } rmdir($mmav); } $mailman::mmaf = 'INBOX'; mmrm(); } if($mailman::in{'ADDRESSES'}) { mmrq(); } if($mailman::in{'ADDRESSCOMPOSE'}) { my($mmay) = ''; my($mmaz) = ''; $mmaz = $mailman::in{'ADDRESSCOMPOSE'}; mmrr(); if(defined($mailman::mmba{$mmaz})) { my($mmbb) = $mailman::mmba{$mmaz}->{'FIRSTNAME'}; my($mmbc) = $mailman::mmba{$mmaz}->{'LASTNAME'}; my($mmbd) = $mailman::mmba{$mmaz}->{'ADDRESS'}; $mmay = "$mmbb $mmbc " . "<$mmbd>" } mmrs(); if(defined($mailman::mmbe{$mmaz})) { $mmay = $mailman::mmbe{$mmaz}; $mmay =~ s/(\r\n)|(\r\n)/,\ /g; $mmay =~ s/[\r\n]/,\ /g; $mmay =~ s/\,\ $//g; } mmtb('NEW',undef,undef,$mmay); } if($mailman::in{'ADDRESSESNEWINDIVIDUAL'}) { mmrt(); } if($mailman::in{'ADDRESSDELETEINDIVIDUAL'}) { mmrv( $mailman::in{'ADDRESSDELETEINDIVIDUAL'}); mmrq(); } if($mailman::in{'ADDRESSINDIVIDUAL'}) { mmrt(); } if($mailman::in{'SAVEADDRESSINDIVIDUAL'}) { mmrx(); mmrq(); } if($mailman::in{'ADDRESSESNEWGROUP'}) { mmru(); } if($mailman::in{'ADDRESSDELETEGROUP'}) { mmrw( $mailman::in{'ADDRESSDELETEGROUP'}); mmrq(); } if($mailman::in{'ADDRESSGROUP'}) { mmru(); } if($mailman::in{'SAVEADDRESSGROUP'}) { mmry(); mmrq(); } if($mailman::in{'ACCOUNTS'}) { mmrz(); } if($mailman::in{'ACCOUNTNEW'}) { mmsa(); } if($mailman::in{'ACCOUNTDELETE'}) { mmsc($mailman::in{'ACCOUNTDELETE'}); mmrz(); } if($mailman::in{'SAVEACCOUNT'}) { mmsb(); mmra(); mmrz(); } if($mailman::in{'ACCOUNT'}) { mmsa(); } if($mailman::in{'DELETEACCOUNT'}) { mmsc( $mailman::in{'DELETEACCOUNT'}); mmrz(); } if($mailman::in{'LOGIN'}) { my($mmbf) = ''; if($mmbf = mmqv()) { if(defined($mmbf)) { $mmbf =~ s/^\-ERR(.*)$/$1/; } $mailman::bKioskMode = 0; $mailman::mmbg{'GREETING'} = "
Log In Error: $mmbf
"; mmtk('t_login.htm',\%mailman::mmbg); } if($mailman::mmw) { mmuj(); } mmro(); if($mailman::mmac) { mmra(); if($mailman::mmau eq 'FOLDERS') { mmrm(); } else { mmsf(); } } else { if($mailman::mmau eq 'FOLDERS') { mmrm(); } else { mmtk('t_f_frameset.htm'); } } } if($mailman::bUseHijackTest && $mailman::in{'CHECKSUM'} && $mailman::in{'CHECKSUM'} ne '') { if(mmts($mailman::in{'CHECKSUM'}) ne $mailman::mmx) { mmqr( qq|Your MailMan session was initiated from a different network address than\n| . qq|your current location. For security reasons, MailMan will not continue.\n| . qq|You must log in again\n| . qq|from this location to continue.\n| ); } } if($mailman::in{'RELOAD'}) { if($mailman::mmac) { mmra(); mmsf(); } else { mmtk('t_f_frameset.htm'); } } if($mailman::in{'LOADACCOUNT'}) { mmrb($mailman::in{'LOADACCOUNT'}); if($mailman::mmac) { mmsf(); } else { mmtk('t_f_frameset.htm'); } } if($mmaj = mmqp('LIST')) { if($mailman::mmaf eq 'INBOX' || $mailman::mmaf eq '') { mmra(); } mmsf($mmaj); } if($mailman::in{'LIST'}) { if($mailman::mmaf eq 'INBOX' || $mailman::mmaf eq '') { mmrc(); } mmsf(); } my($mmbh) = $mailman::in{'BACKGROUND'}; if($mmbh) { if($mailman::mmac) { print "Location: $mmbh\n\n"; exit(0); } else { mmse($mmbh); } } if($mmbh = $mailman::in{'BACKGROUNDFRAME'}) { mmtk('t_backgroundframe.htm'); } if($mmaj = mmqp('SHOW')) { my($mmbi) = -1; if($mmaj =~ /^(.+)mimepart\:(.+)$/) { $mmbi = $1; $mailman::mmbj = $2; $mailman::mmbj =~ s/%(..)/pack("c",hex($1))/ge; } elsif($mmaj =~ /^(.+)cid\:(.+)$/) { $mmbi = $1; $mailman::mmbk = $2; $mailman::mmbk = mmto($2); } else { $mmbi = $mmaj; } $mmbi = mmto($mmbi); $mmbi = mmrl($mmbi); mmst($mmbi,0); } if($mmaj = mmqp('SOURCE')) { my($mmbi) = mmto($mmaj); $mmbi = mmrl($mmbi); mmsu($mmbi); } if($mmaj = mmqp('PREV')) { my($mmbi) = mmto($mmaj); $mmbi = mmrl($mmbi); mmst($mmbi,-1); } if($mmaj = mmqp('NEXT')) { my($mmbi) = mmto($mmaj); $mmbi = mmrl($mmbi); mmst($mmbi,1); } if($mmaj = mmqp('DELETE')) { my($mmbf) = mmqv(); if($mmbf) { mmqr($mmbf); } my($mmbi) = mmto($mmaj); $mmbi = mmrl($mmbi); mmsw($mmbi); mmqu($mma,"QUIT"); close $mma; $mailman::mmbl = 0; if($mailman::mmac) { mmsf(); } else { mmtk('t_f_frameset.htm'); } } if($mailman::in{'DELETEMARKED'}) { my($mmbf) = ''; if($mmbf = mmqv()) { mmqr($mmbf); } my($mmb) = 0; my($mmc); foreach $mmc (keys(%mailman::in)) { if($mmc =~ /^MARK\:(.*)$/) { my($mmbi) = mmto($1); $mmbi = mmrl($mmbi); mmsw($mmbi); } } mmqu($mma,"QUIT"); close $mma; $mailman::mmbl = 0; if($mailman::mmac) { mmsf(); } else { mmtk('t_f_frameset.htm'); } } if($mmaj = mmqp('MOVE')) { my($mmbm) = mmtn($mailman::in{'FOLDERTRANSFERLIST'}); if($mmbm eq 'MAILMANSPECIALSELECT' || $mmbm eq '') { mmsf(); } my($mmbf) = ''; if($mmbf = mmqv()) { mmqr($mmbf); } my($mmbi) = mmto($mmaj); $mmbi = mmrl($mmbi); if(mmsz($mmbi,$mmbm)) { mmsx($mmbi,'MOVED'); } mmqu($mma,"QUIT"); close $mma; $mailman::mmbl = 0; if($mailman::mmac) { mmsf(); } else { mmtk('t_f_frameset.htm'); } } if($mailman::in{'MOVEMARKED'}) { my($mmbm) = mmtn($mailman::in{'FOLDERTRANSFERLIST'}); if($mmbm eq 'MAILMANSPECIALSELECT' || $mmbm eq '') { mmsf(); } my($mmbf) = ''; if($mmbf = mmqv()) { mmqr($mmbf); } my($mmb) = 0; my($mmc); foreach $mmc (keys(%mailman::in)) { if($mmc =~ /^MARK\:(.*)$/) { my($mmbi) = mmto($1); $mmbi = mmrl($mmbi); if(mmsz($mmbi,$mmbm)) { mmsx($mmbi,'MOVED'); } } } mmqu($mma,"QUIT"); close $mma; $mailman::mmbl = 0; if($mailman::mmac) { mmsf(); } else { mmtk('t_f_frameset.htm'); } } if($mailman::in{'NEW'}) { $mailman::in{'ATTACH'} = 0; mmtb('NEW',0,0); } if($mailman::in{'USEATTACH'}) { $mailman::in{'ATTACH'} = 1; mmtc(''); } if($mmaj = mmqp('REPLY')) { my($mmbi) = mmto($mmaj); $mmbi = mmrl($mmbi); mmtb($mmbi,0,0); } if($mmaj = mmqp('REPLYALL')) { my($mmbi) = mmto($mmaj); $mmbi = mmrl($mmbi); mmtb($mmbi,1,0); } if($mmaj = mmqp('FORWARD')) { my($mmbi) = mmto($mmaj); $mmbi = mmrl($mmbi); mmtb($mmbi,0,1); } if($mailman::in{'SEND'}) { mmte(); } if($mailman::in{'HELP'}) { mmtk('t_help.htm'); } } sub mmqr { my($mmbn,$mmbo) = @_; my($mmbp) = ''; if($mmbn eq "ALRM") { if($mailman::bUseAlarm){ alarm(0); } $mmbn = $mailman::mmbq; mmqu($mma,"QUIT"); close $mma; } if($mailman::mmac) { $mmbp = 't_nf_error.htm'; } else { $mmbp = 't_f_error.htm'; } my(%mmbg); $mmbg{'ERROR'} = $mmbn; mmtk($mmbp,\%mmbg); unless($mmbo) { exit(1); } } sub mmqs { my($mmbr) = @_; my($mmbp) = ''; print CGI->multipart_start(); if($mailman::mmac) { $mmbp = 't_nf_status.htm'; } else { $mmbp = 't_f_status.htm'; } my(%mmbg); $mmbg{'STATUS'} = $mmbr; mmtk($mmbp,\%mmbg); print CGI->multipart_end(); } sub mmqt { print "Set-cookie: MailManAuth=;$mailman::mmab" . "expires=Sun, 03-May-1998 16:00:00 GMT\n"; print "Set-cookie: MailManCmds=;$mailman::mmab" . "expires=Sun, 03-May-1998 16:00:00 GMT\n"; print "Set-cookie: MailManDir=;$mailman::mmab" . "expires=Sun, 03-May-1998 16:00:00 GMT\n"; print "Expires: Sun, 03 May 1998 16:00:00 GMT\n"; $mailman::mmm = ''; $mailman::mmaf = ''; if($mailman::bKioskMode) { my($mmbs) = ''; ($mailman::mmbg{'GREETING'},$mmbs) = mmtj('t_login.htm', ('GREETING','KIOSKMODESCRIPT')); $mailman::mmbg{'HTMLCOMMENTBEGIN'} = ''; $mailman::mmbg{'KIOSKMODESCRIPT'} = mmtg($mmbs,\%mailman::mmbg); $mailman::mmbg{'HTMLCOMMENTBEGIN'} = ''; $mailman::mmbg{'HTMLCOMMENTEND'} = ''; } else { $mailman::mmbg{'GREETING'} = mmti('t_login.htm','GREETING'); } mmtk('t_login.htm',\%mailman::mmbg); } sub mmqu { my($mmbv) = "\015\012"; my($mmbw, $mmbx) = @_; my($mmby) = length($mmbx . $mmbv); syswrite($mmbw,$mmbx . $mmbv,$mmby); } sub mmqv { if($mailman::mmbl){ return; } my($mmbz); unless(defined($mailman::mmm) && $mailman::mmm ne '') { return("No username provided, cannot proceed."); } unless(defined($mailman::mmo) && $mailman::mmo ne '') { return("No password provided, cannot proceed."); } unless(defined($mailman::strIncomingServer) && $mailman::strIncomingServer ne '') { return("No server provided, cannot proceed."); } retrylogin: if($mailman::bUseAlarm) { $mailman::mmbq = "Connection to server timed out."; $SIG{'ALRM'} = \&mmqr; alarm($mailman::iTimeoutDurationInSeconds); } my($mmca) = 0; $mmca = getprotobyname('tcp'); socket($mma,PF_INET,SOCK_STREAM,$mmca); my($mmcb) = 0; $mmcb = gethostbyname($mailman::strIncomingServer); unless($mmcb) { return("Could not find an IP address for the host " . "\"$mailman::strIncomingServer\"."); } my($mmcc) = ''; $mmcc = sockaddr_in(110, $mmcb); unless(connect($mma, $mmcc)) { return("Could not connect to server " . "\"$mailman::strIncomingServer\", \"$!\""); } select($mma); $|=1; select(STDOUT); binmode($mma); $mailman::mmbq = "The server connected, but will not respond."; if($mailman::bUseAlarm){ alarm($mailman::iTimeoutDurationInSeconds); } unless(<$mma> =~ /^\+OK/) { return("The server does not respond appropriately."); } $mailman::mmbq = "The server timed out during login."; if($mailman::bUseAlarm){ alarm($mailman::iTimeoutDurationInSeconds); } mmqu($mma,"USER $mailman::mmm"); my($mmcd) = ''; $mmcd = <$mma>; unless($mmcd =~ /^\+OK/) { return($mmcd); } mmqu($mma,"PASS $mailman::mmo"); $mmcd = <$mma>; unless($mmcd =~ /^\+OK/) { if((($mmcd =~ /another session/i) || ($mmcd =~ /another POP3 session/i) || ($mmcd =~ /mailbox in use/i) || ($mmcd =~ /unable to lock/i) || ($mmcd =~ /mailbox busy/i)) && $mmbz < 12) { mmqu($mma,"QUIT"); close $mma; $mmbz++; sleep(5); goto retrylogin; } else { return "Access denied: $mmcd"; } return($mmcd); } if($mailman::bUseAlarm) { alarm(0); } mmqu($mma,'STAT'); $mmcd = <$mma>; $mmcd =~ /^\+OK\s+(\d+)\s+/i; $mailman::mmce = $1; if($mailman::mmce == 0) { $mailman::mmbl = 1; return; } mmqu($mma,"LIST"); $mmcd = <$mma>; unless($mmcd =~ /^\+OK/) { return($mmcd); } $mailman::mmce = 0; while(<$mma> =~ /(\d+) (\d+)/) { $mailman::mmcf[$1] = $2; $mailman::mmce++; } $mailman::mmbl = 1; return; } sub mmqw { my($mmcg,$mmch) = @_; my($mmci) = ''; if(defined($mmcg) && defined($mmch)) { $mmci .= mmtn( $mmch . $mailman::mmcj[$mmcg]) . '|'; } else { $mmci .= mmtn( $mailman::mmck) . '|'; } $mmci .= mmtn($mailman::mmm) . '|'; $mmci .= mmtn($mailman::strIncomingServer) . '|'; $mmci .= mmtn($mailman::mmay) . '|'; $mmci .= mmtn($mailman::mmcl) . '|'; $mmci .= mmtn($mailman::mmcm) . '|'; $mmci .= mmtn($mailman::mmcn) . '|'; $mmci .= mmtn($mailman::mmco) . '|'; $mmci .= mmtn($mailman::mmcp) . '|'; $mmci .= mmtn($mailman::mmcq) . '|'; if(defined($mmcg)) { $mmci .= $mailman::mmcf[$mmcg] . '|'; } else { $mmci .= $mailman::mmcf . '|'; } $mmci .= $mailman::mmcr . '|'; $mmci .= $mailman::mmcs . '|'; $mmci .= $mailman::mmct; return $mmci; } sub mmqx { my($mmcu) = @_; chomp($mmcu); my(@mmcv) = split(/\|/,$mmcu); if($#mmcv < 12) { return 0; } $mailman::mmck = mmto($mmcv[0]); $mailman::mmcw = mmto($mmcv[1]); $mailman::mmcx= mmto($mmcv[2]); $mailman::mmay = mmto($mmcv[3]); $mailman::mmcl = mmto($mmcv[4]); $mailman::mmcm = mmto($mmcv[5]); $mailman::mmcn = mmto($mmcv[6]); $mailman::mmco = mmto($mmcv[7]); $mailman::mmcp = mmto($mmcv[8]); $mailman::mmcq = mmto($mmcv[9]); $mailman::mmcf = $mmcv[10]; $mailman::mmcr = $mmcv[11]; $mailman::mmcr =~ s/\s//g; $mailman::mmcs = $mmcv[12]; $mailman::mmcs =~ s/\s//g; $mailman::mmct = $mmcv[13]; unless($mailman::mmay){ $mailman::mmay = "Unknown";} unless($mailman::mmcm){ $mailman::mmcm = "Unknown";} unless($mailman::mmcn){ $mailman::mmcn = "Unknown";} unless($mailman::mmcp){ $mailman::mmcp = "Unspecified";} $mailman::mmcy = mmrj(mmrh($mailman::mmay)); $mailman::mmcz = mmrj(mmrh($mailman::mmcm)); $mailman::mmda = mmrj(mmrh($mailman::mmcp)); $mailman::mmdb = mmrj(mmrh($mailman::mmcn)); return 1; } sub mmqy { unless(-d $mailman::strLocalLocationUsers) { mmqr("Could not locate directory \"" . "$mailman::strLocalLocationUsers\" for user information."); } unless(-d $mailman::mmt) { unless(mkdir($mailman::mmt,0755)) { mmqr( "Could not create user directory \"$mailman::mmt\" " . "in \"$mailman::strLocalLocationUsers\". Make sure that " . "\"$mailman::strLocalLocationUsers\" is writable by the " . "web user."); } if(defined($mailman::iLocalDirectoryPermissions)) { mmtt($mailman::mmt, $mailman::iLocalDirectoryPermissions); } } } sub mmqz { unless($mailman::mmaf) { return; } my($mmdc) = $mailman::mmt . '/' . mmtn($mailman::mmaf); unless(-d $mmdc) { unless(mkdir($mmdc,0755)) { mmqr("Could not create directory for folder " . "\"$mailman::mmaf\" " . "in \"$mailman::mmt\". Make sure that " . "\"$mailman::mmt\" is writable by the " . "web user."); } if(defined($mailman::iLocalDirectoryPermissions)) { mmtt($mmdc,, $mailman::iLocalDirectoryPermissions); } if($mailman::mmaf eq 'INBOX') { $mailman::mmaf = 'SENT'; mmqz(); $mailman::mmaf = 'TRASH'; mmqz(); $mailman::mmaf = 'INBOX'; } } } sub mmra { $mailman::mmaf = 'INBOX'; mmrc(); if($mailman::bDownloadIndividualAccounts) { return; } mmsd(); my($mmdd,$mmde,$mmdf) = ('','',''); if($mailman::mmdg) { $mmdd = $mailman::mmm; $mmde = $mailman::mmo; $mmdf = $mailman::strIncomingServer; } my($mmdh) = ''; foreach $mmdh (keys %mailman::mmdi) { $mailman::mmm = $mailman::mmdi{$mmdh}->{'ACCOUNTITEM_USERNAME'}; $mailman::mmo = $mailman::mmdi{$mmdh}->{'ACCOUNTITEM_PASSWORD'}; $mailman::strIncomingServer = $mailman::mmdi{$mmdh}->{'ACCOUNTITEM_SERVER'}; $mailman::mmaf = $mailman::mmdi{$mmdh}->{'ACCOUNTITEM_FOLDER'}; mmrc(); } if($mailman::mmdg) { $mailman::mmm = $mmdd; $mailman::mmo = $mmde; $mailman::strIncomingServer = $mmdf; $mailman::mmaf = 'INBOX'; } } sub mmrb { my($mmdj) = shift; mmsd(); my($mmdd,$mmde,$mmdf) = ('','',''); if($mailman::mmdg) { $mmdd = $mailman::mmm; $mmde = $mailman::mmo; $mmdf = $mailman::strIncomingServer; } my($mmdh) = ''; foreach $mmdh (keys %mailman::mmdi) { $mailman::mmm = $mailman::mmdi{$mmdh}->{'ACCOUNTITEM_USERNAME'}; $mailman::mmo = $mailman::mmdi{$mmdh}->{'ACCOUNTITEM_PASSWORD'}; $mailman::strIncomingServer = $mailman::mmdi{$mmdh}->{'ACCOUNTITEM_SERVER'}; $mailman::mmaf = $mailman::mmdi{$mmdh}->{'ACCOUNTITEM_FOLDER'}; if($mmdh =~ /$mmdj/i) { mmrc(); } } if($mailman::mmdg) { $mailman::mmm = $mmdd; $mailman::mmo = $mmde; $mailman::strIncomingServer = $mmdf; } } sub mmrc { unless(defined($mailman::mmaf) && length($mailman::mmaf)) { $mailman::mmaf = 'INBOX'; } my($mmbf) = ''; if($mmbf = mmqv()) { mmqr($mmbf); } if($mailman::iUserDiskQuota) { unless($mailman::mmdk) { mmub(); } if($mailman::mmdk >= $mailman::iUserDiskQuota) { return; } } mmqy(); mmqz(); mmro(); use Fcntl; my($mmch) = $mailman::mmm . '@' . $mailman::strIncomingServer . '@'; if($mailman::mmce == 0) { mmqu($mma,"QUIT"); close $mma; $mailman::mmbl = 0; return; } mmqu($mma,"UIDL"); my($mmcd) = ''; $mmcd = <$mma>; unless($mmcd =~ /^\+OK/) { mmqr($mmcd); } my $mmb=0; while(<$mma> =~ /(\d+)\s+(\S+)/) { my($mmce,$mmdl) = ($1, $2); if(defined($mailman::mmdm) && $mailman::mmdm) { $mmdl =~ s/(\w)/sprintf("%02x", ord($1))/eg; } $mailman::mmdn[$mmb] = $mmce; $mailman::mmcj[$mmce] = $mmdl; $mailman::mmdo{$mmch . $mmdl} = 1; $mmb++; } my $mmdp = $mmb; retry: my(%mmdq); my($mmdr) = ''; my(%mmds) = (); my(%mmdt) = (); my($mmcg) = my($mmdu) = 0; my($mmdv) = 0; my(%mmdw); my($mmdx) = new FileHandle(); my($mmdy) = $mailman::mmt . '/INBOX/msglist'; if(open($mmdx,"<$mmdy")) { flock($mmdx,2); my($mmbx) = ''; $mmbx = <$mmdx>; if($mmbx =~ /^(\d+)\s(\d+)\s/) { $mmcg = $1; } elsif($mmbx =~ /^(\d+)\s/) { $mmcg = $1; } else { close($mmdx); mmug($mailman::mmt . '/INBOX'); goto retry; } $mmdu = 0; while(defined($_ = <$mmdx>)) { chomp; if(/^([^\|]+)\|/ && mmqx($_)) { my($mmdz) = mmto($1); $mmdq{$mmdz} = 1; $mmdu++; unless(defined($mailman::mmct) && $mailman::mmct =~ /R/i) { $mmdv++; } my($mmea) = $mailman::mmco; my($mmeb) = 0; while(defined($mmds{$mmea})) { if($mmea =~ s/^([^\_]*)\_(\d+)/$1/) { $mmeb++; } $mmea .= "_$mmeb"; } $mmds{$mmea} = $_; } elsif(/^DELETED\:\s+(\S+)\s*$/) { my($mmdz) = mmto($1); if($mailman::mmdo{$mmdz} || $mmdz !~ /^$mmch/) { $mmdq{$mmdz} = 1; $mmdw{$mmdz} = 1; $mmdr .= $_ . "\n"; } } elsif(/^\S+\:\s+(\S+)\s*$/) { my($mmdz) = mmto($1); if($mailman::mmdo{$mmdz} || $mmdz !~ /^$mmch/) { $mmdq{$mmdz} = 1; $mmdr .= $_ . "\n"; } } } if($mmdu != $mmcg) { close($mmdx); mmug($mailman::mmt . '/INBOX'); goto retry; } close($mmdx); } my($mmec); my($mmed) = ''; my($mmee) = 0; my($mmef) = 0; my($mmeg) = 0; message: for($mmb=0;$mmb<$mmdp;$mmb++) { if($mmeg) { last message; } $mmec = $mailman::mmdn[$mmb]; my($mmeh) = $mmch . $mailman::mmcj[$mmec]; if($mailman::mmaq) { if($mmdw{$mmeh}) { mmqu($mma,"DELE $mmec"); $mmcd = <$mma>; unless($mmcd =~ /^\+OK/) { mmqr("While trying to delete a message " . "that has been deleted from your message " . "folders, your POP3 server responded " . "\"$mmcd\""); } } } unless($mmdq{$mmeh}) { my($mmei) = mmtn($mmch . $mailman::mmcj[$mmec]); mmrd($mmec,$mmei); if($mailman::iUserDiskQuota) { $mailman::mmdk += (-s "${mailman::mmt}/" . mmtn($mailman::mmaf) . "/$mmei"); if($mailman::mmdk >= $mailman::iUserDiskQuota) { $mmeg = 1; } } $mailman::mmct = ''; my($mmej) = mmqw($mmec, $mmch); my($mmea) = mmtu($mailman::mmcn); if($mailman::mmaf eq 'INBOX') { my($mmeb) = 0; while(defined($mmds{$mmea})) { if($mmea =~ s/^([^\_]*)\_(\d+)/$1/) { $mmeb++; } $mmea .= "_$mmeb"; } $mmds{$mmea} = $mmej; $mmee++; } else { $mmdr .= 'MOVED: ' . mmtn($mmeh) . "\n"; my($mmeb) = 0; while(defined($mmdt{$mmea})) { if($mmea =~ s/^([^\_]*)\_(\d+)/$1/) { $mmeb++; } $mmea .= "_$mmeb"; } $mmdt{$mmea} = $mmej; $mmef++; } if($mailman::mmap) { mmqu($mma, "DELE $mmec"); $mmcd = <$mma>; unless($mmcd =~ /^\+OK/) { mmqr($mmcd); } } } } unless(open($mmdx,">$mmdy")) { mmqr("Could not create user message list in \"" . $mmdy ."\". Make sure that the " . "directory is writable by the web user."); } flock($mmdx,2); $mailman::mmce = $mmcg + $mmee; print {$mmdx} "$mailman::mmce $mmdv\n"; my($mmej) = ''; foreach $mmej (sort {$a <=> $b} keys %mmds) { print {$mmdx} $mmds{$mmej} . "\n"; } print {$mmdx} "\n" . $mmdr; close($mmdx); if(($mailman::mmaf ne 'INBOX') && $mmef) { mmta(mmtn($mailman::mmaf), $mmef, \%mmdt); } mmqu($mma,"QUIT"); close $mma; $mailman::mmbl = 0; } sub mmrd { my($mmec,$mmek) = @_; my($mmel) = new FileHandle(); mmrf($mmec); $mmek = "${mailman::mmt}/" . mmtn($mailman::mmaf) . "/$mmek"; unless(open($mmel,">$mmek")) { mmqr("Could not create file to store message " . "in \"$mmek\". Make sure that the " . "directory is writable by the web user."); } my($mmem) = $mmec; mmqu($mma,"RETR $mmem"); my($mmcd) = ''; $mmcd = <$mma>; unless($mmcd =~ /^\+OK/) { mmqr($mmcd); } my($mmbx) = ''; while(defined($mmbx = <$mma>)) { if($mmbx =~ /^\.\r$/){ last; } print {$mmel} $mmbx; } close $mmel; if(defined($mailman::iLocalFilePermissions)) { mmtt($mmek,$mailman::iLocalFilePermissions); } } sub mmre { if($mailman::mmm ne '') { mmro(); if($mailman::mmat) { my($mmav) = $mailman::mmt . '/TRASH'; opendir(DELETEDIR, $mmav); my(@mmaw) = readdir(DELETEDIR); closedir(DELETEDIR); my($mmax); foreach $mmax (@mmaw) { unlink("${mmav}/${mmax}"); } } } } sub mmrf { my($mmcg) = @_; $mailman::mmbq = "The server timed out fetching a header."; if($mailman::bUseAlarm){ alarm($mailman::iTimeoutDurationInSeconds); } mmqu($mma,"TOP $mmcg 0"); my($mmcd) = ''; $mmcd = <$mma>; unless($mmcd =~ /^\+OK/) { mmqu($mma,"RETR $mmcg"); my($mmcd) = ''; $mmcd = <$mma>; unless($mmcd =~ /^\+OK/) { mmqr($mmcd); } } mmrg($mma); $mailman::mmen = $mmcg . 'H' . $mailman::mmeo; $mailman::mmep = $mmcg; } sub mmrg { my($mmbw) = shift; $mailman::mmay = ''; $mailman::mmcl = ''; $mailman::mmcm = ''; $mailman::mmcn = ''; $mailman::mmco = '0'; $mailman::mmcp = ''; $mailman::mmcq = ''; $mailman::mmeo = ''; $mailman::mmcr = 0; $mailman::mmcs = 0; my($mmeq) = 0; my($mmer) = 0; my($mmes) = 0; my($mmet) = 1; my($mmeu) = ''; my($mmev) = -1; while(defined($_ = <$mmbw>)) { if(/^[\r\n]+$/){ $mmeq = 1; } if(/^\.[\r\n]*$/){ last; } if(/^Content-type\:\s+([^\;\s]+)[\;\s]/i) { my($mmew) = $1; if( ($mmew !~ /multipart\/alternative/i) && ($mmew !~ /text\//i)) { $mailman::mmcs = 1; } } if(/^begin \d\d\d (\S+)\s*$/i) { $mailman::mmcs = 1; } if(/^X\-Mailer\: Crescent Internet ToolPak ActiveX Mail Control/i) { $mailman::mmcs = 1; } unless($mmeq) { $mmev = mmtu($_); if($mmev != -1) { $mailman::mmco = $mmev; } $mmet = 1; if(/^To\:\s*(.+)$/i || ((/^\s(.+)$/) && $mmer)) { $mailman::mmay .= $1; $mailman::mmay =~ s/^(.*)[\r\n]+$/$1/; $mailman::mmay = mmrh($mailman::mmay); $mmeu .= $_; $mmer = 1; $mmes = 0; $mmet = 0; } if(/^CC\:\s*(.+)$/i || ((/^\s(.+)$/) && $mmes)) { $mailman::mmcl .= $1; $mailman::mmcl =~ s/^(.*)[\r\n]+$/$1/; $mailman::mmcl = mmrh($mailman::mmcl); $mmeu .= $_; $mmer = 0; $mmes = 1; $mmet = 0; } if(/^From\:\s*(.+)$/i) { $mailman::mmcm = $1; $mailman::mmcm =~ s/^(.*)[\r\n]+$/$1/; $mailman::mmcm = mmrh($mailman::mmcm); $mmeu .= $_; } if(/^Date\:\s*(.+)$/i) { $mailman::mmcn = $1; $mailman::mmcn =~ s/^(.*)[\r\n]+$/$1/; $mmeu .= $_; } if(/^Subject\:\s*(.+)$/i) { $mailman::mmcp = $1; $mailman::mmcp =~ s/^(.*)[\r\n]+$/$1/; $mailman::mmcp = mmrh($mailman::mmcp); $mmeu .= $_; } if(/^Reply-To\:\s*(.+)$/i) { $mailman::mmcq = $1; $mailman::mmcq =~ s/^(.*)[\r\n]+$/$1/; $mmeu .= $_; } if(/^Message-ID\:\s*(.+)$/i) { $mailman::mmeo = $1; $mailman::mmeo =~ s/^(.*)[\r\n]+$/$1/; } if($mmet) { $mmer = 0; $mmes = 0; } } if(/^MIME-Version\:\s*1\.0/i) { if(!$mmeq) { $mailman::mmcr = 1; } } } if($mailman::mmeo eq "") { $mailman::mmeo = $mmeu; while(length($mailman::mmeo)>20) { $mailman::mmeo = (substr($mailman::mmeo,0,20) ^ substr($mailman::mmeo,20)); } $mailman::mmeo = pack("u*",$mailman::mmeo); } $mailman::mmeo =~ s/(\W)/sprintf("%%%x", ord($1))/eg; unless($mailman::mmay){ $mailman::mmay = "Unknown";} unless($mailman::mmcm){ $mailman::mmcm = "Unknown";} unless($mailman::mmcn){ $mailman::mmcn = "Unknown";} unless($mailman::mmcp){ $mailman::mmcp = "Unspecified";} unless($mailman::mmen){ $mailman::mmen = "0";} $mailman::mmcy = mmrj($mailman::mmay); $mailman::mmcz = mmrj($mailman::mmcm); $mailman::mmex = mmrj($mailman::mmcl); $mailman::mmda = mmrj($mailman::mmcp); $mailman::mmdb = mmrj($mailman::mmcn); } sub mmrh { my $mmey = shift; $mmey =~ s/\=\?(iso-8859-\d|us-ascii)\?q\?([^\?]+)\?\=/ mmso(mmsn($2))/xeig; $mmey =~ s/\=\?(iso-8859-\d|us-ascii)\?b\?([^\?]+)\?\=/ mmsp(mmsn($2))/xeig; return $mmey; } sub mmri { my($mmbi) = @_; $mmbi =~ /^(\d+)H(.+)$/; my($mmez) = $1; my($mmfa) = $2; if($1 eq '' || $2 eq '') { mmqr('The message ID string "' . $mmbi . '" is poorly formed.'); } $mmfa =~ s/%(..)/pack("c",hex($1))/ge; $mailman::mmbq = "The server timed out during message listing."; if($mailman::bUseAlarm){ alarm($mailman::iTimeoutDurationInSeconds); } mmqu($mma,"LIST"); my($mmcd) = ''; $mmcd = <$mma>; unless($mmcd =~ /^\+OK/) { mmqr($mmcd); } $mailman::mmfb = 0; while(<$mma> =~ /(\d+) (\d+)/) { $mailman::mmcf[$1] = $2; $mailman::mmfb++; } my($mmb) = $mmez; my($mmfc) = 0; while($mmb>0) { mmrf($mmb); $mailman::mmeo =~ s/%(..)/pack("c",hex($1))/ge; if($mailman::mmeo eq $mmfa) { $mmfc = 1; last; } $mmb--; } if(!$mmfc) { $mailman::mmay = ''; $mmb = $mmez; mmrf($mmb); } if($mailman::mmay eq '') { mmqr('Could not find the specified message.'); } return ($mmb); } sub mmrj { my($mmfd) = @_; $mmfd =~ s/\&/\&\;/g; $mmfd =~ s/\/\>\;/g; $mmfd =~ s/\%mmfe/\/g; my($mmfg) = '(http://|https://|ftp://)' . q%(?:&(?![gl]t;)|[^\s\(\)\|<>,"'\&])+% . q%[^\.?!;,"'\|\[\]\(\)\s<>\&]%; my($mmfh) = "\$1\<\/a\>"/eig; if($mailman::mmac) { $mmfd =~ s/(href\=\"[^\"]*)(BACKGROUND\=)/${1}NOFRAMES\=TRUE&$2/g; } return $mmfd; } sub mmrk { my($mmck) = shift; $mmck =~ s/([\w\W])/sprintf("%02x",ord($1))/eg; return $mmck; } sub mmrl { my($mmck) = shift; $mmck =~ s/([a-fA-F0-9]{2})/pack("C",hex($1))/eg; return $mmck; } sub mmrm { my($mmbf) = mmqv(); if($mmbf) { mmqr($mmbf); } $mailman::mmbg{'USERNAME'} = $mailman::mmm; $mailman::mmbg{'USERNAMEHIDDEN'} = $mailman::mmn; $mailman::mmbg{'SERVERHIDDEN'} = $mailman::mmq; $mailman::mmbg{'PASSWORDHIDDEN'} = $mailman::mmp; $mailman::mmbg{'CHECKSUM'} = $mailman::mmy; if(defined($mailman::strFromDomainName)) { $mailman::mmbg{'SERVER'} = mmul($mailman::strFromDomainName); } else { $mailman::mmbg{'SERVER'} = mmul($mailman::strIncomingServer); } my($mmfi, $mmfj, $mmfk) = mmtj('t_folders.htm', ('FOLDER_EVEN','FOLDER_ODD','DELETEFOLDERIMAGE')); $mailman::mmbg{'AUTHENTICATION'} = 'MailManEscape(AUTHENTICATION)'; $mailman::mmbg{'SETTINGS'} = 'MailManEscape(SETTINGS)'; my(@mmfl) = mmty(); my($mmfm) = 0; my($mmfn); foreach $mmfn (@mmfl) { my($mmfo,$mmfp) = mmtz($mmfn); $mailman::mmbg{'FOLDERNAME'} = mmrj($mmfn); $mailman::mmbg{'FOLDERNAMESAFE'} = mmtn($mmfn); $mailman::mmbg{'FOLDERNAMESAFESAFE'} = mmtn($mailman::mmbg{'FOLDERNAMESAFE'}); $mailman::mmbg{'NUMMESSAGES'} = $mmfo; $mailman::mmbg{'NUMUNREADMESSAGES'} = $mmfp; if($mmfo == 0 && $mmfn !~ /^INBOX$/i && $mmfn !~ /^SENT$/i && $mmfn !~ /^TRASH$/i) { $mailman::mmbg{'DELETEFOLDERIMAGE'} = mmtg($mmfk, \%mailman::mmbg); } else { $mailman::mmbg{'DELETEFOLDERIMAGE'} = ''; } my($mmfq) = ''; if(($mmfm+1)%2==0) { $mmfq = mmtg($mmfi, \%mailman::mmbg); } else { $mmfq = mmtg($mmfj, \%mailman::mmbg); } $mmfm++; $mailman::mmbg{'FOLDERS'} .= $mmfq; } $mailman::mmbg{'FOLDERS'} =~ s/MailManEscape\(/MailMan\(/gi; mmtk('t_folders.htm',\%mailman::mmbg); } sub mmrn { my($mmbf) = mmqv(); if($mmbf) { mmqr($mmbf); } $mailman::mmbg{'USERNAME'} = $mailman::mmm; $mailman::mmbg{'USERNAMEHIDDEN'} = $mailman::mmn; $mailman::mmbg{'SERVERHIDDEN'} = $mailman::mmq; $mailman::mmbg{'PASSWORDHIDDEN'} = $mailman::mmp; $mailman::mmbg{'CHECKSUM'} = $mailman::mmy; mmro(); $mailman::mmbg{'PREF_REALNAME'} = $mailman::mmak; $mailman::mmbg{'PREF_EMAIL'} = $mailman::mmal; $mailman::mmbg{'PREF_OUTGOING'} = $mailman::mman; $mailman::mmbg{'PREF_SIGNATURE'} = $mailman::mmam; $mailman::mmbg{'PREF_NUMPERPAGE'} = $mailman::mmao; if($mailman::mmap) { $mailman::mmbg{'PREF_DELETEDOWNLOAD'} = 'checked'; } else { $mailman::mmbg{'PREF_DELETEDOWNLOAD'} = ''; } if($mailman::mmaq) { $mailman::mmbg{'PREF_DELETEPROXY'} = 'checked'; } else { $mailman::mmbg{'PREF_DELETEPROXY'} = ''; } if($mailman::mmar) { $mailman::mmbg{'PREF_DELETESAVE'} = 'checked'; } else { $mailman::mmbg{'PREF_DELETESAVE'} = ''; } if($mailman::mmas) { $mailman::mmbg{'PREF_SENDSAVE'} = 'checked'; } else { $mailman::mmbg{'PREF_SENDSAVE'} = ''; } if($mailman::mmat) { $mailman::mmbg{'PREF_PURGETRASH'} = 'checked'; } else { $mailman::mmbg{'PREF_PURGETRASH'} = ''; } $mailman::mmbg{'PREF_STARTUP_'.$mailman::mmau} = 'checked'; if(defined($mailman::strFromDomainName)) { $mailman::mmbg{'SERVER'} = mmul($mailman::strFromDomainName); } else { $mailman::mmbg{'SERVER'} = mmul($mailman::strIncomingServer); } mmtk('t_preferences.htm',\%mailman::mmbg); } sub mmro { my($mmfr) = new FileHandle(); $mailman::mmfs = "${mailman::mmt}/preferences"; if(!open($mmfr,"<$mailman::mmfs")) { $mailman::mmak = ''; $mailman::mmam = ''; $mailman::mmap = 1; $mailman::mmaq = 0; $mailman::mmar = 1; $mailman::mmas = 1; $mailman::mmat = 1; $mailman::mmao = $mailman::iMessagesPerPage; $mailman::mman = ''; $mailman::mmau = 'INBOX'; $mailman::mmal = mmuh(); return; } flock($mmfr,2); my($mmbx) = ''; while(defined($mmbx = <$mmfr>)) { if($mmbx =~ /REALNAME\:\s+\"([^\"]*)\"/) { $mailman::mmak = mmto($1); } elsif($mmbx =~ /EMAIL\:\s+\"([^\"]*)\"/) { $mailman::mmal = mmto($1); } elsif($mmbx =~ /OUTGOING\:\s+\"([^\"]*)\"/) { $mailman::mman = mmto($1); } elsif($mmbx =~ /SIGNATURE\:\s+\"([^\"]*)\"/) { $mailman::mmam = mmto($1); } elsif($mmbx =~ /STARTUP\:\s+\"([^\"]*)\"/) { $mailman::mmau = mmto($1); } elsif($mmbx =~ /DELETEDOWNLOAD\:\s+\"([^\"]*)\"/) { if($1 eq '1') { $mailman::mmap = 1; } else { $mailman::mmap = 1; } } elsif($mmbx =~ /DELETEPROXY\:\s+\"([^\"]*)\"/) { if($1 eq '1') { $mailman::mmaq = 1; } else { $mailman::mmaq = 0; } } elsif($mmbx =~ /DELETESAVE\:\s+\"([^\"]*)\"/) { if($1 eq '1') { $mailman::mmar = 1; } else { $mailman::mmar = 0; } } elsif($mmbx =~ /SAVESAVE\:\s+\"([^\"]*)\"/) { if($1 eq '1') { $mailman::mmas = 1; } else { $mailman::mmas = 0; } } elsif($mmbx =~ /PURGETRASH\:\s+\"([^\"]*)\"/) { if($1 eq '1') { $mailman::mmat = 1; } else { $mailman::mmat = 0; } } elsif($mmbx =~ /NUMPERPAGE\:\s+\"([^\"]*)\"/) { $mailman::mmao = $1; } } close($mmfr); } sub mmrp { my($mmfr) = new FileHandle(); my($mmft) = $mailman::mmac; $mailman::mmac = 1; mmqy(); $mailman::mmfs = "${mailman::mmt}/preferences"; if(!open($mmfr,">$mailman::mmfs")) { mmqr("Could not open the preferences file \"" . $mailman::mmfs . "\" for storing this user's preferences. "); } flock($mmfr,2); print {$mmfr} "REALNAME: \"" . mmtn($mailman::mmak) . "\"\n"; print {$mmfr} "EMAIL: \"" . mmtn($mailman::mmal) . "\"\n"; print {$mmfr} "OUTGOING: \"" . mmtn($mailman::mman) . "\"\n"; print {$mmfr} "STARTUP: \"" . mmtn($mailman::mmau) . "\"\n"; print {$mmfr} "DELETEDOWNLOAD: \"" . $mailman::mmap . "\"\n"; print {$mmfr} "DELETEPROXY: \"" . $mailman::mmaq . "\"\n"; print {$mmfr} "DELETESAVE: \"" . $mailman::mmar . "\"\n"; print {$mmfr} "SAVESAVE: \"" . $mailman::mmas . "\"\n"; print {$mmfr} "PURGETRASH: \"" . $mailman::mmat . "\"\n"; print {$mmfr} "NUMPERPAGE: \"" . $mailman::mmao . "\"\n"; print {$mmfr} "SIGNATURE: \"" . mmtn($mailman::mmam) . "\"\n"; close($mmfr); if(defined($mailman::iLocalFilePermissions)) { mmtt($mailman::mmfs, $mailman::iLocalFilePermissions); } $mailman::mmac = $mmft; } sub mmrq { my($mmbp) = 't_addresses.htm'; $mailman::mmbg{'USERNAME'} = $mailman::mmm; $mailman::mmbg{'USERNAMEHIDDEN'} = $mailman::mmn; $mailman::mmbg{'SERVERHIDDEN'} = $mailman::mmq; $mailman::mmbg{'PASSWORDHIDDEN'} = $mailman::mmp; $mailman::mmbg{'CHECKSUM'} = $mailman::mmy; if(defined($mailman::strFromDomainName)) { $mailman::mmbg{'SERVER'} = mmul($mailman::strFromDomainName); } else { $mailman::mmbg{'SERVER'} = mmul($mailman::strIncomingServer); } mmrr(); if($mailman::mmfu) { my($mmfv, $mmfw) = mmtj($mmbp, ('INDIVIDUAL_EVEN','INDIVIDUAL_ODD')); my($mmfx) = 0; my($mmaz) = ''; foreach $mmaz (keys %mailman::mmba) { $mailman::mmbg{'NICKNAME'} = $mmaz; $mailman::mmbg{'NICKNAMESAFE'} = mmtn($mmaz); my($mmbb) = $mailman::mmba{$mmaz}->{'FIRSTNAME'}; my($mmbc) = $mailman::mmba{$mmaz}->{'LASTNAME'}; my($mmbd) = $mailman::mmba{$mmaz}->{'ADDRESS'}; if(($mmbb ne '') || ($mmbc ne '')) { $mailman::mmbg{'ADDRESS'} = "$mmbb $mmbc " . "<$mmbd>"; } else { $mailman::mmbg{'ADDRESS'} = "$mmbd"; } if($mmfx%2==0) { $mailman::mmbg{INDIVIDUALS} .= mmtg($mmfv,\%mailman::mmbg); } else { $mailman::mmbg{INDIVIDUALS} .= mmtg($mmfw,\%mailman::mmbg); } $mmfx++; } } else { $mailman::mmbg{'INDIVIDUALS'} = mmti($mmbp, 'NOBODY_INDIVIDUAL'); } mmrs(); if($mailman::mmfy) { my($mmfz, $mmga) = mmtj($mmbp, ('GROUP_EVEN','GROUP_ODD')); my($mmfx) = 0; my($mmaz) = ''; foreach $mmaz (keys %mailman::mmbe) { $mailman::mmbg{'NICKNAME'} = $mmaz; $mailman::mmbg{'NICKNAMESAFE'} = mmtn($mmaz); $mailman::mmbg{'ADDRESSES'} = $mailman::mmbe{$mmaz}; $mailman::mmbg{'ADDRESSES'} =~ s/(\r\n)|(\r\n)/,\ /g; $mailman::mmbg{'ADDRESSES'} =~ s/[\r\n]/,\ /g; $mailman::mmbg{'ADDRESSES'} =~ s/\,\ $//g; if($mmfx%2==0) { $mailman::mmbg{GROUPS} .= mmtg($mmfz,\%mailman::mmbg); } else { $mailman::mmbg{GROUPS} .= mmtg($mmga,\%mailman::mmbg); } $mmfx++; } } else { $mailman::mmbg{'GROUPS'} = mmti($mmbp, 'NOBODY_GROUP'); } mmtk($mmbp,\%mailman::mmbg); } sub mmrr { my($mmgb) = new FileHandle(); mmqy(); my($mmgc) = "${mailman::mmt}/individuals"; if(!open($mmgb,"<$mmgc")) { return; } flock($mmgb,2); my($mmaz) = ''; my($mmgd) = ''; $mailman::mmfu = 0; while(defined($_ = <$mmgb>)) { if(/^BEGIN\s+(\S+)\s*$/) { $mmaz = mmto($1); $mmgd = $mmaz; $mmgd =~ tr/[A-Z]/[a-z]/; $mailman::mmfu++; $mailman::mmba{$mmgd}->{NICKNAME} = $mmaz; } elsif(/^(\S+)\s+(\S+)\s*$/) { $mailman::mmba{$mmgd}->{$1} = mmto($2); } } close($mmgb); } sub mmrs { my($mmgb) = new FileHandle(); mmqy(); my($mmge) = "${mailman::mmt}/groups"; if(!open($mmgb,"<$mmge")) { return; } flock($mmgb,2); my($mmaz) = ''; my($mmgd) = ''; $mailman::mmfy = 0; while(defined($_ = <$mmgb>)) { if(/^(\S+)\s+\"(\S+)\"\s*/) { $mmaz = mmto($1); $mmgd = $mmaz; $mmgd =~ tr/[A-Z]/[a-z]/; $mailman::mmbe{$mmgd} .= mmto($2); $mailman::mmfy++; } } close($mmgb); } sub mmrt { my($mmbf) = shift; my($mmgb) = new FileHandle(); my($mmbp) = 't_addressesindividual.htm'; $mailman::mmbg{'USERNAME'} = $mailman::mmm; $mailman::mmbg{'USERNAMEHIDDEN'} = $mailman::mmn; $mailman::mmbg{'SERVERHIDDEN'} = $mailman::mmq; $mailman::mmbg{'PASSWORDHIDDEN'} = $mailman::mmp; $mailman::mmbg{'CHECKSUM'} = $mailman::mmy; if(defined($mailman::strFromDomainName)) { $mailman::mmbg{'SERVER'} = mmul($mailman::strFromDomainName); } else { $mailman::mmbg{'SERVER'} = mmul($mailman::strIncomingServer); } my($mmaz) = ''; if($mailman::in{'ADDRESSINDIVIDUAL'}) { $mmaz = $mailman::in{'ADDRESSINDIVIDUAL'}; $mailman::mmbg{'NICKNAME'} = $mmaz; $mailman::mmbg{'NICKNAME'} = mmtg( mmti($mmbp, 'NICKNAME_FIXED'),\%mailman::mmbg); mmqy(); my($mmgc) = "${mailman::mmt}/individuals"; if(!open($mmgb,"<$mmgc")) { mmqr("Could not open the address file \"" . $mmgc . "\" for storing this user's addresses. "); } flock($mmgb,2); my($mmgf) = 0; my($mmgg) = 0; my($mmgh) = ''; individualsline: while(defined($_ = <$mmgb>)) { if(/^BEGIN\s+(\S+)\s*$/) { $mmgh = mmto($1); if($mmgh =~ /$mmaz/i) { $mmgf = 1; $mmgg = 1; } } elsif(/^END/) { if($mmgg) { close($mmgb); last individualsline; } } elsif($mmgg && /^(\S+)\s+(\S+)\s*$/) { $mailman::mmbg{"ADDRESSITEM_$1"} = mmto($2); } } close($mmgb); } else { $mailman::mmbg{'NICKNAME'} = mmti($mmbp, 'NICKNAME_NEW'); } if($mmbf ne '') { $mailman::mmbg{'ERROR'} = $mmbf; } my($mmb) = 0; my($mmc); foreach $mmc (keys(%mailman::in)) { if($mmc =~ /^ADDRESSITEM_(.*)$/) { $mailman::mmbg{$mmc} = $mailman::in{$mmc}; } } mmtk($mmbp,\%mailman::mmbg); } sub mmru { my($mmbf) = shift; my($mmgb) = new FileHandle(); my($mmbp) = 't_addressesgroup.htm'; $mailman::mmbg{'USERNAME'} = $mailman::mmm; $mailman::mmbg{'USERNAMEHIDDEN'} = $mailman::mmn; $mailman::mmbg{'SERVERHIDDEN'} = $mailman::mmq; $mailman::mmbg{'PASSWORDHIDDEN'} = $mailman::mmp; $mailman::mmbg{'CHECKSUM'} = $mailman::mmy; if(defined($mailman::strFromDomainName)) { $mailman::mmbg{'SERVER'} = mmul($mailman::strFromDomainName); } else { $mailman::mmbg{'SERVER'} = mmul($mailman::strIncomingServer); } my($mmaz) = ''; if($mailman::in{'ADDRESSGROUP'}) { $mmaz = $mailman::in{'ADDRESSGROUP'}; $mailman::mmbg{'NICKNAME'} = $mmaz; $mailman::mmbg{'NICKNAME'} = mmtg( mmti($mmbp, 'NICKNAME_FIXED'),\%mailman::mmbg); mmqy(); my($mmge) = "${mailman::mmt}/groups"; if(!open($mmgb,"<$mmge")) { mmqr("Could not open the address file \"" . $mmge . "\" for storing this user's addresses. "); } flock($mmgb,2); my($mmgi) = ''; groupsline: while(defined($_ = <$mmgb>)) { if(/^(\S+)\s+\"(\S+)\"\s*/) { $mmgi = mmto($1); my $mmgj = $2; if($mmgi =~ /$mmaz/i) { $mailman::mmbg{'ADDRESSITEM_ADDRESSES'} = mmto($mmgj); } } } close($mmgb); } else { $mailman::mmbg{'NICKNAME'} = mmti($mmbp, 'NICKNAME_NEW'); } if($mmbf ne '') { $mailman::mmbg{'ERROR'} = $mmbf; } my($mmb) = 0; my($mmc); foreach $mmc (keys(%mailman::in)) { if($mmc =~ /^ADDRESSITEM_(.*)$/) { $mailman::mmbg{$mmc} = $mailman::in{$mmc}; } } mmtk($mmbp,\%mailman::mmbg); } sub mmrv { my($mmaz) = shift; my($mmgb) = new FileHandle(); my($mmgk) = new FileHandle(); my($mmft) = $mailman::mmac; $mailman::mmac = 1; mmqy(); my($mmgc) = "${mailman::mmt}/individuals"; if((!open($mmgb,"<$mmgc")) || (!open($mmgk,">$mmgc.tmp"))) { return; } flock($mmgb,2); my($mmgf) = 0; my($mmgg) = 0; my($mmgh) = ''; while(defined($_ = <$mmgb>)) { if(/^BEGIN\s+(\S+)\s*$/) { $mmgh = mmto($1); if($mmgh =~ /$mmaz/i) { $mmgf = 1; $mmgg = 1; } else { print {$mmgk} $_; } } elsif(/^END/) { unless($mmgg) { print {$mmgk} $_; } $mmgg = 0; } elsif(!$mmgg) { print {$mmgk} $_; } } close($mmgb); close($mmgk); use File::Copy; copy("$mmgc.tmp", $mmgc); $mailman::mmac = $mmft; } sub mmrw { my($mmaz) = shift; my($mmgb) = new FileHandle(); my($mmgk) = new FileHandle(); my($mmft) = $mailman::mmac; $mailman::mmac = 1; mmqy(); my($mmge) = "${mailman::mmt}/groups"; if((!open($mmgb,"<$mmge")) || (!open($mmgk,">$mmge.tmp"))) { return; } flock($mmgb,2); my($mmgi) = ''; while(defined($_ = <$mmgb>)) { if(/^(\S+)\s+\"(\S+)\"\s*/) { $mmgi = mmto($1); unless($mmgi =~ /$mmaz/i) { print {$mmgk} $_; } } else { print {$mmgk} $_; } } close($mmgb); close($mmgk); use File::Copy; copy("$mmge.tmp", $mmge); $mailman::mmac = $mmft; } sub mmrx { my($mmft) = $mailman::mmac; $mailman::mmac = 1; my($mmgb) = new FileHandle(); my($mmgk) = new FileHandle(); mmqy(); my($mmgl) = ''; my($mmgm) = ''; my($mmb) = 0; my($mmc); foreach $mmc (keys(%mailman::in)) { if($mmc =~ /^ADDRESSITEM_(.*)$/) { my($mmgn) = $1; if($mmgn eq 'NICKNAME') { $mmgl = $mailman::in{$mmc}; } else { $mmgm .= "$mmgn " . mmtn($mailman::in{$mmc}) . "\n"; } } } if($mmgl eq '') { mmrt("Error: The nickname field is " . "required."); } if($mailman::in{'ADDRESSITEM_ADDRESS'} eq '') { mmrt("Error: The address field is " . "required."); } my($mmgc) = "${mailman::mmt}/individuals"; if((!open($mmgb,"<$mmgc")) || (!open($mmgk,">$mmgc.tmp"))) { if(!open($mmgb,">$mmgc")) { mmqr("Could not open the address file \"" . $mmgc . "\" for storing this user's addresses. "); } print {$mmgb} "BEGIN " . mmtn($mmgl) . "\n"; print {$mmgb} $mmgm; print {$mmgb} "END\n"; close($mmgb); $mailman::mmac = $mmft; return; } flock($mmgb,2); my($mmgf) = 0; my($mmgg) = 0; my($mmgh) = ''; while(defined($_ = <$mmgb>)) { if(/^BEGIN\s+(\S+)\s*$/) { $mmgh = mmto($1); print {$mmgk} $_; if($mmgh eq $mmgl) { $mmgf = 1; $mmgg = 1; print {$mmgk} $mmgm; } } elsif(/^END/) { $mmgg = 0; print {$mmgk} $_; } elsif(!$mmgg) { print {$mmgk} $_; } } unless($mmgf) { print {$mmgk} "BEGIN " . mmtn($mmgl) . "\n"; print {$mmgk} $mmgm; print {$mmgk} "END\n"; } close($mmgb); close($mmgk); use File::Copy; copy("$mmgc.tmp", $mmgc); if(defined($mailman::iLocalFilePermissions)) { mmtt($mmgc, $mailman::iLocalFilePermissions); mmtt("$mmgc.tmp", $mailman::iLocalFilePermissions); } $mailman::mmac = $mmft; } sub mmry { my($mmft) = $mailman::mmac; $mailman::mmac = 1; my($mmgb) = new FileHandle(); my($mmgk) = new FileHandle(); mmqy(); my($mmgl) = $mailman::in{'ADDRESSITEM_NICKNAME'}; my($mmgo) = mmtn($mailman::in{'ADDRESSITEM_NICKNAME'}); my($mmgp) = mmtn($mailman::in{'ADDRESSITEM_ADDRESSES'}); if($mmgl eq '') { mmru("Error: The nickname field is " . "required."); } if($mailman::in{'ADDRESSITEM_ADDRESSES'} eq '') { mmru("Error: The address field is " . "required."); } my($mmge) = "${mailman::mmt}/groups"; if((!open($mmgb,"<$mmge")) || (!open($mmgk,">$mmge.tmp"))) { if(!open($mmgb,">$mmge")) { mmqr("Could not open the address file \"" . $mmge . "\" for storing this user's addresses. "); } print {$mmgb} "$mmgo \"$mmgp\"\n"; close($mmgb); $mailman::mmac = $mmft; return; } flock($mmgb,2); my($mmgq) = 0; my($mmgi) = ''; while(defined($_ = <$mmgb>)) { if(/^(\S+)\s+\"(\S+)\"\s*/) { $mmgi = mmto($1); if($mmgi eq $mmgl) { $mmgq = 1; print {$mmgk} "$mmgo \"$mmgp\"\n"; } else { print {$mmgk} $_; } } } unless($mmgq) { print {$mmgk} "$mmgo \"$mmgp\"\n"; } close($mmgb); close($mmgk); use File::Copy; copy("$mmge.tmp", $mmge); if(defined($mailman::iLocalFilePermissions)) { mmtt($mmge, $mailman::iLocalFilePermissions); mmtt("$mmge.tmp", $mailman::iLocalFilePermissions); } $mailman::mmac = $mmft; } sub mmrz { my($mmbp) = 't_accounts.htm'; $mailman::mmbg{'USERNAME'} = $mailman::mmm; $mailman::mmbg{'USERNAMEHIDDEN'} = $mailman::mmn; $mailman::mmbg{'SERVERHIDDEN'} = $mailman::mmq; $mailman::mmbg{'PASSWORDHIDDEN'} = $mailman::mmp; $mailman::mmbg{'CHECKSUM'} = $mailman::mmy; if(defined($mailman::strFromDomainName)) { $mailman::mmbg{'SERVER'} = mmul($mailman::strFromDomainName); } else { $mailman::mmbg{'SERVER'} = mmul($mailman::strIncomingServer); } mmsd(); if($mailman::mmdg) { my($mmgr, $mmgs) = mmtj($mmbp, ('ACCOUNT_EVEN','ACCOUNT_ODD')); my($mmfx) = 0; my($mmdh) = ''; foreach $mmdh (sort keys %mailman::mmdi) { my($mmcw) = $mailman::mmdi{$mmdh}->{'ACCOUNTITEM_USERNAME'}; my($mmcx) = $mailman::mmdi{$mmdh}->{'ACCOUNTITEM_SERVER'}; $mailman::mmbg{'ACCOUNTITEM_ID'} = mmtn($mmdh); $mailman::mmbg{'ACCOUNTITEM_USERNAME'} = $mmcw; $mailman::mmbg{'ACCOUNTITEM_SERVER'} = $mmcx; if($mmfx%2==0) { $mailman::mmbg{ACCOUNTS} .= mmtg($mmgr,\%mailman::mmbg); } else { $mailman::mmbg{ACCOUNTS} .= mmtg($mmgs,\%mailman::mmbg); } $mmfx++; } } else { $mailman::mmbg{'ACCOUNTS'} = mmti($mmbp, 'NO_ACCOUNTS'); } mmtk($mmbp,\%mailman::mmbg); } sub mmsa { my($mmbf) = shift; my($mmgt) = new FileHandle(); my($mmbp) = 't_account.htm'; $mailman::mmbg{'USERNAME'} = $mailman::mmm; $mailman::mmbg{'USERNAMEHIDDEN'} = $mailman::mmn; $mailman::mmbg{'SERVERHIDDEN'} = $mailman::mmq; $mailman::mmbg{'PASSWORDHIDDEN'} = $mailman::mmp; $mailman::mmbg{'CHECKSUM'} = $mailman::mmy; if(defined($mailman::strFromDomainName)) { $mailman::mmbg{'SERVER'} = mmul($mailman::strFromDomainName); } else { $mailman::mmbg{'SERVER'} = mmul($mailman::strIncomingServer); } my($mmdh) = ''; if($mailman::in{'ACCOUNT'}) { $mmdh = $mailman::in{'ACCOUNT'}; mmqy(); my($mmgu) = "${mailman::mmt}/accounts"; if(!open($mmgt,"<$mmgu")) { mmqr("Could not open the accounts file \"" . $mmgu . "\" for storing this user's accounts."); } flock($mmgt,2); my($mmgv) = 0; my($mmgw) = 0; my($mmgx) = ''; accountline: while(defined($_ = <$mmgt>)) { if(/^BEGIN\s+(\S+)\s*$/) { $mmgx = $1; if($mmgx eq $mmdh) { $mmgv = 1; $mmgw = 1; } } elsif(/^END/) { if($mmgw) { close($mmgt); last accountline; } } elsif($mmgw && /^(\S+)\s+(\S+)\s*$/) { $mailman::mmbg{$1} = mmto($2); } } close($mmgt); } if($mmbf ne '') { $mailman::mmbg{'ERROR'} = $mmbf; } if($mailman::mmbg{'ACCOUNTITEM_FOLDER'}) { $mailman::mmbg{'FOLDERDEPOSITLIST'} = mmua($mailman::mmbg{'ACCOUNTITEM_FOLDER'}); } else { $mailman::mmbg{'FOLDERDEPOSITLIST'} = mmua('INBOX'); } my($mmb) = 0; my($mmc); foreach $mmc (keys(%mailman::in)) { if($mmc =~ /^ACCOUNTITEM_(.*)$/) { $mailman::mmbg{$mmc} = $mailman::in{$mmc}; } } mmtk($mmbp,\%mailman::mmbg); } sub mmsb { my($mmm) = $mailman::mmm; my($mmo) = $mailman::mmo; my($strIncomingServer) = $mailman::strIncomingServer; $mailman::mmbg{'ACCOUNTITEM_FOLDER'} = $mailman::in{'ACCOUNTITEM_FOLDER'}; if($mailman::in{'ACCOUNTITEM_USERNAME'} eq '') { mmsa("Error: The username field is " . "required."); } if($mailman::in{'ACCOUNTITEM_PASSWORD'} eq '') { mmsa("Error: The password field is " . "required."); } if($mailman::in{'ACCOUNTITEM_SERVER'} eq '') { mmsa("Error: The server field is " . "required."); } $mailman::mmm = $mailman::in{'ACCOUNTITEM_USERNAME'}; $mailman::mmo = $mailman::in{'ACCOUNTITEM_PASSWORD'}; $mailman::strIncomingServer = $mailman::in{'ACCOUNTITEM_SERVER'}; my($mmbf) = ''; if($mmbf = mmqv()) { $mailman::mmm = $mmm; $mailman::mmo = $mmo; $mailman::strIncomingServer = $strIncomingServer; $mmbf =~ s/^\-ERR//i; mmsa('ERROR: ' . $mmbf); } else { mmqu($mma,"QUIT"); close $mma; $mailman::mmbl = 0; $mailman::mmm = $mmm; $mailman::mmo = $mmo; $mailman::strIncomingServer = $strIncomingServer; } my($mmft) = $mailman::mmac; $mailman::mmac = 1; my($mmgt) = new FileHandle(); my($mmgy) = new FileHandle(); mmqy(); my($mmdh) = ''; my($mmgz) = ''; my($mmha) = ''; my($mmb) = 0; if($mailman::in{'ACCOUNTITEM_ID'}) { $mmgz = $mmha = $mailman::in{'ACCOUNTITEM_ID'}; } else { $mmgz = mmtn($mailman::in{'ACCOUNTITEM_USERNAME'}.'@'. $mailman::in{'ACCOUNTITEM_SERVER'}); $mmha = $mmgz . "\n"; } my($mmc); foreach $mmc (keys(%mailman::in)) { if($mmc =~ /^ACCOUNTITEM_(.*)$/ && $mmc ne 'ACCOUNTITEM_ID') { my($mmhb) = $1; $mmha .= "$mmc " . mmtn($mailman::in{$mmc}) . "\n"; } } my($mmgu) = "${mailman::mmt}/accounts"; if((!open($mmgt,"<$mmgu")) || (!open($mmgy,">$mmgu.tmp"))) { if(!open($mmgt,">$mmgu")) { mmqr("Could not open the account file \"" . $mmgu . "\" for storing this user's accounts."); } print {$mmgt} "BEGIN "; print {$mmgt} $mmha; print {$mmgt} "END\n"; close($mmgt); $mailman::mmac = $mmft; return; } flock($mmgt,2); my($mmgv) = 0; my($mmgw) = 0; my($mmgx) = ''; while(defined($_ = <$mmgt>)) { if(/^BEGIN\s+(\S+)\s*$/) { $mmgx = $1; if($mmgx eq $mmgz) { $mmgv = 1; $mmgw = 1; print {$mmgy} "BEGIN $mmha"; } else { print {$mmgy} $_; } } elsif(/^END/) { $mmgw = 0; print {$mmgy} $_; } elsif(!$mmgw) { print {$mmgy} $_; } } unless($mmgv) { print {$mmgy} "BEGIN "; print {$mmgy} $mmha; print {$mmgy} "END\n"; } close($mmgt); close($mmgy); use File::Copy; copy("$mmgu.tmp", $mmgu); if(defined($mailman::iLocalFilePermissions)) { mmtt($mmgu, $mailman::iLocalFilePermissions); mmtt("$mmgu.tmp", $mailman::iLocalFilePermissions); } $mailman::mmac = $mmft; } sub mmsc { my($mmdh) = shift; my($mmgt) = new FileHandle(); my($mmgy) = new FileHandle(); my($mmft) = $mailman::mmac; $mailman::mmac = 1; mmqy(); my($mmgu) = "${mailman::mmt}/accounts"; if((!open($mmgt,"<$mmgu")) || (!open($mmgy,">$mmgu.tmp"))) { return; } flock($mmgt,2); my($mmgv) = 0; my($mmgw) = 0; my($mmgx) = ''; while(defined($_ = <$mmgt>)) { if(/^BEGIN\s+(\S+)\s*$/) { $mmgx = $1; if($mmgx eq $mmdh) { $mmgv = 1; $mmgw = 1; } else { print {$mmgy} $_; } } elsif(/^END/) { unless($mmgw) { print {$mmgy} $_; } $mmgw = 0; } elsif(!$mmgw) { print {$mmgy} $_; } } close($mmgt); close($mmgy); use File::Copy; copy("$mmgu.tmp", $mmgu); $mailman::mmac = $mmft; } sub mmsd { my($mmhc) = new FileHandle(); mmqy(); my($mmhd) = "${mailman::mmt}/accounts"; if(!open($mmhc,"<$mmhd")) { return; } flock($mmhc,2); my($mmdh) = ''; $mailman::mmdg = 0; while(defined($_ = <$mmhc>)) { if(/^BEGIN\s+(\S+)\s*$/) { $mmdh = $1; $mailman::mmdg++; } elsif(/^(\S+)\s+(\S+)\s*$/) { $mailman::mmdi{$mmdh}->{$1} = mmto($2); } } close($mmhc); } sub mmse { my($mmhe) = shift; $mailman::mmbg{'URL'} = $mmhe; mmtk('t_backgroundframeset.htm',\%mailman::mmbg); } sub mmsf { my($mmhf) = @_; unless(defined($mmhf)) { $mmhf = 0; } my($mmhg, $mmhh) = (0, 0); my($mmbp) = ''; if($mailman::mmac) { if($mailman::mmaf eq 'SENT') { my($mmhi) = 't_nf_messagelistsent.htm'; if(defined($mailman::mmae)) { $mmhi = $mailman::mmae . $mmhi; } if(-e "${mailman::strLocalTemplateLocation}$mmhi") { $mmbp = 't_nf_messagelistsent.htm'; } else { $mmbp = 't_nf_messagelist.htm'; } } else { $mmbp = 't_nf_messagelist.htm'; } } else { if($mailman::mmaf eq 'SENT') { my($mmhi) = 't_f_messagelistsent.htm'; if(defined($mailman::mmae)) { $mmhi = $mailman::mmae . $mmhi; } if(-e "${mailman::strLocalTemplateLocation}$mmhi") { $mmbp = 't_f_messagelistsent.htm'; } else { $mmbp = 't_f_messagelist.htm'; } } else { $mmbp = 't_f_messagelist.htm'; } } my($mmhj, $mmhk, $mmhl, $mmhm) = ('','','',''); my($mmhn, $mmho, $mmhp) = ('','',''); if($mailman::iUserDiskQuota) { ($mmhj, $mmhk, $mmhm, $mmhn, $mmhl, $mmho, $mmhp) = mmtj($mmbp, ('MESSAGE_EVEN', 'MESSAGE_ODD', 'ATTACHMENT_IMAGE', 'READ_IMAGE', 'UNREAD_IMAGE', 'QUOTA_STATUS', 'QUOTA_ERROR')); } else { ($mmhj, $mmhk, $mmhm, $mmhn, $mmhl) = mmtj($mmbp, ('MESSAGE_EVEN', 'MESSAGE_ODD', 'ATTACHMENT_IMAGE', 'READ_IMAGE', 'UNREAD_IMAGE')); } $mailman::mmbg{'USERNAME'} = $mailman::mmm; $mailman::mmbg{'USERNAMEHIDDEN'} = $mailman::mmn; $mailman::mmbg{'SERVERHIDDEN'} = $mailman::mmq; $mailman::mmbg{'PASSWORDHIDDEN'} = $mailman::mmp; $mailman::mmbg{'CHECKSUM'} = $mailman::mmy; $mailman::mmbg{'NUM'} = $mailman::mmce; if($mailman::iUserDiskQuota) { unless($mailman::mmdk) { mmub(); } $mailman::mmbg{'QUOTA_USAGE_PERCENT'} = sprintf("%2.1f", ($mailman::mmdk/ $mailman::iUserDiskQuota)*100); $mailman::mmbg{'QUOTA_LIMIT_MB'} = sprintf("%2.1f", ($mailman::iUserDiskQuota / (1024*1024))); $mailman::mmbg{'QUOTA_STATUS'} = mmtg($mmho,\%mailman::mmbg); if($mailman::mmdk >= $mailman::iUserDiskQuota) { $mailman::mmbg{'QUOTA_STATUS'} .= $mmhp; } } if(defined($mailman::strFromDomainName)) { $mailman::mmbg{'SERVER'} = mmul($mailman::strFromDomainName); } else { $mailman::mmbg{'SERVER'} = mmul($mailman::strIncomingServer); } if($mailman::mmaf eq '') { $mailman::mmaf = 'INBOX'; } $mailman::mmbg{'FOLDERLIST'} = mmua(); $mailman::mmbg{'CURRENTFOLDER'} = mmrj($mailman::mmaf); use Fcntl; my($mmdc) = $mailman::mmt . '/' . mmtn($mailman::mmaf); my($mmdx) = new FileHandle(); my($mmdy) = "${mmdc}/msglist"; retry: unless(open($mmdx,$mmdy)) { $mailman::mmbg{'NUM'} = 0; $mailman::mmbg{'MESSAGELIST'} = mmti($mmbp,'NOMESSAGES'); mmtk($mmbp,\%mailman::mmbg); } flock($mmdx,2); if(<$mmdx> =~ /^(\d+)\s/) { $mailman::mmce = $1; $mailman::mmbg{'NUM'} = $mailman::mmce; } else { close($mmdx); mmug($mmdc); goto retry; } mmro(); $mailman::iMessagesPerPage = $mailman::mmao; if($mailman::mmce > 0) { if($mmhf == 0) { $mmhf = $mailman::mmce; } my($mmhq); if($mailman::mmce > 1) { my($mmfx) = 0; for($mmfx=$mailman::mmce; $mmfx>0; $mmfx-=$mailman::iMessagesPerPage) { my($mmhr) = $mmfx; my($mmhs) = $mmfx-$mailman::iMessagesPerPage+1; my($mmht) = ''; if($mmhs<1) { $mmhs = 1; } if($mmhf <= $mmhr && $mmhf >= $mmhs) { $mmhq = 1; $mmhg = $mmhr; $mmhh = $mmhs; } else { $mmhq = 0; } if($mmhr == $mmhs) { $mmht = "$mmhr"; } else { $mmht = "$mmhr-$mmhs"; } if($mailman::mmac) { if($mmhq) { $mailman::mmbg{'PAGELINKS'} .= "[$mmht] "; } else { $mailman::mmbg{'PAGELINKS'} .= qq||; } } else { if($mmhq) { $mailman::mmbg{'PAGELINKS'} .= "[$mmht] "; } else { $mailman::mmbg{'PAGELINKS'} .= qq|| . qq|[$mmht] |; } } } } else { $mailman::mmbg{'PAGELINKS'} = ''; $mmhg = 1; $mmhh = 1; } } $mailman::mmbg{'MESSAGELIST'} = ''; my $mmfx = 0; nextmessage: while(defined($_ = <$mmdx>)) { if(($mmfx+1) < $mmhh) { if(mmqx($_)) { $mmfx++; } next nextmessage; } if(($mmfx+1) > $mmhg) { last nextmessage; } unless(mmqx($_)) { next nextmessage; } $mailman::mmbg{'TO'} = $mailman::mmcy; $mailman::mmbg{'MESSAGENUM'} = $mmfx+1; $mailman::mmbg{'DATE'} = $mailman::mmdb; $mailman::mmbg{'SUBJECT'} = $mailman::mmda; if(defined($mailman::iSubjectTruncationLength)) { if(length($mailman::mmcp) > $mailman::iSubjectTruncationLength) { $mailman::mmbg{'SUBJECT'} = mmrj( substr($mailman::mmcp, 0, $mailman::iSubjectTruncationLength - 3) . '...'); } } $mailman::mmbg{'SIZE'} = int($mailman::mmcf[$mmfx] / 1024); $mailman::mmbg{'ID'} = mmtn(mmrk($mailman::mmck)); $mailman::mmbg{'FROM'} = $mailman::mmcz; if($mailman::mmcm =~ /^([^\<]+)\s?\)) { $mailman::mmik[$mmij++] = $mmbx; } } else { mmqr("Could not load the specified message from disk." . ""); } seek($mmel,0,0); mmrg($mmel); close($mmel); return $mmbi; } sub mmsh { my($mmbi,$mmii) = @_; my($mmcg) = 0; my($mmdc) = $mailman::mmt . '/' . mmtn($mailman::mmaf); my($mmdx) = new FileHandle(); my($mmdy) = "${mmdc}/msglist"; retry: if(open($mmdx,"<$mmdy")) { flock($mmdx,2); if(<$mmdx> =~ /^(\d+)\s/) { $mmcg = $1; } else { close($mmdx); mmug($mmdc); goto retry; } my($mmil) = 0; my($mmim, $mmin) = ('', ''); my($mmio) = 0; while(defined($_ = <$mmdx>)) { if(/^([^\|]+)\|/) { $mmil++; $mmin = $mmim; $mmim = mmto($1); if($mmio) { close($mmdx); return $mmim; } if($mmim eq $mmbi) { if($mmii == -1) { close($mmdx); return $mmin; } if($mmil < $mmcg) { $mmio = 1; } else { close($mmdx); return ''; } } } } close($mmdx); } return ''; } sub mmsj { my($mmip,$mmiq) = @_; my($mmhw) = ''; my($mmir) = ''; my($mmis) = ''; my($mmit) = 0; my($mmiu) = 0; my($mmiv) = 0; my($mmiw) = ''; my($mmix) = ''; my($mmiy) = localtime(time); $mmiy = mmtr($mmiy); my(@mmiz,@mmja,@mmjb, $mmjc,@mmjd,@mmje); my($mmjf); my(@mmjg,@mmjh,$mmji,@mmjj); { my($mmeq)=0; $mmjc=0; my($mmey)= ''; headerline: foreach $_ (@$mmip) { $mmey .= $_; if(/^[\r\n]+$/){ last headerline; } } $mmey =~ s/[\r\n]/ /g; if(($mmey =~ /Content-type\:\s+multipart\/mixed\s?;.*boundary\=\"([^\"\;\s]+)\"\;?\s/si) || ($mmey =~ /Content-type\:\s+multipart\/signed\s?;.*boundary\=\"([^\"\;\s]+)\"\;?\s/si) || ($mmey =~ /Content-type\:\s+multipart\/report\s?;.*boundary\=\"([^\"\;\s]+)\"\;?\s/si)) { $mmjf = 'multipart/mixed'; $mmir = $1; $mmix = mmtp($mmir); $mailman::mmjk = 1; } elsif(($mmey =~ /Content-type\:\s+multipart\/mixed\s?;.*boundary\=\"?([^\"\;\s]+)\"?\;?\s/si) || ($mmey =~ /Content-type\:\s+multipart\/signed\s?;.*boundary\=\"?([^\"\;\s]+)\"?\;?\s/si) || ($mmey =~ /Content-type\:\s+multipart\/report\s?;.*boundary\=\"?([^\"\;\s]+)\"?\;?\s/si)) { $mmjf = 'multipart/mixed'; $mmir = $1; $mmix = mmtp($mmir); $mailman::mmjk = 1; } elsif($mmey =~ /Content-type\:\s+multipart\/alternative\s?;.*boundary\=\"?([^\"\;\s]+)\"?\;?\s/si) { $mmjf = 'multipart/alternative'; $mmir = $1; $mmix = mmtp($mmir); } elsif($mmey =~ /Content-type\:\s+multipart\/related\s?;.*boundary\=\"?([^\"\;\s]+)\"?\;?\s/si) { $mmjf = 'multipart/related'; $mmir = $1; $mmix = mmtp($mmir); } elsif($mmey =~ /Content-type\:\s+([^\;]+);.*name\=\"?([^\"\;\s]+)\"?\;?\s/si) { $mmjf = $mmja[0] = $1; $mmis = $mmjd[0] = $2; $mmit = 0; $mmiz[0][$mmiu++] = "Content-type: $1; name=\"$2\"\n"; } elsif($mmey =~ /Content-type\:\s+([^\;]+)/si) { $mmjf = $mmja[0] = $1; $mmis = $mmjd[0] = 'messagebody'; $mmit = 0; $mmiz[0][$mmiu++] = "Content-type: $1\n"; } if($mmey =~ /Content-transfer-encoding\:\s+(\S+)\s/si) { $mmiz[0][$mmiu++] = "Content-transfer-encoding: $1\n"; } $mmiz[0][$mmiu++] = "\n"; $mmeq=0; $mmjc=0; messageline: foreach $_ (@$mmip) { if($mmeq) { if(/^\-\-$mmix\-\-/) { last messageline; } if(/^\-\-$mmix/) { $mmjc++; $mmiu=0; $mmiv=0; $mmjb[$mmjc] = $mmir . 'P' . $mmjc; next messageline; } $mmiz[$mmjc][$mmiu++] = $_; if(/^[\r\n]+$/) { if(!$mmiv) { $mmiv = 1; unless(defined($mmjd[$mmjc])) { $mmjd[$mmjc] = 'Untitled'; } } } if(!$mmiv) { if(/name\=\"?([^\"]+)\"?/i) { my($mmjl) = $1; $mmjd[$mmjc] = mmrh($mmjl); } if(/^Content-type\:\s+([^\;]+)\;?/i) { $mmiw = $1; $mmja[$mmjc] = $mmiw; } if(/^Content-ID\:\s+([^\;]+)\;?/i) { my($mmjm) = $1; $mmjm =~ s/\<([^\>]+)\>/$1/g; $mmjm =~ s/\s*(\S+)\s*/$1/g; $mmje[$mmjc] = $mmjm; } } } if(/^[\r\n]+$/) { $mmeq = 1; } } } if($mailman::mmbj eq '0') { mmsm($mmiz[0]); } my($mmjn)=1; if($mailman::mmbj ne '') { for(;$mmjn<=$mmjc;$mmjn++) { if($mmjb[$mmjn] eq $mailman::mmbj) { mmsm($mmiz[$mmjn]); } } } elsif($mailman::mmbk ne '') { for(;$mmjn<=$mmjc;$mmjn++) { if($mmje[$mmjn] eq $mailman::mmbk) { mmsm($mmiz[$mmjn]); } } } if($mailman::mmcr) { if($mmjf =~ /text\/plain/i) { $mmhw .= mmsr($mmip, $mmiq); return $mmhw; } elsif($mmjf =~ /text\/html/i) { $mmhw .= mmss($mmip, $mmiq); return $mmhw; } elsif($mmjf !~ /multipart\/mixed/i && $mmjf !~ /multipart\/alternative/i && $mmjf !~ /multipart\/related/i) { if($mmiq) { $mmhw .= mmsr($mmip, $mmiq); } else { my $mmjo = mmrk($mailman::mmen); if(($mmja[0] =~ /message\/rfc822/i) || $mmja[0] =~ /message\/delivery\-status/i) { $mmhw .= qq|
\n| . qq|
\n|; my($mmbx) = '';
my($mmjp) = $mmiz[0]; foreach $mmbx (@$mmjp) { $mmhw .= mmrj($mmbx); } $mmhw .=
qq|
\n| . qq|
\n|; } elsif($mailman::mmac) { $mmhw .= qq|

\n| . qq|\n| . qq|\n| . qq|

\n|; } else { if($mmis =~ /\.(jpg)|(gif)|(png)\s*$/i) { $mmhw .= qq|

\n| . qq|

\n| . qq|\n| . qq|\n| . qq|\n| . qq|
Attachment 1:\n| . qq|\n| . qq|$mmis
\n| . qq|\n| . qq|\n| . qq|

\n|; } else { $mmhw .= qq|

Attachment 1:\n| . qq|\n| . qq|$mmis

\n|; } } } return $mmhw; } my($mmjn)=1; if($mmjf =~ /multipart\/mixed/i) { if($mmja[1] =~ /multipart\/alternative/i || $mmja[1] =~ /multipart\/mixed/i) { $mmhw .= mmsj($mmiz[1], $mmiq); } elsif($mmja[1] =~ /text\/plain/i) { $mmhw .= mmsr($mmiz[1], $mmiq); } elsif($mmja[1] =~ /text\/html/i) { if($mmiq) { $mmhw .= mmsr($mmiz[1], $mmiq); } else { $mmhw .= mmss($mmiz[1]); } } else { $mmjn = 0; } } elsif($mmjf =~ /multipart\/alternative/i) { my($mmjq) = 1; for(;$mmjq<=$mmjc;$mmjq++) { if($mmja[$mmjq] =~ /text\/html/i && !$mmiq) { $mmhw .= mmss($mmiz[$mmjq]); return $mmhw; } } $mmjq = 1; for(;$mmjq<=$mmjc;$mmjq++) { if($mmja[$mmjq] =~ /text\/plain/i) { $mmhw .= mmsr($mmiz[$mmjq], $mmiq); return $mmhw; } } } elsif($mmjf =~ /multipart\/related/i) { $mmhw .= mmsj($mmiz[1],$mmiq); } else { $mmhw .= mmsr($mmip, $mmiq); return($mmhw); } if($mmiq) { return($mmhw); } if($mmjf eq 'multipart/mixed') { for(;$mmjn<$mmjc;$mmjn++) { my($mmjr) = $mmjb[$mmjn+1]; $mmjr = mmtn($mmjr); my $mmjo = mmrk($mailman::mmen); if(!defined($mmiz[$mmjn+1])) { ; } elsif(($mmja[$mmjn+1] =~ /message\/rfc822/i) || ($mmja[$mmjn+1] =~ /message\/delivery\-status/i) || ($mmja[$mmjn+1] eq '')) { $mmhw .= qq|
\n| . qq|
\n|; my($mmbx) = '';
my($mmjp) = $mmiz[$mmjn+1]; foreach $mmbx (@$mmjp) { $mmhw .= $mmbx; } $mmhw .=
qq|
\n| . qq|


\n|; } elsif($mailman::mmac) { $mmhw .= qq|

\n| . qq|\n| . qq|\n| . qq|

\n|; } else { if($mmjd[$mmjn+1] =~ /\.(jpg)|(gif)|(png)\s*$/i) { $mmhw .= qq|

\n| . qq|

\n| . qq|\n| . qq|\n| . qq|\n| . qq|
Attachment #$mmjn:\n| . qq|\n| . qq|$mmjd[$mmjn+1]
\n| . qq|\n| . qq|\n| . qq|

\n|; } else { $mmhw .= qq|

Attachment #$mmjn:\n| . qq|\n| . qq|$mmjd[$mmjn+1]

\n|; } } } } } else { $mmji=0; plaintextline: foreach $_ (@$mmip) { if(/^begin \d\d\d (\S+)\s*$/i) { $mmji++; $mmiu=0; $mmjj[$mmji] = $1; $mmjh[$mmji] = $1 . 'P' . $mmji; next plaintextline; } elsif($mmji>0 && /^end\s*$/i) { $mmji++; $mmiu=0; $mmjg[$mmji] .= "Fake Header\n\n"; next plaintextline; } $mmjg[$mmji][$mmiu++] = $_; } if($mailman::mmbj ne '') { my($mmjs) = 0; for(;$mmjs<=$mmji;$mmjs++) { if($mmjh[$mmjs] eq $mailman::mmbj) { if($mmjj[$mmjs] eq '') { $mmhw .= mmsr($mmjg[$mmjs], $mmiq); return $mmhw; } else { mmsq($mmjg[$mmjs],$mmjj[$mmjs]); } } } } else { my($mmjs) = 0; for(;$mmjs<=$mmji;$mmjs++) { if(!defined($mmjj[$mmjs]) || $mmjj[$mmjs] eq '') { $mmhw .= mmsr($mmjg[$mmjs], $mmiq); } elsif(!$mmiq) { my($mmjt) = $mmjh[$mmjs]; $mmjt = mmtn($mmjt); my $mmjo = mmrk($mailman::mmen); if($mailman::mmac) { $mmhw .= '

\n"; } else { if($mmjj[$mmjs] =~ /\.(jpg)|(gif)|(png)\s*$/i) { $mmhw .= qq|

\n| . qq|

\n| . qq|\n| . qq|\n| . qq|\n| . qq|
Attachment #$mmjs:\n| . qq|\n| . qq|$mmjj[$mmjs]
\n| . qq|\n| . qq|\n| . qq|

\n|; } else { $mmhw .= qq|

Attachment #$mmjs:\n| . qq|\n| . qq|$mmjj[$mmjs]

\n|; } } } } } if($mmja[0] =~ /text\/html/i) { $mmhw = mmss($mmip); } return($mmhw); } return($mmhw); } sub mmsm { my($mmjv) = @_; my($mmjw,$mmjx) = (0, 0); my($mmjy) = 0; my($mmiv) = 0; my($mmbx) = ''; my($mmjz) = ''; my($mmey) = ''; my($mmka) = ''; my($mmek) = 'Untitled'; foreach $mmbx (@$mmjv) { if($mmbx =~ /^Content-transfer-encoding\: base64/i) { $mmjw = 1; } elsif($mmbx =~ /^Content-transfer-encoding\: quoted-printable/i) { $mmjx = 1; } elsif($mmbx =~ /^Content-transfer-encoding\: x-uuencode/i) { $mmjy = 1; } else { if($mmiv && $mmjw) { $mmjz .= $mmbx; } elsif($mmiv && $mmjx) { $mmjz .= $mmbx; } elsif($mmiv) { $mmjz .= $mmbx; } else { $mmey .= $mmbx; } } if($mmbx =~ /^[\r\n]+$/) { $mmiv = 1; $mmey =~ s/[\r\n]+[ \t]+(\S)/ $1/gs; if($mmjy) { my $mmkb; do { $mmkb = shift(@$mmjv); } while($mmkb !~ /^begin \d\d\d (\S+)\s*$/i); $mmek = $1; mmsq($mmjv, $mmek); exit(0); } } if(!$mmiv && $mmbx =~ /name\=\"?([^\"\;]+)\"?\;?\s/si) { $mmek = $1; } } if($mmjw) { $mmka = mmsp($mmjz); } elsif($mmjx) { $mmka = mmso($mmjz); } else { $mmka = $mmjz; } print "Expires: Sun, 03 May 1998 16:00:00 GMT\n"; my($mmkc,$mmkd,$mmke) = mmtq(); if($mmkc !~ /MSIE/i) { print "Cache-control: no-cache\n"; } unless($mailman::mmw) { print $mmey; print $mmka; exit(0); } else { unless(-d $mailman::mmu) { unless(mkdir($mailman::mmu,0755)) { mmqr("Could not create temporary directory for " . "storing the attachment file. Make sure that " . "the directory " . "\"$mailman::mmu\" exists " . "and is writable by the web user."); } if(defined($mailman::iLocalDirectoryPermissions)) { mmtt($mailman::mmu, $mailman::iLocalDirectoryPermissions); } } my $mmkf = $mmek; if($mmek =~ /^(.+)(\.[^\.]+)$/) { my $mmkg = $1; my $mmkh = $2; $mmek = mmtn(mmtn($mmkg)) . $mmkh; } else { $mmek = mmtn(mmtn($mmek)); } my($mmki) = new FileHandle(); my($mmkj) = $mailman::mmu . '/' . $mmek; unless(open($mmki,">$mmkj")) { mmqr("Could not create temporary attachment file in \"" . $mmkj ."\". Make sure that the " . "directory is writable by the web user."); } binmode($mmki); print {$mmki} $mmka; close($mmki); if ($mmkf =~ /^(.+)(\.[^\.]+)$/) { my($mmkk) = $mailman::mmv . '/' . mmtn(mmtn(mmtn($1))) . $2; print "Location: $mmkk\n\n"; } else { my($mmkk) = $mailman::mmv . '/' . $mmek; print "Location: $mmkk\n\n"; } exit(0); } } sub mmsn { my $mmjz = shift; $mmjz =~ tr/\_/\ /; return $mmjz; } sub mmso { my($mmjz) = @_; my($mmkl); $mmjz =~ s/\s+(\r?\n)/$1/g; $mmjz =~ s/=\r?\n//g; $mmkl = $mmjz; $mmkl =~ s/=([\da-fA-F]{2})/pack("C", hex($1))/ge; return($mmkl); } sub mmsp { my($mmjz) = @_; my($mmkl); $mmjz =~ tr|A-Za-z0-9+=/||cd; if(length($mmjz)%4) { return($mmjz); } $mmjz =~ s/=+$//; $mmjz =~ tr|A-Za-z0-9+/| -_|; while($mmjz =~ /(.{1,60})/gs) { my($mmkm) = chr(32+length($1)*3/4); $mmkl .= unpack("u",$mmkm . $1 ); } return($mmkl); } sub mmsq { my($mmkn,$mmko) = @_; print "Expires: Sun, 03 May 1998 16:00:00 GMT\n"; my($mmkc,$mmkd,$mmke) = mmtq(); if($mmkc !~ /MSIE/i) { print "Cache-control: no-cache\n"; } unless($mailman::mmw) { print qq|Content-Type: application\/octet-stream; name="$mmko"\n\n|; my($mmhw) = ''; my($mmbx) = ''; foreach $mmbx (@$mmkn) { $mmhw .= unpack('u',$mmbx); } print $mmhw; exit(0); } else { unless(-d $mailman::mmu) { unless(mkdir($mailman::mmu,0755)) { mmqr("Could not create temporary directory for " . "storing the attachment file. Make sure that " . "the directory " . "\"$mailman::mmu\" exists " . "and is writable by the web user."); } if(defined($mailman::iLocalDirectoryPermissions)) { mmtt($mailman::mmu, $mailman::iLocalDirectoryPermissions); } } my($mmki) = new FileHandle(); my($mmkj) = $mailman::mmu . '/' . $mmko; unless(open($mmki,">$mmkj")) { mmqr("Could not temporary attachment file in \"" . $mmkj ."\". Make sure that the " . "directory is writable by the web user."); } binmode($mmki); my($mmbx) = ''; foreach $mmbx (@$mmkn) { print {$mmki} unpack('u',$mmbx); } close($mmki); my($mmkk) = $mailman::mmv . '/' . $mmko; print "Location: $mmkk\n\n"; exit(0); } } sub mmsr { my($mmip,$mmiq) = @_; my($mmjw,$mmjx); my($mmhw) = ''; my($mmeq) = 0; my($mmjz) = ''; if(!$mmiq) { $mmhw = "
\n"; } $mmeq=0;
foreach $_ (@$mmip) { if(!$mmeq) { if(/^Content-transfer-encoding\: base64/i) {
$mmjw = 1; } elsif(/^Content-transfer-encoding\: quoted-printable/i) { $mmjx = 1; } }
if($mmeq) { my($mmkp) = ''; if($mmjx || $mmjw) { $mmjz = $_; if($mmjw) {
$mmkp = mmsp($mmjz); } elsif($mmjx) { $mmkp = mmso($mmjz); }
} else { $mmkp = $_; } my($mmkq) = length($mmkp); my($mmkr) = ''; if($mmiq) {
$mmkr = $mmkp; $mmkr =~ s/\/\>\;/g;
$mmkr =~ s/\&/\&\;/g; } else { $mmkr = mmrj($mmkp); } my($mmks) = 90 +
(length($mmkr) - $mmkq); $mmkr =~ s/([^\n]{1,$mmks})\s/$1\n/g; $mmkr =~ s/\015//g;
if($mmiq) { $mmkr = '> ' . $mmkr; } $mmhw .= $mmkr ; } if(/^[\r\n]+$/){ $mmeq = 1; } }
if($mmjw) { $mmhw .= mmsp($mmjz); } elsif($mmjx) {
$mmhw .= mmso($mmjz); } if(!$mmiq) { $mmhw .= "
\n"; } return $mmhw; } sub mmss { my($mmip) = @_; my($mmjw,$mmjx); my($mmjz) = ''; my($mmhw) = ''; my($mmeq) = 0; foreach $_ (@$mmip) { if(!$mmeq) { if(/^Content-transfer-encoding\: base64/i) { $mmjw = 1; } elsif(/^Content-transfer-encoding\: quoted-printable/i) { $mmjx = 1; } } if($mmeq) { if($mmjx || $mmjw) { $mmjz .= $_; } else { my($mmkr) = $_; $mmkr =~ s/\r//g; $mmhw .= $mmkr; } } if(/^[\r\n]+$/){ $mmeq = 1; } } if($mmjw) { $mmhw .= mmsp($mmjz); } elsif($mmjx) { $mmhw .= mmso($mmjz); } $mmhw =~ s/\<\/?(html|head|body|title)[^\>]*\>//sig; my $mmjo = mmrk($mailman::mmen); $mmhw =~ s/(src\s*\=\s*\")cid\:([^\"]+)(\")/$1 . "${mailman::mmz}?SHOW:${mmjo}cid:" . mmtn($2) . '=TRUE' . $3/egi; return $mmhw; } sub mmst { my($mmbi,$mmii) = @_; my($mmcg) = 0; my($mmkt) = 0; my($mmdc) = $mailman::mmt . '/' . mmtn($mailman::mmaf); my($mmdx) = new FileHandle(); my($mmdr) = ''; my(%mmds) = (); my($mmku) = ''; my($mmkv) = ''; my($mmkw) = 0; my($mmil) = 0; my($mmdv) = 0; my($mmdy) = "${mmdc}/msglist"; retry: if(open($mmdx,"<$mmdy")) { flock($mmdx,2); if(<$mmdx> =~ /^(\d+)\s/) { $mailman::mmfb = $1; } else { close($mmdx); mmug($mmdc); goto retry; } messageloop: while(defined($_ = <$mmdx>)) { chomp; if(/^([^\|]+)\|/ && mmqx($_)) { $mmil++; my($mmim) = $mailman::mmck; unless($mmkt) { $mmcg++; } unless(defined($mailman::mmct) && $mailman::mmct =~ /R/i) { $mmdv++; } my($mmea) = $mailman::mmco; my($mmeb) = 0; while(defined($mmds{$mmea})) { if($mmea =~ s/^([^\_]*)\_(\d+)/$1/) { $mmeb++; } $mmea .= "_$mmeb"; } $mmds{$mmea} = $_; if($mmim eq $mmbi) { $mmkt = 1; $mailman::mmep = $mmil; if($mailman::mmct !~ /R/i) { $mmdv--; $mmku = $_; $mmkv = $mmea; $mmkw = 1; } } } elsif(/^DELETED\:\s+(\S+)\s*$/) { my($mmdz) = mmto($1); $mmdr .= $_ . "\n"; } elsif(/^\S+\:\s+(\S+)\s*$/) { my($mmdz) = mmto($1); $mmdr .= $_ . "\n"; } } close($mmdx); } $mailman::mmen = mmto(mmsg(mmtn($mmbi),$mmii)); my($mmbp) = ''; if($mailman::mmac) { $mmbp = 't_nf_message.htm'; } else { $mmbp = 't_f_message.htm'; } $mailman::mmbg{'USERNAME'} = $mailman::mmm; $mailman::mmbg{'USERNAMEHIDDEN'} = $mailman::mmn; $mailman::mmbg{'SERVER'} = $mailman::strIncomingServer; $mailman::mmbg{'SERVERHIDDEN'} = $mailman::mmq; $mailman::mmbg{'PASSWORDHIDDEN'} = $mailman::mmp; $mailman::mmbg{'CHECKSUM'} = $mailman::mmy; $mailman::mmbg{'NUM'} = $mailman::mmfb; $mailman::mmbg{'TO'} = $mailman::mmcy; $mailman::mmbg{'FROM'} = $mailman::mmcz; $mailman::mmbg{'DATE'} = $mailman::mmcn; $mailman::mmbg{'SUBJECT'} = $mailman::mmda; $mailman::mmbg{'MESSAGENUM'} = $mailman::mmep; $mailman::mmbg{'MESSAGE'} = mmsj(\@mailman::mmik); $mailman::mmbg{'ID'} = mmrk($mailman::mmen); $mailman::mmbg{'MESSAGENUM'} = $mmcg + $mmii; $mailman::mmbg{'FOLDERLIST'} = mmua(); $mailman::mmbg{'CC'} = $mailman::mmex; $mailman::mmkx = mmti($mmbp,'CCLINE'); if($mailman::mmcl eq '') { $mailman::mmkx = ''; } else { $mailman::mmkx = mmtg($mailman::mmkx,\%mailman::mmbg); } $mailman::mmbg{'CCLINE'} = $mailman::mmkx; mmtk($mmbp,\%mailman::mmbg,1); if($mmkw) { mmqx($mmku); $mailman::mmct .= 'R'; $mmku = mmqw(undef,undef); $mmds{$mmkv} = $mmku; unless(open($mmdx,">$mmdy")) { mmqr("Could not create user message list in \"" . $mmdy ."\". Make sure that the " . "directory is writable by the web user."); } flock($mmdx,2); $mailman::mmce = $mmcg; print {$mmdx} "$mmil $mmdv\n"; my($mmej) = ''; foreach $mmej (sort {$a <=> $b} keys %mmds) { print {$mmdx} $mmds{$mmej} . "\n"; } print {$mmdx} "\n" . $mmdr; close($mmdx); } exit(1); } sub mmsu { my($mmbi,$mmii) = @_; $mailman::mmen = mmsg(mmtn($mmbi),$mmii); my($mmbp) = ''; if($mailman::mmac) { $mmbp = 't_nf_message.htm'; } else { $mmbp = 't_f_message.htm'; } $mailman::mmbg{'USERNAME'} = $mailman::mmm; $mailman::mmbg{'USERNAMEHIDDEN'} = $mailman::mmn; $mailman::mmbg{'SERVER'} = $mailman::strIncomingServer; $mailman::mmbg{'SERVERHIDDEN'} = $mailman::mmq; $mailman::mmbg{'PASSWORDHIDDEN'} = $mailman::mmp; $mailman::mmbg{'CHECKSUM'} = $mailman::mmy; $mailman::mmbg{'NUM'} = $mailman::mmfb; $mailman::mmbg{'MESSAGENUM'} = $mailman::mmep; $mailman::mmbg{'TO'} = $mailman::mmcy; $mailman::mmbg{'FROM'} = $mailman::mmcz; $mailman::mmbg{'DATE'} = $mailman::mmcn; $mailman::mmbg{'SUBJECT'} = $mailman::mmda; $mailman::mmbg{'FOLDERLIST'} = mmua(); $mailman::mmbg{'ID'} = mmrk($mailman::mmen); $mailman::mmbg{'CC'} = $mailman::mmex; $mailman::mmkx = mmti($mmbp,'CCLINE'); if($mailman::mmcl eq '') { $mailman::mmkx = ''; } else { $mailman::mmkx = mmtg($mailman::mmkx,\%mailman::mmbg); } $mailman::mmbg{'CCLINE'} = $mailman::mmkx; $mailman::mmbg{'MESSAGE'} = "
\n";
my($mmbx) = ''; foreach $mmbx (@mailman::mmik) { $mmbx =~ s/\015//g;
$mmbx =~ s/\&/\&\;/g; $mmbx =~ s/\/\>\;/g;
$mailman::mmbg{'MESSAGE'} .= $mmbx; } $mailman::mmbg{'MESSAGE'} .= "
\n"; mmtk($mmbp,\%mailman::mmbg); } sub mmsv { my($mmbi) = @_; $mailman::mmce = mmri($mmbi); mmqu($mma,"DELE $mailman::mmce"); my($mmcd) = ''; $mmcd = <$mma>; unless($mmcd =~ /^\+OK/) { mmqr($mmcd); } } sub mmsw { my($mmbi) = @_; mmro(); if($mailman::mmar && $mailman::mmaf !~ /^TRASH$/i) { unless(mmsz($mmbi,'TRASH')) { mmqr("There was an unknown error copying this message " . "into the 'TRASH' folder. The deletion was " . "aborted."); } } mmsx($mmbi); if($mailman::mmaf ne 'INBOX') { mmsy($mmbi); } } sub mmsx { my($mmbi,$mmky) = @_; unless($mmky) { $mmky = 'DELETED'; } my($mmdc) = $mailman::mmt . '/' . mmtn($mailman::mmaf); my($mmdy) = "${mmdc}/msglist"; my($mmdx) = new FileHandle(); my($mmkz) = new FileHandle(); retry: if(!open($mmdx,"+<$mmdy")) { mmqr("Could not open message index for deletion."); return; } if(!open($mmkz,">$mmdy.tmp")) { mmqr("Could not create backup message index."); return; } flock($mmdx,2); my($mmbx) = ''; $mmbx = <$mmdx>; if($mmbx =~ /^(\d+)\s(\d+)\s/) { $mailman::mmfb = $1; $mailman::mmfb--; my($mmla) = ($2 - 1); print {$mmkz} "$mailman::mmfb $mmla\n"; } elsif($mmbx =~ /^(\d+)\s/) { $mailman::mmfb = $1; $mailman::mmfb--; print {$mmkz} "$mailman::mmfb\n"; } else { close($mmdx); close($mmkz); mmug($mmdc); goto retry; } my($mmlb) = 0; while(defined($_ = <$mmdx>)) { if((/^([^\|]+)\|/)||(/^\S+\:\s+(\S+)\s*$/)) { my($mmlc) = mmto($1); if($mmlc eq $mmbi) { if($mailman::mmaf eq 'INBOX') { print {$mmkz} "$mmky: " . mmtn($mmlc) . "\n"; } $mmlb = 1; } else { print {$mmkz} $_; } } } close($mmkz); if($mmlb) { if(!open($mmkz,"<$mmdy.tmp")) { mmqr("Could not open backup message index."); return; } seek($mmdx,0,0); truncate($mmdx,0); while(defined($_ = <$mmkz>)) { print {$mmdx} $_; } close($mmkz); unlink($mmdc . '/' . mmtn($mmbi)); } close($mmdx); } sub mmsy { my($mmbi) = shift; my($mmdx) = new FileHandle(); my($mmkz) = new FileHandle(); my($mmdy) = "${mailman::mmt}/INBOX/msglist"; retry: if(open($mmdx,"<$mmdy") && open($mmkz,">$mmdy.tmp")) { flock($mmdx,2); if(<$mmdx> =~ /^(\d+)\s/) { print {$mmkz} "$1\n"; } else { close($mmdx); close($mmkz); mmug("${mailman::mmt}/INBOX"); goto retry; } while(defined($_ = <$mmdx>)) { if(/^\S+\:\s+(\S+)\s*$/) { my($mmdz) = mmto($1); unless($mmdz eq $mmbi) { print {$mmkz} $_; } } else { print {$mmkz} $_; } } print {$mmkz} "DELETED: " . mmtn($mmbi) . "\n"; close($mmdx); close($mmkz); use File::Copy; copy("$mmdy.tmp", $mmdy); } } sub mmsz { my($mmbi, $mmbm) = @_; my($mmdc) = $mailman::mmt . '/' . mmtn($mailman::mmaf); my($mmld) = mmtn($mmbi); my($mmdy) = "${mmdc}/msglist"; my($mmdx) = new FileHandle(); retry: if(!open($mmdx,"+<$mmdy")) { mmqr("Could not open message index."); return 0; } flock($mmdx,2); if(<$mmdx> =~ /^(\d+)\s/) { $mailman::mmfb = $1; } else { close($mmdx); mmug($mmdc); goto retry; } my($mmco) = ''; my($mmcu) = ''; while(defined($_ = <$mmdx>)) { if(/^([^\|]+)\|/) { my($mmlc) = mmto($1); if($mmlc eq $mmbi) { $mmcu = $_; $mmco = $mailman::mmco; } } } close($mmdx); if($mmcu eq '') { return 0; } unless(mmqx($mmcu)) { return 0; } my($mmle) = $mailman::mmco; my(%mmds) = (); $mmds{$mmle} = $mmcu; if(mmta($mmbm,1,\%mmds)) { unless(copy("${mmdc}/${mmld}", "${mailman::mmt}/${mmbm}/${mmld}")) { return 0; } } return 1; } sub mmta { my($mmbm,$mmee,$mmlf) = @_; my($mmlg) = $mailman::mmt . '/' . $mmbm; unless(-d $mmlg) { my $mmlh = $mailman::mmaf; $mailman::mmaf = $mmbm; mmqz(); $mailman::mmaf = $mmlh; } my($mmli) = "${mmlg}/msglist"; my($mmdx) = new FileHandle(); retry: if(!open($mmdx,"<$mmli")) { if(!open($mmdx,">$mmli")) { mmqr("Could not create new message index: " . $mmli); return; } flock($mmdx,2); print {$mmdx} "$mmee $mmee\n"; my($mmej) = ''; foreach $mmej (sort keys %{$mmlf}) { print {$mmdx} $mmlf->{$mmej} . "\n"; } close($mmdx); return 1; } flock($mmdx,2); my($mmdr) = ''; my($mmcg) = my($mmdu) = 0; my($mmdv) = 0; my(%mmdw); my($mmbx) = ''; $mmbx = <$mmdx>; if($mmbx =~ /^(\d+)\s(\d+)\s/) { $mmcg = $1; } elsif($mmbx =~ /^(\d+)\s/) { $mmcg = $1; } else { close($mmdx); mmug($mmlg); goto retry; } $mmdu = 0; while(defined($_ = <$mmdx>)) { chomp; if(/^([^\|]+)\|/ && mmqx($_)) { my($mmdz) = mmto($1); $mmdu++; unless(defined($mailman::mmct) && $mailman::mmct =~ /R/i) { $mmdv++; } my($mmea) = $mailman::mmco; my($mmeb) = 0; while(defined($mmlf->{$mmea})) { if($mmea =~ s/^([^\_]*)\_(\d+)/$1/) { $mmeb++; } $mmea .= "_$mmeb"; } $mmlf->{$mmea} = $_; } elsif(/^DELETED\:\s+(\S+)\s*$/) { my($mmdz) = mmto($1); $mmdw{$mmdz} = 1; $mmdr .= $_ . "\n"; } elsif(/^\S+\:\s+(\S+)\s*$/) { my($mmdz) = mmto($1); $mmdr .= $_ . "\n"; } } if($mmdu != $mmcg) { close($mmdx); mmug($mmlg); goto retry; } close($mmdx); unless(open($mmdx,">$mmli")) { mmqr("Could not create user message list in \"" . $mmli . "\". Make sure that the " . "directory is writable by the web user."); } flock($mmdx,2); $mailman::mmce = $mmcg + $mmee; $mmdv += $mmee; print {$mmdx} "$mailman::mmce $mmdv\n"; my($mmej) = ''; foreach $mmej (sort keys %{$mmlf}) { print {$mmdx} $mmlf->{$mmej} . "\n"; } print {$mmdx} "\n" . $mmdr; close($mmdx); return 1; } sub mmtb { my($mmbi,$mmlj,$mmlk, $mmay) = @_; my($mmhw) = ''; my($mmll) = ''; my($mmlm) = ''; my($mmln) = ''; $mailman::mmbg{'ATTACH'} = $mailman::in{'ATTACH'}; my($mmbp) = ''; $mmbp = 't_messageform.htm'; mmro(); if($mmbi ne 'NEW') { mmsg(mmtn($mmbi),0); $mmll = $mailman::mmay; $mmlm = $mailman::mmcm; $mmln = $mailman::mmcp; if($mailman::mmcq) { $mailman::mmay = $mailman::mmcq; } else { $mailman::mmay = $mailman::mmcm; } if($mmlj) { $mailman::mmay .= ", $mmll"; if($mailman::mmcl){ $mailman::mmay .= ", $mailman::mmcl"; } } if($mmlk) { unless($mailman::mmcp =~ /^fwd\:/i) { $mailman::mmcp = "Fwd: $mailman::mmcp"; } $mailman::mmay = ""; } else { unless($mailman::mmcp =~ /^re\:/i) { $mailman::mmcp = "Re: $mailman::mmcp"; } } $mailman::mmcl = ''; } $mailman::mmay =~ s/\"/"/g; $mailman::mmcp =~ s/\"/"/g; if($mmbi ne 'NEW') { $mailman::mmjk = 0; $mmhw = mmsj(\@mailman::mmik,1); if($mmlk) { my($mmlo) = mmti($mmbp, 'FORWARDHEADER'); $mailman::mmbg{'ORIGINALTO'} = $mmll; $mailman::mmbg{'ORIGINALFROM'} = $mmlm; $mailman::mmbg{'ORIGINALSUBJECT'} = $mmln; $mailman::mmbg{'ORIGINALDATE'} = $mailman::mmcn; $mmhw = mmtg($mmlo, \%mailman::mmbg) . $mmhw; $mmhw = "\n\n\n\n" . $mailman::mmam . "\n\n" . $mmhw; if($mailman::mmjk) { $mailman::mmlp = $mmbi; $mailman::mmbg{'ERROR'} = 'The original message attachment(s) ' . 'will be included in this message.'; } } else { $mmhw = "\n\n" . $mmhw . "\n\n" . $mailman::mmam; } } else { unless(length($mmhw)) { $mmhw = "\n\n\n\n" . $mailman::mmam; } } if(defined($mmay)) { $mailman::mmay = $mmay; } $mailman::mmbg{'USERNAME'} = $mailman::mmm; $mailman::mmbg{'USERNAMEHIDDEN'} = $mailman::mmn; $mailman::mmbg{'SERVER'} = $mailman::strIncomingServer; $mailman::mmbg{'SERVERHIDDEN'} = $mailman::mmq; $mailman::mmbg{'PASSWORDHIDDEN'} = $mailman::mmp; $mailman::mmbg{'CHECKSUM'} = $mailman::mmy; $mailman::mmbg{'NUM'} = $mailman::mmce; $mailman::mmbg{'MESSAGE'} = $mmhw; $mailman::mmbg{'TO'} = $mailman::mmay; $mailman::mmbg{'CC'} = $mailman::mmcl; $mailman::mmbg{'SUBJECT'} = $mailman::mmcp; my($mmlq) = $mailman::mmak; $mailman::mmbg{'FROM'} = $mmlq . ' <' . $mailman::mmal . '>'; my($mmlr) = $mailman::mman; $mailman::mmbg{'OUTGOING'} = $mmlr; my($mmkc,$mmkd,$mmke) = mmtq(); my($mmls) = 0; if(($mmkc =~ /MSIE/i && $mmkd >= 4) || ($mmkc =~ /Mozilla/i && $mmkd >= 2)) { if(!$mmlk) { if($mailman::in{'ATTACH'}) { $mailman::mmbg{'UPLOAD'} = mmti($mmbp, 'UPLOAD'); $mmls = 1; } else { $mailman::mmbg{'UPLOAD'} = mmti($mmbp, 'BENIGNUPLOAD'); } } else { $mailman::mmbg{'UPLOAD'} = ''; } } else { $mailman::mmbg{'UPLOAD'} = ''; } if($mmls) { $mailman::mmbg{'MULTIPARTTAG'} = mmti($mmbp,'MULTIPARTTAG'); $mailman::mmbg{'ENCTYPE'} = "multipart/form-data"; } else { $mailman::mmbg{'ENCTYPE'} = "application/x-www-form-urlencoded"; } mmtk($mmbp,\%mailman::mmbg); } sub mmtc { my($mmbf,$mmlt) = @_; my($mmlk) = 0; $mailman::mmbg{'ATTACH'} = $mailman::in{'ATTACH'}; my($mmbp) = ''; $mmbp = 't_messageform.htm'; $mailman::mmbg{'USERNAME'} = $mailman::mmm; $mailman::mmbg{'USERNAMEHIDDEN'} = $mailman::mmn; $mailman::mmbg{'SERVER'} = $mailman::strIncomingServer; $mailman::mmbg{'SERVERHIDDEN'} = $mailman::mmq; $mailman::mmbg{'PASSWORDHIDDEN'} = $mailman::mmp; $mailman::mmbg{'CHECKSUM'} = $mailman::mmy; $mailman::mmbg{'NUM'} = $mailman::in{'NUM'}; $mailman::mmbg{'TO'} = $mailman::in{'TO'}; $mailman::mmbg{'CC'} = $mailman::in{'CC'}; $mailman::mmbg{'FROM'} = $mailman::in{'FROM'}; $mailman::mmbg{'SUBJECT'} = $mailman::in{'SUBJECT'}; $mailman::mmbg{'OUTGOING'} = $mailman::strOutgoingServer; $mailman::mmbg{'ERROR'} = $mmbf; unless(defined($mmlt) && length($$mmlt)) { $mailman::mmbg{'MESSAGE'} = $mailman::in{'TEXT'}; } else { $mailman::mmbg{'MESSAGE'} = $$mmlt; } if(defined($mailman::in{'FORWARDATTACHMENTS'})) { $mailman::mmlp = mmto($mailman::in{'FORWARDATTACHMENTS'}); $mmlk = 1; } my($mmkc,$mmkd,$mmke) = mmtq(); my($mmls) = 0; if(($mmkc =~ /MSIE/i && $mmkd >= 4) || ($mmkc =~ /Mozilla/i && $mmkd >= 2)) { if(!$mmlk) { if($mailman::in{'ATTACH'}) { $mailman::mmbg{'UPLOAD'} = mmti($mmbp, 'UPLOAD'); $mmls = 1; } else { $mailman::mmbg{'UPLOAD'} = mmti($mmbp, 'BENIGNUPLOAD'); } } else { $mailman::mmbg{'UPLOAD'} = ''; } } else { $mailman::mmbg{'UPLOAD'} = ''; } if($mmls) { $mailman::mmbg{'MULTIPARTTAG'} = mmti($mmbp,'MULTIPARTTAG'); $mailman::mmbg{'ENCTYPE'} = "multipart/form-data"; } else { $mailman::mmbg{'ENCTYPE'} = "application/x-www-form-urlencoded"; } mmtk($mmbp,\%mailman::mmbg); } sub mmtd { my($mmbv) = "\015\012"; my($mmbw, $mmbx) = @_; if($mailman::mmlu) { print $mailman::mmlv $mmbx . $mmbv; } else { my($mmby) = length($mmbx . $mmbv); syswrite($mmbw,$mmbx . $mmbv,$mmby); } } sub mmte { my($mmbv) = "\015\012"; my($mmhw) = ''; my($mmir) = ''; my($mmlw) = ''; my($mmay) = ''; my($mmbf) = ''; if($mmbf = mmqv()) { if(defined($mmbf)) { $mmbf =~ s/^\-ERR(.*)$/$1/; } $mailman::bKioskMode = 0; $mailman::mmbg{'GREETING'} = "
Log In Error: $mmbf
"; mmtk('t_login.htm',\%mailman::mmbg); mmqu($mma,"QUIT"); close $mma; $mailman::mmbl = 0; } mmro(); my($mmlx) = $mailman::in{'FORWARDATTACHMENTS'}; if($mmlx) { $mmlx = $mmlx; mmsg($mmlx,0); my($mmjc) = 0; my($mmbx) = ''; foreach $mmbx (@mailman::mmik) { if($mmbx =~ /boundary\=\"?([^\"]+)\"?\;?/ && $mmir eq '') { $mmir = $1; } if($mmir ne '' && $mmbx =~ /^\-\-$mmir\s*$/) { $mmjc++; } if($mmjc > 0) { $mmbx =~ s/[\r\n]+/$mmbv/; $mmlw .= $mmbx; } } } $mmhw = $mailman::in{'TEXT'}; $mmhw =~ s/\015//sg; $mmhw =~ s/([^\012]{1,90})\s/$1\012/sg; $mmhw =~ s/\012/\015\012/sg; my $mmcm = $mailman::in{'FROM'}; my $mmly = 0; local *Reader, *Writer; if(defined($mailman::strLocalLocationSendmail)) { $mailman::mmlu = 1; use IPC::Open2; $mmly = open2(\*Reader, \*Writer, "$mailman::strLocalLocationSendmail -bs"); $mma = \*Reader; select($mma); $|=1; select(STDOUT); binmode($mma); $mailman::mmlv = \*Writer; select($mailman::mmlv); $|=1; select(STDOUT); binmode($mailman::mmlv); } else { unless($mailman::strOutgoingServer) { mmtc("Send Error: No server provided, cannot proceed.", \$mmhw); } my($mmca) = 0; $mmca = getprotobyname('tcp'); socket($mma,PF_INET,SOCK_STREAM,$mmca); my($mmcb) = 0; $mmcb = gethostbyname($mailman::strOutgoingServer); unless($mmcb) { mmtc("Could not find an IP address for the host " . "\"$mailman::strOutgoingServer\".", \$mmhw); } my($mmcc) = ''; $mmcc = sockaddr_in(25, $mmcb); unless(connect($mma, $mmcc)) { mmtc("Send Error: Could not connect to server " . "$mailman::strOutgoingServer", \$mmhw); } select($mma); $|=1; select(STDOUT); binmode($mma); } $mailman::mmbq = "The server connected, but will not respond."; if($mailman::bUseAlarm){ alarm($mailman::iTimeoutDurationInSeconds); } my($mmcd) = ''; $mmcd = <$mma>; unless($mmcd =~ /^220.+/) { if($mailman::mmlu) { mmtc("Could not invoke local Sendmail instance at \"" . $mailman::strLocalLocationSendmail . "\""); } else { mmtc("Send Error: The server does not respond " . "appropriately. It responded: \"$mmcd\"", \$mmhw); } } while($mmcd =~ /^\d\d\d\-/) { $mmcd = <$mma>; } my($mmlz) = $ENV{REMOTE_HOST}; unless($mmlz){ $mmlz = 'mailman.endymion.com';} mmtd($mma,"HELO $mmlz"); $mmcd = <$mma>; unless($mmcd =~ /^250.+/) { mmtc('Send Error: ' . $mmcd, \$mmhw); } while($mmcd =~ /^\d\d\d\-/) { $mmcd = <$mma>; } $mailman::mmbq = "The server timed out while accepting a message."; if($mailman::bUseAlarm){ alarm($mailman::iTimeoutDurationInSeconds); } my($mmma) = $mmcm; if($mmma =~ /(\<[^\>]+\>)/) { $mmma = $1; } else { $mmma = '<' . $mmma . '>'; } mmtd($mma,"MAIL FROM: $mmma"); $mmcd = <$mma>; unless($mmcd =~ /^250.+/) { mmtc('Send Error: ' . $mmcd, \$mmhw); } while($mmcd =~ /^\d\d\d\-/) { $mmcd = <$mma>; } mmrr(); my($mmaz) = ''; if($mailman::mmfu) { foreach $mmaz (sort keys %mailman::mmba) { $mmaz =~ tr/[A-Z]/[a-z]/; my($mmbb) = $mailman::mmba{$mmaz}->{'FIRSTNAME'}; unless(defined($mmbb)){ $mmbb = ''; } my($mmbc) = $mailman::mmba{$mmaz}->{'LASTNAME'}; unless(defined($mmbc)){ $mmbc = ''; } my($mmbd) = $mailman::mmba{$mmaz}->{'ADDRESS'}; unless(defined($mmbd)){ $mmbd = ''; } if(($mmbb ne '') || ($mmbc ne '')) { $mailman::mmba{$mmaz}->{'SMTPADDRESS'} = "$mmbb $mmbc <$mmbd>"; } else { $mailman::mmba{$mmaz}->{'SMTPADDRESS'} = "$mmbd"; } } } mmrs(); my($mmgj) = ''; if($mailman::mmfy) { foreach $mmaz (sort keys %mailman::mmbe) { $mmaz =~ tr/[A-Z]/[a-z]/; $mailman::mmbe{$mmaz} =~ s/(\r\n)|(\r\n)/,/g; $mailman::mmbe{$mmaz} =~ s/[\r\n]/,/g; $mailman::mmbe{$mmaz} =~ s/\,$//g; } } { $mmay = $mailman::in{'TO'}; $mmay =~ s/\;/\,/g; $mailman::in{'TO'} = $mmay; } my($mmmb) = $mailman::in{'TO'}; $mmmb =~ s/\"[^\"]+\"//g; my(@mmmc) = split(/[\,\;]/,$mmmb); my($mmmd) = ''; my(@mmme) = ();; my($mmcl) = ''; if($mailman::in{'CC'}) { $mmmd .= $mailman::in{'CC'}; @mmme = split(/[\,\;]/,$mmmd); $mmcl = $mailman::in{'CC'}; } my(@mmmf) = (); my(@mmmg) = (); my(@mmmh) = (); { my($mmfx); for($mmfx=0;$mmfx<($#mmmc+1);$mmfx++) { my($mmmi) = $mmmc[$mmfx]; $mmmi =~ s/^\s+(.*)$/$1/; $mmmi =~ s/^(.*)\s+$/$1/; my($mmmj) = $mmmi; $mmmj =~ tr/[A-Z]/[a-z]/; if($mailman::mmbe{$mmmj}) { $mmmi = $mailman::mmbe{$mmmj}; } push(@mmmf,split(/[\,\;]/,$mmmi)); } for($mmfx=0;$mmfx<($#mmme+1);$mmfx++) { my($mmmi) = $mmme[$mmfx]; $mmmi =~ s/^\s+(.*)$/$1/; $mmmi =~ s/^(.*)\s+$/$1/; my($mmmj) = $mmmi; $mmmj =~ tr/[A-Z]/[a-z]/; if($mailman::mmbe{$mmmj}) { $mmmi = $mailman::mmbe{$mmmj}; } push(@mmmg,split(/[\,\;]/,$mmmi)); } } my($mmmk) = 0; for(;$mmmk<2;$mmmk++) { my($mmml,$mmmm,$mmmn); if($mmmk == 0) { $mmml = \$mmay; $mmmm = \@mmmf; $mmmn = $#mmmf; } else { $mmml = \$mmcl; $mmmm = \@mmmg; $mmmn = $#mmmg; } my($mmfx); recipient: for($mmfx=0;$mmfx<($mmmn+1);$mmfx++) { my($mmmi) = $mmmm->[$mmfx]; my($mmmj) = $mmmi; $mmmj =~ tr/[A-Z]/[a-z]/; if($mailman::mmba{$mmmj}->{'SMTPADDRESS'}) { $mmmi = $mailman::mmba{$mmmj}->{'SMTPADDRESS'}; $mmmm->[$mmfx] = $mmmi; } if($mmmi =~ /^\s*$/){ next recipient; } push(@mmmh,$mmmi); } ${$mmml} = join(', ',@{$mmmm}); } my($mmmi) = ''; while($mmmi = shift(@mmmh)) { $mmmi =~ s/^\s+(.*)$/$1/; $mmmi =~ s/^(.*)\s+$/$1/; unless($mmmi =~ /@/) { if(defined($mailman::strOutgoingDomainName)) { $mmmi .= "\@$mailman::strOutgoingDomainName"; } } if($mmmi =~ /(\S+)\s+\([^\)]\)/) { $mmmi = '<' . $1 . '>'; } elsif($mmmi =~ /\<([^\>]+)\>/) { $mmmi = '<' . $1 . '>'; } elsif($mmmi !~ /\<[^\>]+\>/) { $mmmi = '<' . $mmmi . '>'; } mmtd($mma,"RCPT TO: $mmmi"); my $mmcd = <$mma>; unless($mmcd =~ /^250.+/) { mmtc('Send Error: ' . $mmcd, \$mmhw); } while($mmcd =~ /^\d\d\d\-/) { $mmcd = <$mma>; } } mmtd($mma,"DATA"); my $mmcd = <$mma>; unless($mmcd =~ /^354.+/) { mmtc('Send Error: ' . $mmcd, \$mmhw); } while($mmcd =~ /^\d\d\d\-/) { $mmcd = <$mma>; } my($mmmo) = defined($ENV{'TZ'}) ? $ENV{'TZ'} : 'GMT'; my(@mmmp) = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat'); my(@mmih) = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep', 'Oct','Nov','Dec'); my($mmhy,$mmhz,$mmia,$mmib,$mmic,$mmid,$mmie) = ($mmmo eq 'GMT') ? gmtime(time) : localtime(time); $mmie = $mmmp[$mmie]; $mmic = $mmih[$mmic]; $mmia = sprintf("%2.2d",$mmia); $mmhz = sprintf("%2.2d",$mmhz); $mmhy = sprintf("%2.2d",$mmhy); if(length($mmid) == 2) { $mmid = mmui($mmid); } elsif(length($mmid) == 3) { $mmid += 1900; } my($mmcn) = "$mmie, $mmib $mmic $mmid $mmia:$mmhz:$mmhy $mmmo"; my($mmmq) = $mmie.$mmib.$mmic.$mmid.$mmia.$mmhz.$mmhy; $mailman::mmay = $mmay; my $mmmr = qq|To: ${mmay}${mmbv}|; if($mmcl) { $mmmr .= qq|Cc: ${mmcl}${mmbv}|; } $mailman::mmcm = $mailman::in{'FROM'}; $mmmr .= qq|From: ${mmcm}${mmbv}|; my $mmcp = $mailman::in{'SUBJECT'}; $mmmr .= qq|Subject: ${mmcp}${mmbv}|; $mmmr .= qq|Date: ${mmcn}${mmbv}|; $mmmr .= "X-Mailer: Endymion MailMan " . "$mailman::strMailManEdition $mailman::strMailManVersion$mmbv"; if($mailman::in{'USERFILE1'} || $mailman::in{'USERFILE2'} || $mmlx) { unless($mmir){ $mmir = 'MailMan_Boundary'; } $mmmr .= "MIME-Version: 1.0$mmbv"; $mmmr .= "Content-Type: multipart/mixed; boundary=\"$mmir\"$mmbv$mmbv"; $mmmr .= "This is a multi-part message in MIME format.$mmbv$mmbv"; $mmmr .= "--$mmir$mmbv"; $mmmr .= "Content-Type: text/plain$mmbv$mmbv"; } else { $mmmr .= "$mmbv"; } mmtd($mma,$mmmr . $mmhw); my($mmel) = new FileHandle(); my($mmdc) = ''; my($mmms) = $mailman::mmaf; my($mmmt) = 0; if($mailman::mmas) { $mailman::mmaf = 'SENT'; $mmdc = $mailman::mmt . '/' . mmtn($mailman::mmaf); mmqy(); mmqz(); my($mmei) = $mmdc . '/' . mmtn( $mailman::mmm . '@' . $mailman::strIncomingServer . '@' . $mmmq); if(open($mmel,">$mmei")) { $mmmr =~ s/\015\012/\n/g; $mmhw =~ s/\015\012/\n/g; print {$mmel} $mmmr . $mmhw; $mmmt += length($mmmr) + length($mmhw); } else { mmtc("There was a problem storing the outgoing " . "message in the 'SENT' folder. The send was " . "aborted."); } } if(defined($mailman::strOutgoingBannerText)) { if($mailman::mmas) { print {$mmel} $mailman::strOutgoingBannerText; $mmmt += length($mailman::strOutgoingBannerText); } $mailman::strOutgoingBannerText =~ s/\015//sg; $mailman::strOutgoingBannerText =~ s/([^\012]{1,90})\s/$1\012/sg; $mailman::strOutgoingBannerText =~ s/\012/\015\012/sg; mmtd($mma, $mailman::strOutgoingBannerText); } my($mmjl) = ''; foreach $mmjl ('USERFILE1','USERFILE2') { unless($mailman::in{$mmjl}){next;} my($mmek) = ''; $mmek = $mailman::incfn{$mmjl}; my($mmew) = $mailman::inct{$mmjl}; my $mmmu .= $mailman::in{$mmjl}; my($mmmv) = $mmek; $mmmv =~ s/^.*[\\\/]([^\\\/]+)$/$1/; my($mmmw) = '--' . $mmir . $mmbv; $mmmw .= "Content-Type: ${mmew}; name=\"" . $mmmv . "\"$mmbv"; $mmmw .= "Content-Transfer-Encoding: base64$mmbv"; $mmmw .= "Content-Disposition: attachment; filename=\"" . $mmmv . "\"$mmbv"; $mmmw .= $mmbv; $mmmw .= mmuk($mmmu,$mmbv); mmtd($mma,$mmmw); if($mailman::mmas) { $mmmw =~ s/\015\012/\n/g; print {$mmel} $mmmw; $mmmt += length($mmmw); } } if($mmlw) { mmtd($mma,$mmlw); if($mailman::mmas) { $mmlw =~ s/\015\012/\n/g; print {$mmel} $mmlw; $mmmt += length($mmlw); } } else { if($mmir) { my($mmmx) = '--' . $mmir . '--'; mmtd($mma,$mmmx); if($mailman::mmas) { print {$mmel} $mmmx; $mmmt += length($mmmx); } } } mmtd($mma,''); mmtd($mma,'.'); my $mmcd = <$mma>; unless($mmcd =~ /^250.+/) { mmtc('Send Error: ' . $mmcd, \$mmhw); } while($mmcd =~ /^\d\d\d\-/) { $mmcd = <$mma>; } mmtd($mma,"QUIT"); close $mma; if($mailman::mmlu) { close $mailman::mmlv; waitpid($mmly, 0); } if($mailman::mmas) { close($mmel); my($mmdx) = new FileHandle(); my($mmkz) = new FileHandle(); my($mmdy) = "${mmdc}/msglist"; retry: if(!open($mmdx,"+<$mmdy")) { if(!open($mmdx,"+>$mmdy")) { mmqr("Could not open message index for modification."); return; } print {$mmdx} "0 0\n"; seek($mmdx,0,0); } if(!open($mmkz,">$mmdy.tmp")) { mmqr("Could not create backup message index."); return; } flock($mmdx,2); if(<$mmdx> =~ /^(\d+)\s/) { $mailman::mmfb = $1; $mailman::mmfb++; print {$mmkz} "$mailman::mmfb 0\n"; } else { close($mmdx); close($mmkz); mmug($mmdc); goto retry; } while(defined($_ = <$mmdx>)) { print {$mmkz} $_; } my($mmej) = ''; $mmej .= mmtn( $mailman::mmm . '@' . $mailman::strIncomingServer . '@' . $mmmq) . '|'; $mmej .= mmtn($mailman::mmm) . '|'; $mmej .= mmtn($mailman::strIncomingServer) . '|'; $mmej .= mmtn($mailman::mmay) . '|'; $mmej .= mmtn($mailman::in{'CC'}) . '|'; $mmej .= mmtn($mmcm) . '|'; $mmej .= mmtn($mmcn) . '|'; $mmej .= mmtn(mmtu($mmcn)) . '|'; $mmej .= mmtn($mmcp) . '|'; $mmej .= mmtn($mmcm) . '|'; $mmej .= $mmmt . '|'; $mmej .= (($mmir eq '') ? 0 : 1) . '|'; $mmej .= (($mmir eq '') ? 0 : 1) . '|'; $mmej .= ''; print {$mmkz} $mmej . "\n"; close($mmdx); close($mmkz); use File::Copy; copy("$mmdy.tmp", $mmdy); $mailman::mmaf = $mmms; } my($mmbp) = ''; $mmbp = 't_sendconfirm.htm'; $mailman::mmbg{'USERNAME'} = $mailman::mmm; $mailman::mmbg{'USERNAMEHIDDEN'} = $mailman::mmn; $mailman::mmbg{'SERVER'} = $mailman::strIncomingServer; $mailman::mmbg{'SERVERHIDDEN'} = $mailman::mmq; $mailman::mmbg{'PASSWORDHIDDEN'} = $mailman::mmp; $mailman::mmbg{'CHECKSUM'} = $mailman::mmy; $mailman::mmbg{'SUBJECT'} = mmrj($mailman::in{'SUBJECT'}); $mailman::mmbg{'TO'} = mmrj($mailman::in{'TO'}); $mailman::mmbg{'OUTGOING'} = mmrj($mailman::strOutgoingServer); mmtk($mmbp,\%mailman::mmbg); exit(0); } sub mmtf { my($mmmy) = @_; my($mmmz) = mmtm($ENV{SERVER_NAME},42); my($mmna) = ''; if($mailman::bUseHijackTest) { $mmna = mmtm($ENV{REMOTE_HOST} . $ENV{REMOTE_ADDR},69); } unless($mmmz){ $mmmz = 'NO SERVER'; } unless($mmna){ $mmna = 'NO HOST'; } my($key) = $mmmz ^ $mmna; if(length($key)==$mmmy) { return($key); } elsif(length($key)>$mmmy) { return(substr($key,0,$mmmy)); } else { while(length($key)<$mmmy) { $key = "$key$key"; } return(substr($key,0,$mmmy)); } } sub mmtg { my($mmnb,$mmnc) = @_; my($mmnd) = ''; unless($mmnc->{'ME'}){ $mmnc->{'ME'} = $mailman::mmz; } while($mmnb =~ /MailMan\(([^\)]+)\)/) { $mmnd = $mmnc->{$1}; $mmnb =~ s/MailMan\($1\)/$mmnd/g; } return $mmnb; } sub mmth { my($mmek, $mmnc) = @_; print "Content-type: text/html\n\n"; if(defined($mmnc)) { my $mmc; foreach $mmc (sort keys %$mmnc) { print qq|\n|; } } if(-e $mmek) { print qq|MailMan: Template Can't Be Read\n| . qq|\n| . qq|

MailMan Configuration Error

\n| . qq|

The output template "$mmek" exists and was found by the MailMan\n| . qq|script, but the script does not have permission to read it.

\n| . qq|

On most Unix systems, you can go to the directory where MailMan is\n| . qq|installed and type "chmod 644 $mmek" to solve this problem. If\n| . qq|your HTTP server is running in a different operating in a different\n| . qq|operating system, consult your HTTP server and operating system \n| . qq|documentation for more information.

\n| . qq|\n|; exit(1); } else { print qq|MailMan: Template Not Found\n| . qq|\n| . qq|

MailMan Configuration Error

\n| . qq|

The output template "$mmek" could not be found by the MailMan \n| . qq|script.

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.

\n| . qq|\n|; exit(1); } } sub mmti { my($mmek,$mmne) = @_; my($mmju) = ''; my($mmnf) = new FileHandle(); if(defined($mailman::mmae)) { $mmek = $mailman::mmae . $mmek; } if(open($mmnf, "<" . $mailman::strLocalTemplateLocation . $mmek)) { my($mmng) = ''; while(defined($_ = <$mmnf>)) { $mmng .= $_; } close($mmnf); if($mmng =~ /MailManSnippet\($mmne\)\s*(.+)\s*EndSnippet\($mmne\)/si) { $mmju = $1; $mmju =~ s/^\s+(\S.*)$/$1/; $mmju =~ s/^(.*\S)\s+$/$1/; return $mmju; } } $mmju = qq|Template Error: Snippet "$mmne" not found in | . qq|template "$mmek"|; return $mmju; } sub mmtj { my($mmek,@mmnh) = @_; my(@mmni); my($mmnf) = new FileHandle(); if(defined($mailman::mmae)) { $mmek = $mailman::mmae . $mmek; } if(open($mmnf, "<" . $mailman::strLocalTemplateLocation . $mmek)) { my($mmng) = ''; while(defined($_ = <$mmnf>)) { $mmng .= $_; } close($mmnf); my($mmne) = ''; foreach $mmne (@mmnh) { if($mmng =~ /MailManSnippet\($mmne\)\s*(.+)\s*EndSnippet\($mmne\)/si) { my($mmju) = $1; $mmju =~ s/^\s+(\S.*)$/$1/; $mmju =~ s/^(.*\S)\s+$/$1/; push(@mmni,$1); } else { mmqr( qq|Template Error: Snippet "$mmne" not found in | . qq|template "$mmek"|); } } return @mmni; } } sub mmtk { my($mmek,$mmnc,$mmbo) = @_; my($mmnj) = 0; my($mmnf) = new FileHandle(); if(defined($mailman::mmae)) { $mmek = $mailman::mmae . $mmek; } unless($mmnc->{'ME'}){ $mmnc->{'ME'} = $mailman::mmz; } my($mmiy) = localtime(time); $mmnc->{'UNIQUE'} = mmtr($mmiy); $mmnc->{'EDITION'} = $mailman::strMailManEdition; $mmnc->{'VERSION'} = $mailman::strMailManVersion; if(open($mmnf, "<" . $mailman::strLocalTemplateLocation . $mmek)) { print "Content-type: text/html\n"; my($mmk) = ''; if(defined($mailman::mmn)) { $mmk .= 'USERNAME' . '#' . $mailman::mmn . '&'; } if(defined($mailman::mmq)) { $mmk .= 'SERVER' . '#' . $mailman::mmq . '&'; } if(defined($mailman::mmp)) { $mmk .= 'PASSWORD' . '#' . $mailman::mmp . '&'; } if(defined($mailman::mmy)) { $mmk .= 'CHECKSUM' . '#' . $mailman::mmy; } if(defined($mailman::mmm) && $mailman::mmm ne '') { print "Set-cookie: MailManAuth=$mmk;" . "$mailman::mmab\n"; } my($mmnk) = mmtn($mailman::mmaf); if($mailman::mmaf ne '') { print "Set-cookie: MailManDir=$mmnk;" . "$mailman::mmab\n"; } if(defined($mailman::mmn)) { $mmnc->{'AUTHENTICATION'} = qq||; } if(defined($mailman::mmq)) { $mmnc->{'AUTHENTICATION'} .= qq||; } if(defined($mailman::mmp)) { $mmnc->{'AUTHENTICATION'} .= qq||; } if(defined($mailman::mmy)) { $mmnc->{'AUTHENTICATION'} .= qq||; } $mmnc->{'SETTINGS'} = ''; my($mmnl) = mmtn($mailman::mmaf); $mmnc->{'SETTINGS'} .= qq||; if($mailman::mmac) { $mmnc->{'SETTINGS'} .= qq||; } if($mailman::mmad) { $mmnc->{'SETTINGS'} .= qq||; } if(defined($mailman::mmae)) { $mmnc->{'SETTINGS'} .= qq||; } if($mailman::mmlp) { my($mmnm) = mmtn($mailman::mmlp); $mmnc->{'SETTINGS'} .= qq||; } my($mmb) = 0; my($mmnn) = ''; my($mmah) = ''; foreach $mmah (keys(%mailman::in)) { if($mmah ne 'USERNAME' && $mmah ne 'SERVER' && $mmah ne 'PASSWORD' && $mmah ne 'CHECKSUM' && $mmah ne 'SEND' && $mmah ne 'TEXT' && $mmah ne 'ATTACH' && $mmah !~ /^FOLDER/ && $mmah !~ /^PREF\_/ && $mmah !~ /^ADDRESSITEM\_/ && $mmah !~ /USERFILE/) { $mmnn .= $mmah . '#' . $mailman::in{$mmah} . '&'; } } chop($mmnn); if($mailman::mmac) { print "Set-cookie: MailManCmds=$mmnn; " . "path=$mailman::mmaa;\n"; } if($mailman::mmad) { print "Expires: Sun, 03 May 1998 16:00:00 GMT\n"; print "Cache-control: no-cache\n"; } print "\n"; if(defined($mailman::strDebug) && ($mmek !~ /t\_f\_frameset/)) { print qq|
\n| . qq|\n | . qq|\n| . qq|
\n| . qq|DEBUG OUTPUT
\n| . qq|
$mailman::strDebug
| . qq|
\n| . qq|
\n|; } while(defined($_ = <$mmnf>)) { while(/\<\!\-\-\s*MMPRO/i) { s/\<\!\-\-\s*MMPRO//ig; } while(/MMPRO\s*\-\-\>/i) { s/MMPRO\s*\-\-\>//ig; } while(!$mailman::bKioskMode && /\<\!\-\-\s*NOKIOSKMODE/i) { s/\<\!\-\-\s*NOKIOSKMODE//ig; } while(!$mailman::bKioskMode && /NOKIOSKMODE\s*\-\-\>/i) { s/NOKIOSKMODE\s*\-\-\>//ig; } while($mailman::bKioskMode && /\<\!\-\-\s*KIOSKMODE/i) { s/\<\!\-\-\s*KIOSKMODE//ig; } while($mailman::bKioskMode && /\bKIOSKMODE\s*\-\-\>/i) { s/\bKIOSKMODE\s*\-\-\>//ig; } while(/MailMan\(([^\)]+)\)/i) { my($mmno) = ''; $mmno = $mmnc->{$1}; if(($1 eq 'TO') or ($1 eq 'SUBJECT') or ($1 eq 'CC')) { $mmno =~ s/\"/\"\;/g; } if(defined($mmno)) { s/MailMan\($1\)/$mmno/ig; } else { s/MailMan\($1\)//ig; } } if(defined($mailman::strURLImageLocation)) { s/([\"\`\'])(i\_[^\.]+\.gif[\"\'])/$1${mailman::strURLImageLocation}$2/ig; } print; $mmnj = 1; } close($mmnf); } else { mmth($mmek, $mmnc); } unless($mmbo) { exit(0); } } sub mmtl { $mailman::mmr = "316361365359288371370355317290360372372368314303303375375375302357366" . "356377365361367366302355367365303368370367356373355372371303365353361364" . "365353366303365365368370367307351304351304302359361358290288353364372317" . "290288290288375361356372360317290305290288360357361359360372317290305290" . "288353364361359366317290364357358372290318"; $mailman::mmr = pack('C109',grep($_ && ($_ -= 256),split(/(\d\d\d)/, $mailman::mmr))); $mailman::mmnp = "Unix"; if((defined $^O and $^O =~ /MSWin32/i || $^O =~ /Windows_95/i || $^O =~ /Windows_NT/i) || (defined $ENV{OS} and $ENV{OS} =~ /MSWin32/i || $ENV{OS} =~ /Windows_95/i || $ENV{OS} =~ /Windows_NT/i)) { $mailman::mmnp = "Windows"; $| = 1; $mailman::mmdm = 1; } if((defined $^O and $^O =~ /MacOS/i) || (defined $ENV{OS} and $ENV{OS} =~ /MacOS/i)) { $mailman::mmnp = "Mac" } if (defined $^O and $^O =~ /VMS/i) { $mailman::mmnp = "VMS"; } if($mailman::mmnp eq 'Unix') { } elsif($mailman::mmnp eq 'Mac') { } elsif($mailman::mmnp eq 'NT') { } } sub mmtm { my($mmnq,$mmnr) = @_; if($mailman::bUseCrypt) { return crypt($mmnq,$mmnr); } else { return $mmnq; } } sub mmtn { my($mmnb) = shift; $mmnb =~ s/(\W)/sprintf("%%%02x", ord($1))/eg; return $mmnb; } sub mmto { my($mmnb) = shift; $mmnb =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; return $mmnb; } sub mmtp { my($mmnb) = @_; $mmnb =~ s/([^A-Za-z0-9 ])/\\$1/g; return($mmnb); } sub mmtq { my($mmns) = $ENV{'HTTP_USER_AGENT'}; $_ = $mmns; if(/(MSIE)\D*(\d+)\.?(\d*)\D?/i) { return ($1,$2,$3); } elsif(/(Mozilla)\D*(\d+)\.?(\d*)\D?/i) { return ($1,$2,$3); } } sub mmtr { my($mmnq) = @_; local $^W = 0; unless(defined($mmnq)){ return; } my($key) = mmtf(length($mmnq)); my($mmnt) = $mmnq ^ $key; $mmnt = pack("u*",$mmnt); chop($mmnt); $mmnt =~ s/(\W)/sprintf("%%%x", ord($1))/eg; @mailman::mmg = split(/X*/,'!dnoh>0Epe9o86l.7w:ab5y<4Mm3i5C/gfr1-cs2"t \;Tu,v'); $mailman::mmh = join('',@mailman::mmg[ 8,34,28,2,41,42,40,23,0,36,36,42,45,4,28,38,42, 8,19,32,9,42,17,19,38,42,8,34,11,1,46,37,9,1,42, 20,22,42,25,19,28,14,25,19,2,42,48,27,8,47,42, 33,34,11,26,42,7,2,1,22,26,28,11,2,42,30,11,34, 8,11,34,19,41,28,11,2,15,42,36,36,5,43,2,40,44]); return "%%%%$mmnt%%%%"; } sub mmts { my($mmnt) = @_; unless(defined($mmnt)){ return; } if($mmnt =~ /\%\%\%\%(.+)\%\%\%\%/) { $mmnt = $1; } else { return $mmnt; } $mmnt =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $mmnt = unpack("u*",$mmnt); my($key) = mmtf(length($mmnt)); my($mmnq) = $mmnt ^ $key; return $mmnq; } sub mmtt { my($mmax,$mmnu) = @_; unless(chmod($mmnu, $mmax)) { mmqr("Could not change the permissions of " . "\"$mmax\" for unknown reasons."); } } sub mmtu { my($mmcn) = shift; mmtw(); my($mmnv,$mmnw,$mmnx) = (60, 60, 24); my($mmny) = ($mmnw * $mmnv); my($mmnz) = ($mmnx * $mmnw * $mmnv); my($mmoa) = [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]; if($mmcn =~ / \s* (\S+\,?\s+)? ($mailman::mmob)\s+ (\d+)\s+ (\d\d?)\:(\d\d?)\:(\d\d?)\s+ (\S+)\s+ (\d{2}|\d{4})\s+ \s* /xi) { $mmcn = "$1 $3 $2 $8 $4:$5:$6 $7"; } my($mmev) = 0; if($mmcn =~ / \s* (\S+\,?\s+)? (\d+)\s+ ($mailman::mmob)\s+ (\d{2}|\d{4})\s+ (\d\d?)\:(\d\d?)\:(\d\d?)\s+ (.*) \s* /xi) { my($mmoc) = $4; my($mmod) = $mailman::mmoe{lc($3)}; my($mmof) = $2; my($mmog,$mmoh,$mmoi) = ($5, $6, $7); my($mmoj) = $8; if(length($mmoc) == 2) { $mmoc = mmui($mmoc); } my($mmok) = 0; for($mmok = 1996; $mmok < $mmoc; $mmok++) { if(mmtv($mmok)) { $mmev += (366 * $mmnz); } else { $mmev += (365 * $mmnz); } } my($mmol) = 0; for($mmol = 0; $mmol < $mmod; $mmol++) { my($mmom) = $mmoa->[$mmol]; if(($mmol == 1) && mmtv($mmoc)) { $mmom = 29; } $mmev += $mmom * $mmnz; } $mmev += ($mmof -1) * $mmnz; $mmev += ($mmog - 1) * $mmny; if($mmoj =~ /([\+\-]\d\d\d\d)/) { $mmoj = $1; } elsif($mmoj =~ /($mailman::mmon)/i) { $mmoj = $mailman::mmoo{lc($1)}; } else { $mmoj = '+0000'; } if($mmoj =~ /^\-(\d\d)/) { $mmev += $1 * $mmny; } elsif($mmoj =~ /^\+(\d\d)/) { $mmev -= $1 * $mmny; } $mmev += $mmoh * $mmnv; $mmev += $mmoi; return $mmev; } return (-1); } sub mmtv { my($mmoc) = @_; return 0 unless $mmoc % 4 == 0; return 1 unless $mmoc % 100 == 0; return 0 unless $mmoc % 400 == 0; return 1; } sub mmtw { return if ($mailman::mmop); $mailman::mmop = 1; my($mmoq) = [['january','february','march','april','may','june','july', 'august','september','october','november','december'], ['jan','feb','mar','apr','may','jun','jul','aug','sep', 'oct','nov','dec'], ['','','','','','','','','sept']]; mmtx('inorder', $mmoq, \%mailman::mmoe, \$mailman::mmob); my($mmor) = [[ 'idlw' => '-1200', 'nt' => '-1100', 'hst' => '-1000', 'cat' => '-1000', 'ahst' => '-1000', 'yst' => '-0900', 'hdt' => '-0900', 'ydt' => '-0800', 'pst' => '-0800', 'pdt' => '-0700', 'mst' => '-0700', 'mdt' => '-0600', 'cst' => '-0600', 'cdt' => '-0500', 'est' => '-0500', 'edt' => '-0400', 'ast' => '-0400', 'nft' => '-0330', 'adt' => '-0300', 'ndt' => '-0230', 'at' => '-0200', 'wat' => '-0100', 'gmt' => '+0000', 'ut' => '+0000', 'utc' => '+0000', 'wet' => '+0000', 'cet' => '+0100', 'fwt' => '+0100', 'met' => '+0100', 'mewt' => '+0100', 'swt' => '+0100', 'bst' => '+0100', 'gb' => '+0100', 'eet' => '+0200', 'cest' => '+0200', 'fst' => '+0200', 'mest' => '+0200', 'metdst'=> '+0200', 'sst' => '+0200', 'bt' => '+0300', 'eest' => '+0300', 'eetedt'=> '+0300', 'it' => '+0330', 'zp4' => '+0400', 'zp5' => '+0500', 'ist' => '+0530', 'zp6' => '+0600', 'nst' => '+0630', 'hkt' => '+0800', 'sgt' => '+0800', 'cct' => '+0800', 'awst' => '+0800', 'wst' => '+0800', 'kst' => '+0900', 'jst' => '+0900', 'rok' => '+0900', 'cast' => '+0930', 'east' => '+1000', 'gst' => '+1000', 'cadt' => '+1030', 'eadt' => '+1100', 'idle' => '+1200', 'nzst' => '+1200', 'nzt' => '+1200', 'nzdt' => '+1300', 'z' => '+0000', 'a' => '-0100', 'b' => '-0200', 'c' => '-0300', 'd' => '-0400', 'e' => '-0500', 'f' => '-0600', 'g' => '-0700', 'h' => '-0800', 'i' => '-0900', 'k' => '-1000', 'l' => '-1100', 'm' => '-1200', 'n' => '+0100', 'o' => '+0200', 'p' => '+0300', 'q' => '+0400', 'r' => '+0500', 's' => '+0600', 't' => '+0700', 'u' => '+0800', 'v' => '+0900', 'w' => '+1000', 'x' => '+1100', 'y' => '+1200' ]]; mmtx('', $mmor, \%mailman::mmoo, \$mailman::mmon); } sub mmtx { my($mmos,$mmot,$mmou,$mmov) = @_; my($mmow,$mmox,$mmoy,@mmoz) = (); for($mmow = 0; $mmow <= $#{$mmot}; $mmow++) { for($mmox = 0; $mmox <= $#{$mmot->[$mmow]}; $mmox++) { $mmoy = $mmot->[$mmow]->[$mmox]; if($mmoy ne '') { if($mmos =~ /inorder/) { %{$mmou}->{$mmoy} = $mmox; } else { my($mmpa) = $mmot->[$mmow]->[++$mmox]; %{$mmou}->{$mmoy} = $mmpa; } push(@mmoz,$mmoy); } } } $$mmov = join('|', @mmoz); } sub mmty { my(@mmpb,@mmpc,@mmpd); opendir(USERDIR, $mailman::mmt); my(@mmaw) = readdir(USERDIR); closedir(USERDIR); my($mmax) = ''; foreach $mmax (@mmaw) { if($mmax ne '.' && $mmax ne '..' && (-d "${mailman::mmt}/${mmax}")) { if($mmax =~ /^INBOX$/i || $mmax =~ /^SENT$/i || $mmax =~ /^TRASH$/i) { push(@mmpc,mmto($mmax)); } else { push(@mmpd,mmto($mmax)); } } } @mmpc = sort(@mmpc); @mmpd = sort(@mmpd); @mmpb = (@mmpc, @mmpd); return(@mmpb); } sub mmtz { my($mmfn) = shift; my($mmdc) = $mailman::mmt . '/' . mmtn($mmfn); my($mmdy) = "${mmdc}/msglist"; if(open(MESSAGEINDEX,"<$mmdy")) { flock(MESSAGEINDEX,2); my($mmbx) = ''; $mmbx = ; if($mmbx =~ /^(\d+)\s+(\d+)\s/) { return($1,$2); } if($mmbx =~ /^(\d+)/) { return($1,'?'); } close(MESSAGEINDEX); } return(0,0); } sub mmua { my($mmpe) = @_; unless(defined($mmpe)) { $mmpe = ''; } my($mmcd) = ''; my(@mmfl) = mmty(); unless(defined($mmpe) && length($mmpe)) { $mmcd .= "