#!/usr/bin/perl # 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 server then you probably do not need to modify # this line because it will most likely be ignored. ############################################################################ # MailMan, Standard Edition, version 3.0.2 # # Copyright (c) 1996, 1997, 1998, Endymion Corporation. All rights reserved. # Endymion Corporation: http://www.endymion.com/ # Originally by Ryan Alyn Porter, rap@endymion.com # # 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: 4/24/1998 Version 2.0 beta # Released: 7/20/1998 Version 2.0 # Last Modified: 12/17/1998 Version 3.0.2 ############################################################################ #use strict; # Version information that might find its way into output. $strMailManVersion = 'v3.0.2'; $strMailManEdition = 'Standard Edition'; # 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. A version of the FAQ should also have been # in the distribution that contained this file. ############################################################################ # This section contains a few variables that you might need to set in order # to get MailMan functioning properly. If your installation is working, # then you don't need to worry about any of these. ############################################################################ # Outgoing Banner Text # This is the banner that is appended to the end of any message that # this MailMan installation sends. One reason why this is one of the # first configuration options is because we want to make it very # obvious that you can remove or modify this banner. Endymion places # no restrictions at all on this banner, so don't worry about leaving # credit to us in here or anything like that. Please feel free to # change this to whatever you like, or completely remove it. If this # value is not defined then it will simply append no banner. $strOutgoingBannerText = "\n" . "---------------------------------------------\n" . "This message was sent using Endymion MailMan.\n" . "http://www.endymion.com/products/mailman/\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. #$strIncomingServer = 'mail.endymion.com'; # Outgoing Mail Server: # Same deal, different server. #$strOutgoingServer = 'mail.endymion.com'; # From Domain Name: # Set this variable to override the domain name that is assumed when a # user logs in. For instance, when the user "rap" logs into the POP3 # server "mail5.it.endymion.com", MailMan will assume that his address # is "rap@mail5.it.endymion.com". If you set this variable to # "endymion.com", then it will assume that his address is # "rap@endymion.com" instead. If the mapping between POP3 user names # and email addresses is more complicated then you will need to actually # build your own routines to do the mapping. For instance, if the user # "endy-rap" at the POP3 server "shell1.ba.best.com" actually receives # mail at the address "rap@endymion.com", then you will need to do make # your own custom mapping routine to deal with this. #$strFromDomainName = "endymion.com"; # 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. #$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. $iMessagesPerPage = 10; # 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: #$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. $strLocalScriptLocation = $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 #$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. #$bUseAlarm = TRUE; # 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 $bUseAlarm is set to TRUE. $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. #$bUseCrypt = TRUE; # 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. #$bUseHijackTest = TRUE; # 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. #$bKioskMode = TRUE; ############################################################################ # You should not have to configure any values after this line. ############################################################################ use Socket; require $strLocalScriptLocation . 'mmcgilib.pl'; local(%mma, %mmb, %mmc, %mmd); ReadParse(\%mma,\%mmb,\%mmc,\%mmd); foreach $mme (keys %mma) { if($mme =~ /^(.+)\.[xy]$/) { if($mme =~ /^([^\#]+)\#(.*)\.[xy]$/) { $mma{$1} = mmie($2); } else { $mma{$1} = 'MAILMANSPECIALTRUE'; } delete($mma{$mme}); } } if($mma{'INTERFACE'}) { @mmf = split(/\&/,$mma{'INTERFACE'}); foreach $mmg (@mmf) { if($mmg =~ /^([^\=]+)\=(.*)$/) { $mma{$1} = mmie($2); } } unless($mma{'INTERFACE'} =~ /ALTERNATE_TEMPLATES/) { $mma{'ALTERNATE_TEMPLATES'} = ''; } } @mmh = split(/\;/,$ENV{'HTTP_COOKIE'}); foreach $mmi (@mmh) { $mmj = TRUE; if($mmi =~ /MailManAuth\=(\S+)/) { @mmk = split(/\&/,$1); foreach $mml (@mmk) { $mml =~ /^(.+)\#(.+)$/; unless($mma{$1}){ $mma{$1} = $2; } } } } $mmm = mmii($mma{'USERNAME'}); $mmn = mmih($mmm); $mmo = mmii($mma{'PASSWORD'}); $mmp = mmih($mmo); unless($strIncomingServer){ $strIncomingServer = mmii($mma{'SERVER'}); } $mmq = mmih($strIncomingServer); unless($strOutgoingServer){ $strOutgoingServer = $mma{'OUTGOING'}; } $mmr = ''; $mms = mmic($ENV{SERVER_NAME},42); $mms .= mmic($ENV{REMOTE_HOST} . $ENV{REMOTE_ADDR},69); $mmt = mmih($mms); mmib(); $mmu = $ENV{SCRIPT_NAME}; unless($mmu =~ /^\//){ $mmu = "/$mmu"; } $mmv = $mmu; $mmv =~ s/^(.*[\\\/])[^\\\/]+$/$1/; if($mmv eq '/') { $mmw = ''; } else { $mmw = "path=$mmv; "; } sub mmgs { if($mma{'NOFRAMES'}) { $mmx = TRUE; } if($mma{'NOCACHE'}) { $mmy = TRUE; } if(defined($mma{'ALTERNATE_TEMPLATES'})) { $mmz = $mma{'ALTERNATE_TEMPLATES'}; } } sub mmgt { my($mmaa) = @_; foreach $mme (keys %mma) { if($mme =~ /^$mmaa\:(.*)$/) { $mmab = $1; return $mmab; } } return; } mmgs(); mmgu(); @mmh = split(/\;/,$ENV{'HTTP_COOKIE'}); foreach $mmi (@mmh) { if($mmi =~ /MailManCmds\=(\S+)/) { @mmac = split(/\&/,$1); foreach $mmad (@mmac) { $mmad =~ /^(.+)\#(.+)$/; unless($mma{$1}){ $mma{$1} = $2; } } } } mmgs(); mmgu(); mmgw(); sub mmgu { if($mma{'BLANK'}) { mmia('t_blank.htm'); } if($mma{'MENU'}) { mmia('t_f_menu.htm'); } if($mma{'LOGOUT'}) { if($bKioskMode) { mmia('t_closewindow.htm'); } else { mmgw(); } } if($mma{'START'}) { mmgw(); } if($mma{'LOGIN'}) { if($mmae = mmgy()) { if(defined($mmaf)) { $mmaf =~ s/^\-ERR(.*)$/$1/; } $bKioskMode = 0; $mmag{'GREETING'} = "
Log In Error: $mmae
"; mmia('t_login.htm',\%mmag); } if($mmx eq TRUE) { mmhe(); } else { mmia('t_f_frameset.htm'); } } if($bUseHijackTest && $mma{'CHECKSUM'} && $mma{'CHECKSUM'} ne '') { if(mmii($mma{'CHECKSUM'}) ne $mms) { mmgv( 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($mmab =~ mmgt('LIST')) { mmhe($mmab); } if($mma{'LIST'}) { mmhe(); } if($mmah = $mma{'BACKGROUND'}) { if($mmx) { print("Location: $mmah\n\n"); exit(0); } else { mmhd($mmah); } } if($mmah = $mma{'BACKGROUNDFRAME'}) { mmia('t_backgroundframe.htm'); } if($mmab = mmgt('SHOW')) { if($mmab =~ /^(.+)mimepart\:(.+)$/) { $mmai = $1; $mmaj = $2; $mmaj =~ s/%(..)/pack("c",hex($1))/ge; } else { $mmai = $mmab; } $mmai = mmie($mmai); mmhn($mmai,0); } if($mmab = mmgt('SOURCE')) { $mmai = mmie($mmab); mmho($mmai); } if($mmab = mmgt('PREV')) { $mmai = mmie($mmab); mmhn($mmai,-1); } if($mmab = mmgt('NEXT')) { $mmai = mmie($mmab); mmhn($mmai,1); } if($mmab = mmgt('DELETE')) { if($mmae = mmgy()) { mmgv($mmae); } $mmai = mmie($mmab); mmhq($mmai); mmgx(\*SOCKET,"QUIT"); close SOCKET; $mmak = 0; mmhe(); } if($mma{'DELETEMARKED'}) { if($mmae = mmgy()) { mmgv($mmae); } foreach $mme (keys %mma) { if($mme =~ /^MARK\:(.*)$/) { $mmai = mmie($1); mmhq($mmai); } } mmgx(\*SOCKET,"QUIT"); close SOCKET; $mmak = 0; if($mmx eq TRUE) { mmhe(); } else { mmia('t_f_frameset.htm'); } } if($mmab = mmgt('MOVE')) { my($mmal) = $mma{'FOLDERTRANSFERLIST'}; if($mmal eq 'MAILMANSPECIALSELECT' || $mmal eq '') { mmhe(); } if($mmae = mmgy()) { mmgv($mmae); } $mmai = mmie($mmab); if(CopyMessageToFolder($mmai,$mmal)) { RemoveMessageFromFolder($mmai,'MOVED'); } mmgx(\*SOCKET,"QUIT"); close SOCKET; $mmak = 0; if($mmx eq TRUE) { mmhe(); } else { mmia('t_f_frameset.htm'); } } if($mma{'MOVEMARKED'}) { my($mmal) = $mma{'FOLDERTRANSFERLIST'}; if($mmal eq 'MAILMANSPECIALSELECT' || $mmal eq '') { mmhe(); } if($mmae = mmgy()) { mmgv($mmae); } foreach $mme (keys %mma) { if($mme =~ /^MARK\:(.*)$/) { $mmai = mmie($1); if(CopyMessageToFolder($mmai,$mmal)) { RemoveMessageFromFolder($mmai,'MOVED'); } } } mmgx(\*SOCKET,"QUIT"); close SOCKET; $mmak = 0; if($mmx eq TRUE) { mmhe(); } else { mmia('t_f_frameset.htm'); } } if($mma{'NEW'}) { mmhr("NEW",0,0); } if($mmab = mmgt('REPLY')) { $mmai = mmie($mmab); mmhr($mmai,0,0); } if($mmab = mmgt('REPLYALL')) { $mmai = mmie($mmab); mmhr($mmai,TRUE,0); } if($mmab = mmgt('FORWARD')) { $mmai = mmie($mmab); mmhr($mmai,0,TRUE); } if($mma{'SEND'}) { mmhu(); } if($mma{'HELP'}) { mmia('t_help.htm'); } } sub mmgv { my($mmaf) = @_; $mmaf =~ s/^\-ERR(.*)$/$1/; if($mmaf eq "ALRM") { if($bUseAlarm eq TRUE){ alarm(0); } $mmaf = $mmam; mmgx(\*SOCKET,"QUIT"); close SOCKET; } if($mmx) { $mman = 't_nf_error.htm'; } else { $mman = 't_f_error.htm'; } my(%mmag); $mmag{'ERROR'} = $mmaf; mmia($mman,\%mmag); exit(1); } sub mmgw { print "Set-cookie: MailManAuth=;$mmw" . "expires=Sun, 03-May-1998 16:00:00 GMT\n"; print "Set-cookie: MailManCmds=;$mmw" . "expires=Sun, 03-May-1998 16:00:00 GMT\n"; print "Set-cookie: MailManDir=;$mmw" . "expires=Sun, 03-May-1998 16:00:00 GMT\n"; print "Expires: Sun, 03 May 1998 16:00:00 GMT\n"; $mmm = ''; $mmao = ''; if($bKioskMode) { ($mmag{'GREETING'},$mmap) = mmhz('t_login.htm', ('GREETING','KIOSKMODESCRIPT')); $mmag{'HTMLCOMMENTBEGIN'} = ''; $mmag{'KIOSKMODESCRIPT'} = mmhw($mmap,\%mmag); $mmag{'HTMLCOMMENTBEGIN'} = ''; $mmag{'HTMLCOMMENTEND'} = ''; } else { $mmag{'GREETING'} = mmhy('t_login.htm','GREETING'); } mmia('t_login.htm',\%mmag); } sub mmgx { my($mmaq) = "\015\012"; my($mmar, $mmas) = @_; my($mmat) = length($mmas . $mmaq); syswrite($mmar,$mmas . $mmaq,$mmat); } sub mmgy { if($mmak){ return; } my($mmau); unless($mmm) { if(!$mmx && !$mmj) { mmgv("In order for the frames version of MailMan " . "to function properly, your web browser must have " . "\"cookies\" enabled. Either your browser has " . "cookies disabled or cookie information has " . "been filtered. In order to use MailMan you " . "will either need to enable cookies in your " . "web browser or back up and use the non-frames " . "version of MailMan."); } else { return("No login provided, cannot proceed."); } } unless($mmo) { return("No password provided, cannot proceed."); } unless($strIncomingServer) { return("No server provided, cannot proceed."); } retrylogin: if($bUseAlarm eq TRUE) { $mmam = "Connection to server timed out."; $SIG{'ALRM'} = \&mmgv; alarm($iTimeoutDurationInSeconds); } $mmav = getprotobyname('tcp'); socket(SOCKET,PF_INET,SOCK_STREAM,$mmav); $mmaw = gethostbyname($strIncomingServer); unless($mmaw) { return("Could not find an IP address for the host " . "\"$strIncomingServer\"."); } $mmax = sockaddr_in(110, $mmaw); unless(connect(SOCKET, $mmax)) { return("Could not connect to server \"$strIncomingServer\", \"$!\""); } select(SOCKET); $|=1; select(STDOUT); binmode(SOCKET); $mmam = "The server connected, but will not respond."; if($bUseAlarm eq TRUE){ alarm(180); } unless( =~ /\+OK/) { return("The server does not respond appropriately."); } $mmam = "The server timed out during login."; if($bUseAlarm eq TRUE){ alarm(180); } mmgx(\*SOCKET,"USER $mmm"); $mmay = ; unless($mmay =~ /\+OK/) { return($mmay); } mmgx(\*SOCKET,"PASS $mmo"); $mmay = ; unless($mmay =~ /\+OK/) { if((($mmay =~ /another session/i) || ($mmay =~ /another POP3 session/i)) && $mmau < 12) { mmgx(\*SOCKET,"QUIT"); close SOCKET; $mmau++; sleep(5); goto retrylogin; } return($mmay); } mmgx(\*SOCKET,'STAT'); $mmay = ; $mmay =~ /^\+OK\s+(\d+)\s+/i; $mmaz = $1; if($mmaz == 0) { $mmak = TRUE; return; } mmgx(\*SOCKET,"LIST"); $mmay = ; unless($mmay =~ /\+OK/) { return($mmay); } $mmaz = 0; while( =~ /(\d+) (\d+)/) { $mmba[$1] = $2; $mmaz++; } $mmak = TRUE; return; } sub mmgz { my($mmbb) = @_; $mmam = "The server timed out fetching a header."; if($bUseAlarm eq TRUE){ alarm(10); } mmgx(\*SOCKET,"TOP $mmbb 0"); $mmay = ; unless($mmay =~ /\+OK/) { mmgv($mmay); } mmha(\*SOCKET); $mmbc = $mmbb . 'H' . $mmbd; $mmbe = $mmbb; } sub mmha { my($mmar) = shift; $mmbf = ''; $mmbg = ''; $mmbh = ''; $mmbi = ''; $mmbj = ''; $mmbk = ''; $mmbd = ''; $mmbl = 0; $mmbm = 0; my($mmbn) = 0; my($mmbo) = 0; my($mmbp) = 0; my($mmbq) = TRUE; while(defined($_ = <$mmar>)) { if(/^[\r\n]+$/){ $mmbn=TRUE; } if(/^\.[\r\n]*$/){ last; } if(/^Content-type\:\s+([^\;\s]+)[\;\s]/i) { my($mmbr) = $1; if( ($mmbr !~ /multipart\/alternative/i) && ($mmbr !~ /text\//i)) { $mmbm = TRUE; } } if(/^begin \d\d\d (\S+)\s*$/i) { $mmbm = TRUE; } unless($mmbn) { $mmbq = TRUE; if(/^To\: (.+)$/i || ((/^\s(.+)$/) && $mmbo)) { $mmbf .= $1; $mmbf =~ s/^(.*)[\r\n]+$/$1/; $mmbs .= $_; $mmbo = TRUE; $mmbp = 0; $mmbq = 0; } if(/^CC\: (.+)$/i || ((/^\s(.+)$/) && $mmbp)) { $mmbg .= $1; $mmbg =~ s/^(.*)[\r\n]+$/$1/; $mmbs .= $_; $mmbo = 0; $mmbp = TRUE; $mmbq = 0; } if(/^From\: (.+)$/i) { $mmbh = $1; $mmbh =~ s/^(.*)[\r\n]+$/$1/; $mmbs .= $_; } if(/^Date\: (.+)$/i) { $mmbi = $1; $mmbi =~ s/^(.*)[\r\n]+$/$1/; $mmbs .= $_; } if(/^Subject\: (.+)$/i) { $mmbj = $1; $mmbj =~ s/^(.*)[\r\n]+$/$1/; $mmbs .= $_; } if(/^Reply-To\: (.+)$/i) { $mmbk = $1; $mmbk =~ s/^(.*)[\r\n]+$/$1/; $mmbs .= $_; } if(/^Message-ID\: (.+)$/i) { $mmbd = $1; $mmbd =~ s/^(.*)[\r\n]+$/$1/; } if($mmbq) { $mmbo = 0; $mmbp = 0; } } if(/^MIME-Version\: 1\.0/i) { if(!$mmbn) { $mmbl = TRUE; } } } if($mmbd eq "") { $mmbd = $mmbs; while(length($mmbd)>20) { $mmbd = (substr($mmbd,0,20) ^ substr($mmbd,20)); } $mmbd = pack("u*",$mmbd); } $mmbd =~ s/(\W)/sprintf("%%%x", ord($1))/eg; unless($mmbf){ $mmbf = "Unknown";} unless($mmbh){ $mmbh = "Unknown";} unless($mmbi){ $mmbi = "Unknown";} unless($mmbj){ $mmbj = "Unspecified";} unless($mmbc){ $mmbc = "0";} $mmbt = mmhc($mmbf); $mmbu = mmhc($mmbh); $mmbv = mmhc($mmbg); $mmbw = mmhc($mmbj); $mmbx = mmhc($mmbi); } sub mmhb { my($mmai) = @_; $mmai =~ /^(\d+)H(.+)$/; $mmby = $1; $mmbz = $2; if($1 eq '' || $2 eq '') { mmgv('The message ID string "' . $mmai . '" is badly formed.'); } $mmbz =~ s/%(..)/pack("c",hex($1))/ge; $mmam = "The server timed out during message listing."; if($bUseAlarm eq TRUE){ alarm(180); } mmgx(\*SOCKET,"LIST"); $mmay = ; unless($mmay =~ /\+OK/) { mmgv($mmay); } $mmca = 0; while( =~ /(\d+) (\d+)/) { $mmba[$1] = $2; $mmca++; } $mmcb = $mmby; while($mmcb>0) { mmgz($mmcb); $mmbd =~ s/%(..)/pack("c",hex($1))/ge; if($mmbd eq $mmbz) { $mmcc = TRUE; last; } $mmcb--; } if(!$mmcc) { $mmbf = ''; $mmcb = $mmby; mmgz($mmcb); } if($mmbf eq '') { mmgv('Could not find the specified message.'); } return ($mmcb); } sub mmhc { my($mmcd) = @_; $mmcd =~ s/\&/\&\;/g; $mmcd =~ s/\/\>\;/g; $mmcd =~ s/\%mmce/\/g; $mmcd =~ s/(http\:\S+)\s/"\$1\<\/a\>"/eg; if($mmx) { $mmcd =~ s/(href\=\"[^\"]*)(BACKGROUND\=)/${1}NOFRAMES\=TRUE&$2/g; } return $mmcd; } sub mmhd { my($mmcg) = shift; $mmag{'URL'} = $mmcg; mmia('t_backgroundframeset.htm',\%mmag); } sub mmhe { my($mmch) = @_; if($mmx) { $mman = 't_nf_messagelist.htm'; } else { $mman = 't_f_messagelist.htm'; } ($mmci, $mmcj, $mmck) = mmhz($mman, ('MESSAGE_EVEN','MESSAGE_ODD','ATTACHMENT_IMAGE')); if($mmae = mmgy()) { mmgv($mmae); } my(%mmag); $mmag{'USERNAME'} = $mmm; $mmag{'USERNAMEHIDDEN'} = $mmn; $mmag{'SERVERHIDDEN'} = $mmq; $mmag{'PASSWORDHIDDEN'} = $mmp; $mmag{'CHECKSUM'} = $mmt; $mmag{'NUM'} = $mmaz; if(defined($strFromDomainName)) { $mmag{'SERVER'} = $strFromDomainName; } else { $mmag{'SERVER'} = $strIncomingServer; } if($mmaz > 0) { $mmam = "The server timed out during message listing."; if($bUseAlarm eq TRUE){ alarm(180); } mmgx(\*SOCKET,"LIST"); $mmay = ; unless($mmay =~ /\+OK/) { mmgv($mmay); } $mmaz = 0; while( =~ /(\d+) (\d+)/) { $mmba[$1] = $2; $mmaz++; } } if($mmaz > 0) { if($mmch == 0) { $mmch = $mmaz; } my($mmcl); if($mmaz > 1) { for($mmcm=$mmaz;$mmcm>0;$mmcm-=$iMessagesPerPage) { $mmcn = $mmcm; $mmco = $mmcm-$iMessagesPerPage+1; if($mmco<1) { $mmco = 1; } if($mmch <= $mmcn && $mmch >= $mmco) { $mmcl = TRUE; $mmcp = $mmcn; $mmcq = $mmco; } else { $mmcl = 0; } if($mmcn == $mmco) { $mmcr = "$mmcn"; } else { $mmcr = "$mmcn-$mmco"; } if($mmx) { if($mmcl) { $mmag{'PAGELINKS'} .= "[$mmcr] "; } else { $mmag{'PAGELINKS'} .= qq||; } } else { if($mmcl) { $mmag{'PAGELINKS'} .= "[$mmcr] "; } else { $mmag{'PAGELINKS'} .= qq|| . qq|[$mmcr] |; } } } } else { $mmag{'PAGELINKS'} = ''; $mmcp = 1; $mmcq = 1; } } if($mmaz > 0) { $mmag{'MESSAGELIST'} = ''; for($mmcm=$mmcp;$mmcm>=$mmcq;$mmcm--) { mmgz($mmcm); $mmag{'FROM'} = $mmbu; $mmag{'TO'} = $mmbt; $mmag{'SUBJECT'} = $mmbw; $mmag{'DATE'} = $mmbx; $mmag{'ID'} = $mmbc; $mmag{'MESSAGENUM'} = $mmcm; $mmag{'SIZE'} = $mmba[$mmcm]; if($mmbm) { $mmag{'ATTACHMENT_IMAGE'} = $mmck; } else { $mmag{'ATTACHMENT_IMAGE'} = ''; } if($mmcm%2==0) { $mmcs = mmhw($mmci,\%mmag); } else { $mmcs = mmhw($mmcj,\%mmag); } $mmag{'MESSAGELIST'} .= $mmcs; } } mmgx(\*SOCKET,"QUIT"); close SOCKET; unless($mmag{'MESSAGELIST'}) { $mmag{'MESSAGELIST'} = mmhy($mman,'NOMESSAGES'); } mmia($mman,\%mmag); } sub mmhf { my($mmai,$mmct) = @_; if($mmae = mmgy()) { mmgv($mmae); } my($mmbb) = mmhb($mmai); $mmbb += $mmct; if($mmbb > $mmca) { if($mmx) { mmhe(); } else { mmgv("No next message."); } } if($mmbb < 1) { if($mmx) { mmhe(); } else { mmgv("No previous message."); } } if($mmct != 0) { mmgz($mmbb); } $mmam = "The server timed out retrieving a message."; if($bUseAlarm eq TRUE){ alarm(180); } $mmcu = $mmbb; mmgx(\*SOCKET,"RETR $mmcu"); $mmay = ; unless($mmay =~ /\+OK/) { mmgv($mmay); } $mmcv = 0; while(defined($mmas = )) { if($mmas =~ /^\.\r$/){ last; } $mmcw[$mmcv++] = $mmas; } mmgx(SOCKET,"QUIT"); close SOCKET; } sub mmhg { my($mmcx,$mmcy) = @_; my($mmcs) = ''; my(@mmcz,@mmda,@mmdb,$mmdc,@mmdd); my($mmde); my(@mmdf,@mmdg,$mmdh,@mmdi); if($mmbl) { my($mmbn)=0; $mmdc=0; my($mmdj)= ''; headerline: foreach $_ (@$mmcx) { $mmdj .= $_; if(/^[\r\n]+$/){ last headerline; } } $mmdj =~ s/[\r\n]/ /g; $mmdk = 1; if($mmdj =~ /Content-type\:\s+multipart\/mixed;.*boundary\=\"?([^\"\;\s]+)\"?\;?\s/si) { $mmde = 'multipart/mixed'; $mmdl = $1; $mmdm = mmif($mmdl); $mmdn = TRUE; } elsif($mmdj =~ /Content-type\:\s+multipart\/alternative;.*boundary\=\"?([^\"\;]+)\"?\;?\s/si) { $mmde = 'multipart/alternative'; $mmdl = $1; $mmdm = mmif($mmdl); } elsif($mmdj =~ /Content-type\:\s+([^\;]+);.*name\=\"?([^\"\;]+)\"?\;?\s/si) { $mmde = $mmda[0] = $1; $mmdo = $mmdd[0] = $2; $mmdp = 0; $mmcz[0][$mmdq++] = "Content-type: $1; name=\"$2\"\n"; } elsif($mmdj =~ /Content-type\:\s+([^\;]+)/si) { $mmde = $mmda[0] = $1; $mmdo = $mmdd[0] = 'messagebody'; $mmdp = 0; $mmcz[0][$mmdq++] = "Content-type: $1; name=\"$2\"\n"; } if($mmdj =~ /Content-transfer-encoding\:\s+(\S+)\s/si) { $mmcz[0][$mmdq++] = "Content-transfer-encoding: $1\n"; } $mmcz[0][$mmdq++] = "\n"; $mmdk = 0; $mmbn=0; $mmdc=0; messageline: foreach $_ (@$mmcx) { if($mmbn) { if(/^\-\-$mmdm\-\-/) { last messageline; } if(/^\-\-$mmdm/) { $mmdc++; $mmdq=0; $mmdr=0; $mmdb[$mmdc] = $mmdl . 'P' . $mmdc; next messageline; } $mmcz[$mmdc][$mmdq++] = $_; if(/^[\r\n]+$/) { if(!$mmdr) { $mmdr=TRUE; if($mmdd[$mmdc] eq '') { $mmdd[$mmdc] = 'Untitled'; } } } if(!$mmdr) { if(/name\=\"?([^\"]+)\"?/i) { $mmdd[$mmdc] = $1; } if(/^Content-type\: ([^\;]+)\;?/i) { $mmds = $1; $mmda[$mmdc] = $mmds; } } } if(/^[\r\n]+$/) { $mmbn=TRUE; } } } if($mmaj eq '0') { mmhh($mmcz[0]); } if($mmaj ne '') { my($mmdt)=1; for(;$mmdt<=$mmdc;$mmdt++) { if($mmdb[$mmdt] eq $mmaj) { mmhh($mmcz[$mmdt]); } } } if($mmbl) { if($mmde =~ /text\/plain/i) { $mmcs = mmhl($mmcx, $mmcy); } elsif($mmde !~ /multipart\/mixed/i && $mmde !~ /multipart\/alternative/i) { if($mmcy) { $mmcs = mmhl($mmcx, $mmcy); } else { if($mmx) { $mmcs .= qq|

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

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

\n| . qq|

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

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

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

\n|; } } } return $mmcs; } my($mmdt)=1; if($mmde =~ /multipart\/mixed/i) { if($mmda[1] =~ /multipart\/alternative/i || $mmda[1] =~ /multipart\/mixed/i) { $mmcs = mmhg($mmcz[1], $mmcy); } elsif($mmda[1] =~ /text\/plain/i) { $mmcs = mmhl($mmcz[1], $mmcy); } elsif($mmda[1] =~ /text\/html/i) { if($mmcy) { $mmcs = mmhl($mmcz[1], $mmcy); } else { $mmcs = mmhm($mmcz[1]); } } else { $mmdt = 0; } } elsif($mmde eq 'multipart/alternative') { my($mmdv) = 1; for(;$mmdv<=$mmdc;$mmdv++) { if($mmda[$mmdv] =~ /text\/html/i && !$mmcy) { $mmcs = mmhm($mmcz[$mmdv]); return $mmcs; } } $mmdv = 1; for(;$mmdv<=$mmdc;$mmdv++) { if($mmda[$mmdv] =~ /text\/plain/i) { $mmcs = mmhl($mmcz[$mmdv], $mmcy); return $mmcs; } } } else { $mmcs = mmhl($mmcx, $mmcy); return($mmcs); } if($mmcy) { return($mmcs); } if($mmde eq 'multipart/mixed') { for(;$mmdt<$mmdc;$mmdt++) { $mmdw = $mmdb[$mmdt+1]; $mmdw = mmid($mmdw); $mmdu = localtime(time); $mmdu = mmih($mmdu); if($mmx) { $mmcs .= qq|

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

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

\n| . qq|

\n| . qq|\n| . qq|\n| . qq|\n| . qq|
Attachment #$mmdt:\n| . qq|\n| . qq|$mmdd[$mmdt+1]
\n| . qq|\n| . qq|\n| . qq|

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

Attachment #$mmdt:\n| . qq|\n| . qq|$mmdd[$mmdt+1]

\n|; } } } } } else { $mmdh=0; plaintextline: foreach $_ (@$mmcx) { if(/^begin \d\d\d (\S+)\s*$/i) { $mmdh++; $mmdq=0; $mmdi[$mmdh] = $1; $mmdg[$mmdh] = $1 . 'P' . $mmdh; next plaintextline; } elsif($mmdh>0 && /^end\s*$/i) { $mmdh++; $mmdq=0; $mmdf[$mmdh] .= "Fake Header\n\n"; next plaintextline; } $mmdf[$mmdh][$mmdq++] = $_; } if($mmaj ne '') { my($mmdx) = 0; for(;$mmdx<=$mmdh;$mmdx++) { if($mmdg[$mmdx] eq $mmaj) { if($mmdi[$mmdx] eq '') { $mmcs = mmhl($mmdf[$mmdx], $mmcy); return $mmcs; } else { mmhk($mmdf[$mmdx],$mmdi[$mmdx]); } } } } else { my($mmdx) = 0; for(;$mmdx<=$mmdh;$mmdx++) { if($mmdi[$mmdx] eq '') { $mmcs .= mmhl($mmdf[$mmdx], $mmcy); } elsif(!$mmcy) { $mmdy = $mmdg[$mmdx]; $mmdy = mmid($mmdy); if($mmx) { $mmcs .= '

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

\n| . qq|

\n| . qq|\n| . qq|\n| . qq|\n| . qq|
Attachment #$mmdx:\n| . qq|\n| . qq|$mmdi[$mmdx]
\n| . qq|\n| . qq|\n| . qq|

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

Attachment #$mmdx:\n| . qq|\n| . qq|$mmdi[$mmdx]

\n|; } } } } } return($mmcs); } return($mmcs); } sub mmhh { my($mmdz) = @_; my($mmea,$mmeb); $mmdr=0; foreach $mmas (@$mmdz) { if($mmas =~ /^Content-transfer-encoding\: base64/i) { $mmea = TRUE; } elsif($mmas =~ /^Content-transfer-encoding\: quoted-printable/i) { $mmeb = TRUE; } elsif($mmas =~ /^Content-Disposition\:/i) { } else { if($mmdr && $mmea) { $mmec .= $mmas; } elsif($mmdr && $mmeb) { $mmec .= $mmas; } else { $mmdj .= $mmas; } } if($mmas =~ /^[\r\n]+$/) { $mmdr = TRUE; $mmdj =~ s/[\r\n]+[ \t]+(\S)/ $1/gs; } } if($mmea) { $mmed = mmhj($mmec); } elsif($mmeb) { $mmed = mmhi($mmec); } print "Expires: Sun, 03 May 1998 16:00:00 GMT\n"; if($mmee !~ /MSIE/i) { print "Cache-control: no-cache\n"; } print $mmdj; print $mmed; exit(0); } sub mmhi { my($mmec) = @_; my($mmef); $mmec =~ s/\s+(\r?\n)/$1/g; $mmec =~ s/=\r?\n//g; $mmef = $mmec; $mmef =~ s/=([\da-fA-F]{2})/pack("C", hex($1))/ge; return($mmef); } sub mmhj { my($mmec) = @_; my($mmef); $mmec =~ tr|A-Za-z0-9+=/||cd; if(length($mmec)%4) { return($mmec); } $mmec =~ s/=+$//; $mmec =~ tr|A-Za-z0-9+/| -_|; while($mmec =~ /(.{1,60})/gs) { my($mmeg) = chr(32+length($1)*3/4); $mmef .= unpack("u",$mmeg . $1 ); } return($mmef); } sub mmhk { my($mmeh,$mmei) = @_; print "Expires: Sun, 03 May 1998 16:00:00 GMT\n"; if($mmee !~ /MSIE/i) { print "Cache-control: no-cache\n"; } print qq|Content-Type: application\/octet-stream; name="$mmei"\n\n|; $mmcs = ''; foreach $mmas (@$mmeh) { $mmcs .= unpack('u',$mmas); } print $mmcs; exit(1); } sub mmhl { my($mmcx,$mmcy) = @_; my($mmea,$mmeb); my($mmcs) = ''; if(!$mmcy) { $mmcs = "
\n"; } $mmbn=0; foreach $_ (@$mmcx) { if(!$mmbn) {
if(/^Content-transfer-encoding\: base64/i) { $mmea = TRUE; }
elsif(/^Content-transfer-encoding\: quoted-printable/i) { $mmeb = TRUE; } } if($mmbn)
{ if($mmeb || $mmea) { $mmec = $_; if($mmea) { $mmej = mmhj($mmec); }
elsif($mmeb) { $mmej = mmhi($mmec); } } else { $mmej = $_; }
$mmek = length($mmej); if($mmcy) { $mmel = $mmej; } else { $mmel = mmhc($mmej); }
$mmem = 90 + $mmek + length($mmel); $mmel =~ s/([^\n]{1,$mmem})\s/$1\n/g;
$mmel =~ s/\015//g; if($mmcy) { $mmel = '> ' . $mmel; } $mmcs .= $mmel ; }
if(/^[\r\n]+$/){ $mmbn=TRUE; } } if($mmea) { $mmcs .= mmhj($mmec); }
elsif($mmeb) { $mmcs .= mmhi($mmec); } if(!$mmcy) {
$mmcs .= "
\n"; } return $mmcs; } sub mmhm { my($mmcx) = @_; my($mmea,$mmeb); $mmbn=0; foreach $_ (@$mmcx) { if(!$mmbn) { if(/^Content-transfer-encoding\: base64/i) { $mmea = TRUE; } elsif(/^Content-transfer-encoding\: quoted-printable/i) { $mmeb = TRUE; } } if($mmbn) { if($mmeb || $mmea) { $mmec .= $_; } else { $mmel = $_; $mmel =~ s/\r//g; $mmcs .= $mmel; } } if(/^[\r\n]+$/){ $mmbn=TRUE; } } if($mmea) { $mmcs .= mmhj($mmec); } elsif($mmeb) { $mmcs .= mmhi($mmec); } $mmdk = 1; $mmcs =~ s/\<\/?(html|head|body|title)[^\>]*\>//sig; $mmdk = 0; return $mmcs; } sub mmhn { my($mmai,$mmct) = @_; mmhf($mmai,$mmct); if($mmx) { $mman = 't_nf_message.htm'; } else { $mman = 't_f_message.htm'; } my(%mmag); $mmag{'USERNAME'} = $mmm; $mmag{'USERNAMEHIDDEN'} = $mmn; $mmag{'SERVER'} = $strIncomingServer; $mmag{'SERVERHIDDEN'} = $mmq; $mmag{'PASSWORDHIDDEN'} = $mmp; $mmag{'CHECKSUM'} = $mmt; $mmag{'NUM'} = $mmca; $mmag{'ID'} = $mmbc; $mmag{'MESSAGENUM'} = $mmbe + $mmct; $mmag{'TO'} = $mmbt; $mmag{'FROM'} = $mmbu; $mmag{'DATE'} = $mmbi; $mmag{'SUBJECT'} = $mmbw; $mmag{'MESSAGE'} = mmhg(\@mmcw); $mmag{'CC'} = $mmbv; $mmen = mmhy($mman,'CCLINE'); if($mmbg eq '') { $mmen = ''; } else { $mmen = mmhw($mmen,\%mmag); } $mmag{'CCLINE'} = $mmen; mmia($mman,\%mmag); } sub mmho { my($mmai,$mmct) = @_; mmhf(mmid($mmai),$mmct); if($mmx) { $mman = 't_nf_message.htm'; } else { $mman = 't_f_message.htm'; } my(%mmag); $mmag{'USERNAME'} = $mmm; $mmag{'USERNAMEHIDDEN'} = $mmn; $mmag{'SERVER'} = $strIncomingServer; $mmag{'SERVERHIDDEN'} = $mmq; $mmag{'PASSWORDHIDDEN'} = $mmp; $mmag{'CHECKSUM'} = $mmt; $mmag{'NUM'} = $mmca; $mmag{'ID'} = $mmbc; $mmag{'MESSAGENUM'} = $mmbe; $mmag{'TO'} = $mmbt; $mmag{'FROM'} = $mmbu; $mmag{'DATE'} = $mmbi; $mmag{'SUBJECT'} = $mmbw; $mmag{'CC'} = $mmbv; $mmen = mmhy($mman,'CCLINE'); if($mmbg eq '') { $mmen = ''; } else { $mmen = mmhw($mmen,\%mmag); } $mmag{'CCLINE'} = $mmen; $mmag{'MESSAGE'} = "
\n"; foreach $mmas (@mmcw) { $mmas =~ s/\015//g;
$mmas =~ s/\&/\&\;/g; $mmas =~ s/\/\>\;/g;
$mmag{'MESSAGE'} .= $mmas; } $mmag{'MESSAGE'} .= "
\n"; mmia($mman,\%mmag); } sub mmhp { my($mmai) = @_; $mmaz = mmhb($mmai); mmgx(\*SOCKET,"DELE $mmaz"); $mmay = ; unless($mmay =~ /\+OK/) { mmgv($mmay); } } sub mmhq { my($mmai) = @_; mmhp($mmai); } sub mmhr { my($mmai,$mmeo,$mmep) = @_; if($mmx) { $mman = 't_nf_messageform.htm'; } else { $mman = 't_f_messageform.htm'; } if($mmai ne "NEW") { mmhf(mmid($mmai),0); $mmeq = $mmbf; $mmer = $mmbh; $mmes = $mmbj; if($mmbk) { $mmbf = $mmbk; } else { $mmbf = $mmbh; } if($mmeo) { $mmbf .= ", $mmeq"; if($mmbg){ $mmbf .= ", $mmbg"; } } if($mmep) { unless($mmbj =~ /^fwd\:/i) { $mmbj = "Fwd: $mmbj"; } $mmbf = ""; } else { unless($mmbj =~ /^re\:/i) { $mmbj = "Re: $mmbj"; } } } $mmbf =~ s/\"//g; $mmbj =~ s/\"//g; if($mmai ne "NEW") { $mmcs = mmhg(\@mmcw,TRUE); if($mmep) { $mmet = mmhy($mman, 'FORWARDHEADER'); $mmag{'ORIGINALTO'} = $mmeq; $mmag{'ORIGINALFROM'} = $mmer; $mmag{'ORIGINALSUBJECT'} = $mmes; $mmag{'ORIGINALDATE'} = $mmbi; $mmcs = mmhw($mmet,\%mmag) . $mmcs; if($mmdn) { $mmeu = $mmai; $mmag{'ERROR'} = 'The original message attachment(s) ' . 'will be included in this message.'; } } } $mmag{'USERNAME'} = $mmm; $mmag{'USERNAMEHIDDEN'} = $mmn; $mmag{'SERVER'} = $strIncomingServer; $mmag{'SERVERHIDDEN'} = $mmq; $mmag{'PASSWORDHIDDEN'} = $mmp; $mmag{'CHECKSUM'} = $mmt; $mmag{'NUM'} = $mmaz; $mmag{'MESSAGE'} = $mmcs; $mmag{'TO'} = $mmbf; $mmag{'CC'} = $mmbg; $mmag{'SUBJECT'} = $mmbj; if(defined($strFromDomainName)) { $mmag{'FROM'} = $mmm . '@' . $strFromDomainName; } else { $mmag{'FROM'} = $mmm . '@' . $strIncomingServer; } my($mmee,$mmev,$mmew) = mmig(); if(($mmee =~ /MSIE/i && $mmev >= 4) || ($mmee =~ /Mozilla/i && $mmev >= 2)) { if(!$mmep) { my($mmex) = mmhy($mman, 'UPLOAD'); $mmag{'UPLOAD'} = $mmex; } } mmia($mman,\%mmag); } sub mmhs { my($mmae) = @_; if($mmx) { $mman = 't_nf_messageform.htm'; } else { $mman = 't_f_messageform.htm'; } $mmag{'USERNAME'} = $mmm; $mmag{'USERNAMEHIDDEN'} = $mmn; $mmag{'SERVER'} = $strIncomingServer; $mmag{'SERVERHIDDEN'} = $mmq; $mmag{'PASSWORDHIDDEN'} = $mmp; $mmag{'CHECKSUM'} = $mmt; $mmag{'NUM'} = $mma{'NUM'}; $mmag{'MESSAGE'} = $mmcs; $mmag{'TO'} = $mma{'TO'}; $mmag{'CC'} = $mma{'CC'}; $mmag{'FROM'} = $mma{'FROM'}; $mmag{'SUBJECT'} = $mma{'SUBJECT'}; $mmag{'OUTGOING'} = $strOutgoingServer; $mmag{'ERROR'} = $mmae; if(defined($mma{'FORWARDATTACHMENTS'})) { $mmeu = mmie($mma{'FORWARDATTACHMENTS'}); $mmep = true; } my($mmee,$mmev,$mmew) = mmig(); if(($mmee =~ /MSIE/i && $mmev >= 4) || ($mmee =~ /Mozilla/i && $mmev >= 2)) { if(!$mmep) { my($mmex) = mmhy($mman, 'UPLOAD'); $mmag{'UPLOAD'} = $mmex; } } mmia($mman,\%mmag); } sub mmht { my($mmaq) = "\015\012"; my($mmar, $mmas) = @_; my($mmat) = length($mmas . $mmaq); syswrite($mmar,$mmas . $mmaq,$mmat); } sub mmhu { my($mmaq) = "\015\012"; if($mmey = $mma{'FORWARDATTACHMENTS'}) { $mmez = mmie($mmey); mmhf($mmez,0); $mmdl = ''; my($mmdc) = 0; foreach $mmas (@mmcw) { if($mmas =~ /boundary\=\"?([^\"]+)\"?\;?/ && $mmdl eq '') { $mmdl = $1; } if($mmdl ne '' && $mmas =~ /^\-\-$mmdl\s*$/) { $mmdc++; } if($mmdc > 0) { $mmas =~ s/[\r\n]+/$mmaq/; $mmfa .= $mmas; } } } $mmcs .= $mma{"TEXT"}; $mmdk = 1; $mmcs =~ s/\015//sg; $mmcs =~ s/([^\012]{1,90})\s/$1\012/sg; $mmcs =~ s/\012/\015\012/sg; $mmdk = 0; unless($strOutgoingServer) { mmhs("Send Error: No server provided, cannot proceed."); } $mmav = getprotobyname('tcp'); socket(SOCKET,PF_INET,SOCK_STREAM,$mmav); $mmaw = gethostbyname($strOutgoingServer); unless($mmaw) { mmhs("Could not find an IP address for the host " . "\"$strOutgoingServer\"."); } $mmax = sockaddr_in(25, $mmaw); unless(connect(SOCKET, $mmax)) { mmhs("Send Error: Could not connect to server " . "$strOutgoingServer"); } select(SOCKET); $|=1; select(STDOUT); binmode(SOCKET); $mmam = "The server connected, but will not respond."; if($bUseAlarm eq TRUE){ alarm(180); } $mmay = ; unless($mmay =~ /^220.+/) { mmhs("Send Error: The server does not respond " . "appropriately."); } while($mmay =~ /^\d\d\d\-/) { $mmay = ; } $mmfb = $ENV{REMOTE_HOST}; unless($mmfb){ $mmfb = 'mailman.endymion.com';} mmht(\*SOCKET,"HELO $mmfb"); $mmay = ; unless($mmay =~ /^250.+/) { mmhs('Send Error: ' . $mmay); } while($mmay =~ /^\d\d\d\-/) { $mmay = ; } $mmam = "The server timed out while accepting a message."; if($bUseAlarm eq TRUE){ alarm(180); } mmht(\*SOCKET,"MAIL FROM: <$mma{'FROM'}>"); $mmay = ; unless($mmay =~ /^250.+/) { mmhs('Send Error: ' . $mmay); } while($mmay =~ /^\d\d\d\-/) { $mmay = ; } $mma{"TO"} =~ s/\;/\,/g; # Allow ";"s to divide addresses. $mmfc = $mma{"TO"}; if($mma{"CC"}){ $mmfc .= qq|,$mma{"CC"}|; } @mmfd = split(/[\,\;]/,$mmfc); { my($mmcm); for($mmcm=0;$mmcm<($#mmfd+1);$mmcm++) { my($mmfe) = $mmfd[$mmcm]; $mmfe =~ s/^\s+(.*)$/$1/; $mmfe =~ s/^(.*)\s+$/$1/; push(@mmff,$mmfe); } } while($mmfe = shift(@mmff)) { $mmfe =~ s/^\s+(.*)$/$1/; $mmfe =~ s/^(.*)\s+$/$1/; unless($mmfe =~ /@/) { if(defined($strOutgoingDomainName)) { $mmfe .= "\@$strOutgoingDomainName"; } } if($mmfe =~ /([^\s<]+@[^\s\r,>]+)/) { $mmfe = '<' . $1 . '>'; mmht(\*SOCKET,"RCPT TO: $mmfe"); $mmay = ; unless($mmay =~ /^250.+/) { mmhs('Send Error: ' . $mmay); } while($mmay =~ /^\d\d\d\-/) { $mmay = ; } } } mmht(\*SOCKET,"DATA"); $mmay = ; unless($mmay =~ /^354.+/) { mmhs('Send Error: ' . $mmay); } while($mmay =~ /^\d\d\d\-/) { $mmay = ; } @mmfg = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat'); @mmfh = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep', 'Oct','Nov','Dec'); ($mmfi,$mmfj,$mmfk,$mmfl,$mmfm,$mmfn,$mmfo) = localtime(time); $mmfo = $mmfg[$mmfo]; $mmfm = $mmfh[$mmfm]; $mmfk = sprintf("%2.2d",$mmfk); $mmfj = sprintf("%2.2d",$mmfj); $mmfi = sprintf("%2.2d",$mmfi); $mmbi = "$mmfo, $mmfl $mmfm $mmfn $mmfk:$mmfj:$mmfi +0000"; $mmfp = qq|To: $mma{'TO'}$mmaq|; if($mma{"CC"}){ $mmfp .= qq|Cc: $mma{'CC'}$mmaq|; } $mmfp .= qq|From: $mma{'FROM'}$mmaq|; $mmfp .= qq|Subject: $mma{'SUBJECT'}$mmaq|; $mmfp .= qq|Date: $mmbi$mmaq|; $mmfp .= "X-Mailer: Endymion MailMan " . "$strMailManEdition $strMailManVersion$mmaq"; if($mma{'USERFILE1'} || $mma{'USERFILE2'} || $mmez) { unless($mmdl){ $mmdl = 'MailMan_Boundary'; } $mmfp .= "MIME-Version: 1.0$mmaq"; $mmfp .= "Content-Type: multipart/mixed; boundary=\"$mmdl\"$mmaq$mmaq"; $mmfp .= "This is a multi-part message in MIME format.$mmaq$mmaq"; $mmfp .= "--$mmdl$mmaq"; $mmfp .= "Content-Type: text/plain$mmaq$mmaq"; } else { $mmfp .= "$mmaq"; } mmht(\*SOCKET,$mmfp . $mmcs); if(defined($strOutgoingBannerText)) { $mmdk = 1; $strOutgoingBannerText =~ s/\015//sg; $strOutgoingBannerText =~ s/([^\012]{1,90})\s/$1\012/sg; $strOutgoingBannerText =~ s/\012/\015\012/sg; $mmdk = 0; mmht(\*SOCKET,$strOutgoingBannerText); } foreach $mmfq ('USERFILE1','USERFILE2') { unless($mma{$mmfq}){next;} unless(defined($mmb{$mmfq})){next;} my($mmfr) = $mmb{$mmfq}; $mmfr =~ s/^(.*[\\\/])([^\\\/])/$2/; $mmfs = '--' . $mmdl . $mmaq; $mmfs .= "Content-Type: application/octet-stream; name=\"$mmfr\"$mmaq"; $mmfs .= "Content-Transfer-Encoding: base64$mmaq"; $mmfs .= "Content-Disposition: attachment; filename=\"$mmfr\"$mmaq"; $mmfs .= $mmaq; $mmfs .= mmij($mma{$mmfq},$mmaq); mmht(\*SOCKET,$mmfs); } if($mmfa) { mmht(\*SOCKET,$mmfa); } else { if($mmdl) { mmht(\*SOCKET,'--' . $mmdl . '--'); } } mmht(\*SOCKET,''); mmht(\*SOCKET,'.'); $mmay = ; unless($mmay =~ /^250.+/) { mmhs('Send Error: ' . $mmay); } while($mmay =~ /^\d\d\d\-/) { $mmay = ; } mmht(\*SOCKET,"QUIT"); close SOCKET; if($mmx) { $mman = 't_nf_sendconfirm.htm'; } else { $mman = 't_f_sendconfirm.htm'; } $mmag{'USERNAME'} = $mmm; $mmag{'USERNAMEHIDDEN'} = $mmn; $mmag{'SERVER'} = $strIncomingServer; $mmag{'SERVERHIDDEN'} = $mmq; $mmag{'PASSWORDHIDDEN'} = $mmp; $mmag{'CHECKSUM'} = $mmt; $mmag{'SUBJECT'} = mmhc($mma{'SUBJECT'}); $mmag{'TO'} = mmhc($mma{'TO'}); $mmag{'OUTGOING'} = mmhc($strOutgoingServer); mmia($mman,\%mmag); exit(0); } sub mmhv { my($mmft) = @_; $mmfu = mmic($ENV{SERVER_NAME},42); $mmfv = mmic($ENV{REMOTE_HOST} . $ENV{REMOTE_ADDR},69); unless($mmfu){ $mmfu = 'NO SERVER'; } unless($mmfv){ $mmfv = 'NO HOST'; } $mmfw = $mmfu ^ $mmfv; if(length($mmfw)==$mmft) { return($mmfw); } elsif(length($mmfw)>$mmft) { return(substr($mmfw,0,$mmft)); } else { while(length($mmfw)<$mmft) { $mmfw = "$mmfw$mmfw"; } return(substr($mmfw,0,$mmft)); } } sub mmhw { my($mmfx,$mmfy) = @_; unless($mmfy->{'ME'}){ $mmfy->{'ME'} = $mmu; } while($mmfx =~ /MailMan\(([^\)]+)\)/) { $mmfz = $mmfy->{$1}; $mmfx =~ s/MailMan\($1\)/$mmfz/g; } return $mmfx; } sub mmhx { my($mmfr) = @_; print "Content-type: text/html\n\n"; if(-e $mmfr) { print qq|MailMan: Template Can't Be Read\n| . qq|\n| . qq|

MailMan Configuration Error

\n| . qq|

The output template "$mmfr" 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 $mmfr" 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 "$mmfr" 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 mmhy { my($mmfr,$mmga) = @_; $mmfr = $mmz . $mmfr; if(open(TEMPLATE,$strLocalTemplateLocation . $mmfr)) { $mmgb = ""; $mmgc = ''; while(defined($_ =