head 0.46; access; symbols; locks jhardin:0.46; strict; comment @# @; 0.46 date 2002.01.13.22.25.14; author jhardin; state Exp; branches; next 0.45; 0.45 date 2001.04.23.00.08.31; author jhardin; state Exp; branches; next 0.44; 0.44 date 2001.04.06.22.53.56; author jhardin; state Exp; branches; next 0.43; 0.43 date 2001.03.25.22.13.58; author jhardin; state Exp; branches; next 0.42; 0.42 date 2001.03.11.18.32.50; author jhardin; state Exp; branches; next 0.41; 0.41 date 2001.03.11.17.13.29; author jhardin; state Exp; branches; next 0.40; 0.40 date 2001.03.10.19.03.37; author jhardin; state Exp; branches; next 0.39; 0.39 date 2001.03.06.05.17.23; author jhardin; state Exp; branches; next 0.38; 0.38 date 2001.03.04.06.27.39; author jhardin; state Exp; branches; next 0.37; 0.37 date 2001.03.04.05.53.37; author jhardin; state Exp; branches; next 0.36; 0.36 date 2001.03.04.02.03.39; author jhardin; state Exp; branches; next 0.35; 0.35 date 2001.03.04.01.54.58; author jhardin; state Exp; branches; next 0.34; 0.34 date 2001.03.04.01.44.59; author jhardin; state Exp; branches; next 0.33; 0.33 date 2001.03.04.00.49.41; author jhardin; state Exp; branches; next 0.32; 0.32 date 2001.03.04.00.46.06; author jhardin; state Exp; branches; next 0.31; 0.31 date 2001.03.03.21.46.37; author jhardin; state Exp; branches; next 0.30; 0.30 date 2001.03.03.21.13.15; author jhardin; state Exp; branches; next 0.29; 0.29 date 2001.03.03.18.43.00; author jhardin; state Exp; branches; next 0.28; 0.28 date 2001.03.03.18.40.34; author jhardin; state Exp; branches; next 0.27; 0.27 date 2001.03.03.18.38.02; author jhardin; state Exp; branches; next 0.26; 0.26 date 2001.03.03.18.36.53; author jhardin; state Exp; branches; next 0.25; 0.25 date 2001.03.03.18.32.02; author jhardin; state Exp; branches; next 0.24; 0.24 date 2001.03.01.04.59.30; author jhardin; state Exp; branches; next 0.23; 0.23 date 2001.02.28.06.17.00; author jhardin; state Exp; branches; next 0.22; 0.22 date 2001.02.28.06.08.17; author jhardin; state Exp; branches; next 0.21; 0.21 date 2001.02.25.19.08.01; author jhardin; state Exp; branches; next 0.20; 0.20 date 2001.02.25.17.13.27; author jhardin; state Exp; branches; next 0.19; 0.19 date 2001.02.25.04.20.55; author jhardin; state Exp; branches; next 0.18; 0.18 date 2001.02.23.04.08.07; author jhardin; state Exp; branches; next 0.17; 0.17 date 2001.02.22.06.17.41; author jhardin; state Exp; branches; next 0.16; 0.16 date 2001.02.21.04.43.47; author jhardin; state Exp; branches; next 0.15; 0.15 date 2001.02.20.05.41.06; author jhardin; state Exp; branches; next 0.14; 0.14 date 2001.02.20.05.35.16; author jhardin; state Exp; branches; next 0.13; 0.13 date 2001.02.20.04.38.10; author jhardin; state Exp; branches; next 0.12; 0.12 date 2001.02.20.03.29.30; author jhardin; state Exp; branches; next 0.11; 0.11 date 2001.02.19.20.56.08; author jhardin; state Exp; branches; next 0.10; 0.10 date 2001.02.19.02.53.20; author jhardin; state Exp; branches; next 0.9; 0.9 date 2001.02.18.18.38.40; author jhardin; state Exp; branches; next 0.8; 0.8 date 2001.02.18.18.11.52; author jhardin; state Exp; branches; next 0.7; 0.7 date 2001.02.17.20.02.00; author jhardin; state Exp; branches; next 0.6; 0.6 date 2001.02.17.20.01.36; author jhardin; state Exp; branches; next 0.5; 0.5 date 2001.02.17.19.43.33; author jhardin; state Exp; branches; next 0.4; 0.4 date 2001.02.17.05.22.31; author jhardin; state Exp; branches; next 0.3; 0.3 date 2001.02.17.05.17.13; author jhardin; state Exp; branches; next 0.2; 0.2 date 2001.02.17.04.45.21; author jhardin; state Exp; branches; next 0.1; 0.1 date 2001.02.16.05.26.58; author jhardin; state Exp; branches; next ; desc @@ 0.46 log @*** empty log message *** @ text @# # Procmail Sanitizer perl script # (C) 2002 John D. Hardin # License: GPL # Contact author for commercial licensing # $Id: sanitizer.pl,v 0.45 2001-04-22 17:08:31-07 jhardin Exp jhardin $ use File::MkTemp; # MIME support use MIME::QuotedPrint; use MIME::Base64; # i18n and l10n support use POSIX; use Locale::PGetText; sub initialize { my ($junk,$sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst); if (setlocale(LC_CTIME) ne "C") { warn "Setting locale to \"", setlocale(LC_CTIME), "\"\n" if $dbg; Locale::PGetText::setLocaleDir("/opt/sanitizer/locale"); Locale::PGetText::setLanguage(setlocale(LC_CTIME)); } $HOST = $ENV{"HOST"}; # assume procmail environment $TEMP = $ENV{"TMPDIR"} || "/tmp"; $dbgv = $ENV{"DEBUG_VERBOSE"}; $dbg = $dbgv || $ENV{"DEBUG"}; # maximum size of encoded in-memory body part $MAX_BP_SZ = ($ENV{"MAX_BP_SZ"} * 1) || (128 * 1024); $INFO = gettext("INFO:"); $CONF = gettext("CONF:"); $WARN = gettext("WARN:"); $FATAL = gettext("FATAL:"); $DEFANG = gettext("DEFANGED"); die "$CONF ", gettext("dangerous characters in localized string"), " \"DEFANGED\"\n" if $DEFANG =~ /[^-0-9a-zA-Z_]/; $DEFANG = sprintf("%05d-%s.txt", $$, $DEFANG); unless ($HOST) { warn "$CONF \$HOST ", gettext("not set in environment"), "\n"; $HOST = $ENV{"HOSTNAME"} || `hostname`; } $SANHDR = "X-Content-Security: [${HOST}] "; $CHARSET = $ENV{"CHARSET"} || "ISO-8859-1"; $default_policy = "SD"; # fail securely - strip and discard umask(0007); # zero out arrays @@boundariestoolong = @@gotboundaries = @@mimeboundaries = @@newboundaries = @@nullboundaries = @@rawboundaries = @@Policy = %RFC822maxlen = @@Headers = @@MsgLog = (); # Do we have a quarantine mailbox? if ($Qbox = $ENV{"SECURITY_QUARANTINE"}) { $Qbox =~ s/(^\s+|\s+$)//g; die "$CONF \$SECURITY_QUARANTINE ", gettext("is not valid if relative"), "\n" if $Qbox !~ /^\//; if (-e $Qbox) { die "$CONF \$SECURITY_QUARANTINE=\"$Qbox\": ", gettext("not a file or directory"), "\n" unless -f $Qbox || -d $Qbox; die "$CONF \$SECURITY_QUARANTINE=\"$Qbox\": ", gettext("not writable"), "\n" unless -w $Qbox; } } # Do we have a quarantine directory? if ($Qdir = $ENV{"SECURITY_QUARANTINE_DIR"}) { $Qdir =~ s/(^\s+|\s+$)//g; die "$CONF \$SECURITY_QUARANTINE_DIR ", gettext("is not valid if relative"), "\n" if $Qdir !~ /^\//; $Qdir =~ s/\/$// if $Qdir ne "/"; die "$CONF \$SECURITY_QUARANTINE_DIR=\"$Qdir\": ", gettext("not a directory"), "\n" unless -d $Qdir; die "$CONF \$SECURITY_QUARANTINE_DIR=\"$Qdir\": ", gettext("not writable"), "\n" unless -w $Qdir; $default_policy = "SQ"; # fail securely - strip and quarantine ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime; $Qtemplate = sprintf("%04d%02d%02d:%02d%02d-%05d-", $year + 1900, $mon + 1, $mday, $hour, $min, $$); } # Do we have a filename log? if ($Flog = $ENV{"SECURITY_FILENAME_LOG"}) { $Flog =~ s/(^\s+|\s+$)//g; die "$CONF \$SECURITY_FILENAME_LOG ", gettext("is not valid if relative"), "\n" if $Flog !~ /^\//; if (-e $Flog) { die "$CONF \$SECURITY_FILENAME_LOG=\"$Flog\": ", gettext("not a file"), "\n" unless -f $Flog; die "$CONF \$SECURITY_FILENAME_LOG=\"$Flog\": ", gettext("not writable"), "\n" unless -w $Flog; } $default_policy .= "L"; } # Do we have a policy files directory? if ($Pdir = $ENV{"SECURITY_POLICY_DIR"}) { $Pdir =~ s/(^\s+|\s+$)//g; die "$CONF \$SECURITY_POLICY_DIR ", gettext("is not valid if relative"), "\n" if $Pdir !~ /^\//; $Pdir =~ s/\/$// if $Pdir ne "/"; die "$CONF \$SECURITY_POLICY_DIR=\"$Pdir\": ", gettext("not a directory"), "\n" unless -d $Pdir; die "$CONF \$SECURITY_POLICY_DIR=\"$Pdir\": ", gettext("not readable"), "\n" unless -r $Pdir; } } sub readpolicy { # Read the attachment security policy and header max length files # Create the Policy and RFC822maxlen arrays # TODO compile and save the policy rather than parsing it every time my($list, $dir, $file, $glob, $policy, $header, $maxlen); unless (@@Policy) { # read it only once warn "$INFO ", gettext("reading attachment policies"), "\n" if $dbg; if ($list = $ENV{"SECURITY_POLICY"}) { foreach $file (split(/:/, $list)) { $file =~ s/^((\s+)|(\.+\/))+//; $file =~ s/\s+$//; next unless $file; unless ($file =~ /^\//) { die "$CONF \$SECURITY_POLICY_DIR ", gettext("not given, cannot find"), " $file\n" unless $Pdir; $file = "${Pdir}/${file}"; } warn "$INFO ", gettext("policy"), " $file\n" if $dbg; if (open(POLICY,"<$file")) { while () { s/#.*//; # no hashes in filenames! if (($glob, $policy) = /^\s*(\S+)\s+(\S+)/) { $policy =~ s/^([a-np-z]*)O/$1/ig; # ignore O, we know better unless ($policy =~ /^[b-z]*[AMSP]/i) { warn "$CONF ", gettext("no valid primary policy in"), " \"$policy\"\n"; warn "$CONF ...file $file, glob $glob\n"; warn "$CONF ...", gettext("defaulting to"), " $default_policy\n"; $policy = $default_policy; } die "$CONF \$SECURITY_QUARANTINE_DIR ", gettext("not given"), "\n" if $policy =~ /^[a-z]*SQ/i && ! $Qdir; die "$CONF \$SECURITY_QUARANTINE ", gettext("not given"), "\n" if $policy =~ /^[a-z]*PQ/i && ! $Qbox; die "$CONF \$SECURITY_FILENAME_LOG ", gettext("not given"), "\n" if $policy =~ /^[a-z]*L/i && ! $Flog; $glob =~ s/([^\\])\./$1\\./g; $glob =~ s/\*/.*/g; $glob =~ s/\?/./g; push(@@Policy, "${glob}\034${policy}"); warn "$INFO $glob $policy\n" if $dbgv; } } close(POLICY); } else { warn "$WARN ", gettext("could not open"), " $file: $!"; } } if ($dbgv) { warn "$INFO *** ", gettext("policy dump"), " ***\n"; for (@@Policy) { warn "$INFO $_\n"; } } warn "$WARN ", gettext("no policy defined"), " - ", gettext("defaulting to"), " $default_policy\n" unless @@Policy; } else { warn "$WARN ", gettext("no policy files defined by"), " \$SECURITY_POLICY - ", gettext("defaulting to"), " $default_policy\n"; } } unless (%RFC822maxlen) { # read it only once warn "$INFO ", gettext("reading RFC822 length limits"), "\n" if $dbg; $RFC822maxlen{"DATE"} = $RFC822maxlen{"FROM"} = $RFC822maxlen{"STATUS"} = $RFC822maxlen{"SUBJECT"} = $RFC822maxlen{"X-STATUS"} = $RFC822maxlen{"X-KEYWORDS"} = $RFC822maxlen{"MESSAGE-ID"} = $RFC822maxlen{"RESENT-DATE"} = $RFC822maxlen{"MIME-VERSION"} = 250; if ($file = $ENV{"SECURITY_RFC822_MAXLEN"}) { unless ($file =~ /^\//) { die "$CONF \$SECURITY_POLICY_DIR ", gettext("not given, cannot find"), " $file\n" unless $Pdir; $file = "${Pdir}/${file}"; } warn "$INFO RFC822 maxlen $file\n" if $dbg; if (open(POLICY,"<$file")) { while () { s/#.*//; # no hashes in filenames! if (($header, $maxlen) = /^\s*(\w+):\s*(\d+)/) { if ($maxlen > 32) { warn "$INFO $header maxlen $maxlen\n" if $dbgv; $RFC822maxlen{"\U$header"} = $maxlen; } else { warn "$CONF $header maxlen $maxlen ", gettext("is too short"), "\n"; } } } close(POLICY); } else { warn "$WARN ", gettext("could not open"), " $file: $!"; } } else { warn "$WARN \$SECURITY_RFC822_MAXLEN ", gettext("not given, using defaults"), "\n" if $dbgv; } } } sub decodefilename { # decode RFC2047-encoded text my($filename, $junk) = @@_; my($dec, $cset, $charset, $enc, $encoding, $enw); if ($filename =~ /^=\?.*\?=$/s) { warn "$INFO ", gettext("decoding filename"), " \"$filename\"\n" if $dbg; $dec = ""; while (($cset, $enc, $enw) = $filename =~ /^=\?([-\w]+)\?([a-z])\?([^?\s]+)\?=\s*/is) { $charset = "\U$cset"; $encoding = "\U$enc"; if ($encoding eq "Q") { $dec .= decode_qp($enw); } elsif ($encoding eq "B") { $dec .= decode_base64($enw); } else { warn "MIME: \"$filename\" ", gettext("uses unrecognized text encoding"), " \"$encoding\"\n"; $dec .= $enw; } $filename =~ s/^=\?[-\w]+\?[a-z]\?[^?\s]+\?=\s*//is; } $filename = $dec; warn "$INFO ", gettext("decoded filename"), " \"$filename\"\n" if $dbg; die "$FATAL ", gettext("catastrophic failure in"), " decodefilename()\n" unless $filename; } return wantarray? ($filename, $charset, $encoding) : $filename; } sub checkfilename { # see if file has a policy # if not, default to $default_policy # if a Microsoft Office document, tag for the VBA scanner my($filename, $junk) = @@_; my($glob, $policy, $dec, $enc, $enw, $scan, $handling); $handling = $scan = ""; $filename = decodefilename($filename); $scan = "O" if $filename =~ /\.(do[ct]|xl[swt]|p[po]t|rtf|pps)$/i; $filename =~ s/\\\001/\\"/sg; warn "$INFO ", gettext("scanning for policy for filename"), " \"$filename\"\n" if $dbg; for (@@Policy) { ($glob, $policy) = split(/\034/); warn "$INFO ", gettext("glob"), " \"$glob\"\n" if $dbgv; if ($filename =~ /^${glob}$/i) { $handling = "${scan}${policy}"; last; } } unless ($handling) { warn "$WARN ", gettext("no policy found for"), " \"$filename\" - ", gettext("defaulting to"), " $default_policy\n"; $handling = "${scan}${default_policy}"; } warn "$INFO ", gettext("policy"), ": \"$handling\"\n" if $dbgv; if ($handling =~ /^[a-z]*L/i) { if (open (FLOG, ">>$Flog")) { print FLOG "$MSGID $filename\n"; close(FLOG); } } return $handling; } sub setMIMEboundary { # set the current MIME boundary string # save the previous # do length-limiting, etc. my($bndry, $junk) = @@_; if ($gotboundary) { push @@boundariestoolong, $boundarytoolong; push @@mimeboundaries, $mimeboundary; push @@newboundaries, $newboundary; push @@nullboundaries, $nullboundary; } $bndry =~ s/(^"|"$)//g; $newboundary = $mimeboundary = $bndry; $boundarytoolong = $nullboundary = 0; $gotboundary++; warn "$INFO ", gettext("boundary"), " $gotboundary = \"$mimeboundary\"\n" if $dbgv; if ($boundarytoolong = (length($mimeboundary) > 80)) { push (@@MsgLog, "\n", gettext("MIME boundary string is excessively long."), " ", gettext("Possible buffer overflow attack."), "\n"); warn "MIME: ", gettext("truncating long boundary string"), "\n"; $newboundary = substr($mimeboundary,0,64); } elsif ($nullboundary = (length($mimeboundary) < 1)) { push (@@MsgLog, "\n", gettext("MIME boundary string explicitly empty."), " ", gettext("Denial-of-Service attack."), "\n"); warn "MIME: ", gettext("replacing null boundary string"), "\n"; $newboundary = "==NULL_MIME_BOUNDARY_SANITIZED-${HOST}-${$}-${gotboundary}=="; } $mimeboundary = quotemeta($mimeboundary); warn "$INFO ", gettext("boundary"), " $gotboundary = \"$mimeboundary\"\n" if $dbgv; } sub popMIMEboundary { $gotboundary--; $boundarytoolong = pop @@boundariestoolong; $mimeboundary = pop @@mimeboundaries; $newboundary = pop @@newboundaries; $nullboundary = pop @@nullboundaries; } sub resetbodypart { # clean up BodyPart temporary file if necessary if ($BodyPart && !$BodyPartSize && -f $BodyPart) { unlink($BodyPart) || warn "$WARN ", gettext("could not remove"), " $BodyPart: $!"; } $BodyPart = ""; $BodyPartSize = 0; $BNDRY = ""; } sub readheaders { # read lines until blank line # if line begins with whitespace, append to previous line # retain the whitespace and \n for writing it back out # add finished line to headers array my($SRC, $Headers, $junk) = @@_; my($hdr); @@$Headers = (); $hdr = ""; while (<$SRC>) { if (/^\s*$/) { if (@@$Headers) { # blank line and had some headers; end of headers if ($hdr) { warn "$INFO ", gettext("saved header"), " \"$hdr\"\n" if $dbgv; push(@@$Headers, $hdr); } return; } else { # skip blank lines before headers next; } } elsif (/^\s/) { # indented - append to prev partial hdr $hdr .= " $_"; } else { # normal header line if ($hdr) { warn "$INFO ", gettext("saved header"), " \"$hdr\"\n" if $dbgv; push(@@$Headers, $hdr); } $hdr = $_; } } # Eep. should not hit EOF in this routine... die "$FATAL ", gettext("catastrophic failure in"), " readheaders()\n"; return; } sub doRFC822headers { # state: reading RFC822 headers and setting up to process body my($SRC, $Headers, $MSGID, $HasMIME, $junk) = @@_; my($hdr, $junk, $index, $header, $maxlen); warn "$INFO ", gettext("reading RFC822 headers"), "\n" if $dbg; readheaders($SRC, $Headers); $index = $$HasMIME = 0; foreach $hdr (@@$Headers) { warn "$INFO ", gettext("RFC822 header"), " \"$hdr\"\n" if $dbgv; if ($hdr =~ /`\s*`/sg) { # Unix shell escape attack push (@@MsgLog, "\n", gettext("Header contained double backquotes."), " ", gettext("Possible UNIX shell-script attack."), "\n", gettext("Original value:"), " \"$hdr\"", "\n"); warn "MIME: ", gettext("fixing double backquotes"), "\n"; $hdr =~ s/`[\s\n]*`/\\"/sg; } if (($junk) = $hdr =~ /^Message-ID\s*:\s.*(<[^@@>]+@@[^>]+>)/i) { $$MSGID = $junk unless $$MSGID; } ($header) = $hdr =~ /^(\w+)\s*:/; $maxlen = $RFC822maxlen{"\U$header"}; if ($maxlen && length($hdr) > $maxlen) { push (@@MsgLog, "\n", gettext("Message header is excessively long."), " ", gettext("Possible buffer overflow attack."), "\n", gettext("Original value:"), " \"$hdr\"", "\n"); warn "RFC822: ", gettext("truncating long header"), " $hdr\n"; $hdr = chomp(substr($hdr, 0, $maxlen)) . "\n"; } next if $$HasMIME; if ($hdr =~ /^MIME-Version\s*:\s/i) { $$HasMIME = 1; $junk = "X-Security: " . gettext("message sanitized on") . " $HOST " . localtime() . "\n"; $junk .= "\t" . gettext("See") . " http://www.impsec.org/email-tools/procmail-security.html\n"; $junk .= "\t" . gettext("for details.") . " \$Revision: 0.45 $x\n"; warn "$INFO ", gettext("adding header(s)"), "\n" if $dbgv; splice (@@$Headers, $index++, 0, $junk); unless ($Qdir && $Qbox) { $junk = "X-Security: " . gettext("the postmaster has not enabled quarantine support") . "\n"; splice (@@$Headers, $index++, 0, $junk); } } $index++; } } sub doMIMEheaders { # state: reading MIME headers and sanitizing them # setting up to process body my($SRC, $Headers, $junk) = @@_; my($hdr, $index, $hname, $Hname, $hdata, $cth, $ceh, $mangle_mime_type, $filename, $oldfilename, $newfilename, $dispfilename, $policy, $handling, $logfiles, $depthatentry, $junk2, $nulls, $cset, $enc); if (@@$Headers) { warn "$INFO ", gettext("Processing MIME headers"), "\n" if $dbg; } else { warn "$INFO ", gettext("Reading MIME headers"), "\n" if $dbg; readheaders($SRC, $Headers); } $policy = $handling = $logfiles = $MIMEencoding = $MIMEtype = $MIMEsubtype = ""; $mangle_mime_type = $index = 0; $depthatentry = $gotboundary; resetbodypart(); foreach $hdr (@@$Headers) { warn "$INFO ", gettext("MIME header"), " \"$hdr\"\n" if $dbgv; $hdr =~ s/([^\\])\\"/$1\\\001/sg; # hide escaped quotes to simplify things if (($junk) = $hdr =~ /^Content-Transfer-Encoding\s*:\s+([78]bit|binary|quoted-printable|base64|x-uuencode)/is) { $MIMEencoding = "\U$junk"; if ($ceh) { warn "MIME ", gettext("Multiple Content-Transfer-Encoding headers"), "\n"; } else { $ceh = \$hdr; } } if (($hname, $hdata) = $hdr =~ /^(Content-[a-z0-9-]+)\s*:\s+(\S.*)/si) { $Hname = "\U$hname"; if ($hdr =~ /`\s*`/) { # Unix shell escape attack push (@@MsgLog, "\n", gettext("Header contained double backquotes."), " ", gettext("Possible UNIX shell-script attack."), "\n", gettext("Original value:"), " \"$hdr\"", "\n"); warn "MIME: ", gettext("fixing double backquotes"), "\n"; $hdr =~ s/`\s*`/\\"/sg; } for ($hdr =~ /\s(\S+)\s*=\s*""/sgi) { $junk = $_; push (@@MsgLog, "\n", gettext("Header contained null value."), " ", gettext("Denial-of-Service attack."), "\n", gettext("Header: "), "${hname}: ${junk}=\"\"", "\n"); warn "MIME: ", gettext("null value in header"), " ${hname}: ${junk}=\"\"\n"; $junk2 = quotemeta($junk); $nulls = gettext("null value sanitized") unless $nulls; $hdr =~ s/\s${junk2}\s*=\s*""(;?\s)\s*/ X-${junk}="[${nulls}]"$1/sgi; } if ($hdr =~ /name\s*=\s*"[^"]+$/is) { warn "MIME: ", gettext("fixing missing close quote on filename"), "\n"; $hdr =~ s/$/"/; } for ($hdr =~ /name\s*=\s*([^"\s][^;]+)/sgi) { s/\s+$//; $junk = $newfilename = $filename = $_; $junk =~ s/\\\001/\\"/sg; warn "MIME: ", gettext("fixing unquoted filename"), " \"${junk}\"\n"; if ($newfilename =~ /\([^)]*\)/ && $newfilename !~ /^=\?/) { push (@@MsgLog, "\n", gettext("MIME body part name contained an RFC822 comment."), " ", gettext("Possible attempt to bypass filename filtering."), "\n", gettext("Original name: "), $junk, "\n"); warn "MIME: ", gettext("filename contains embedded RFC822 comment - removing"), "\n"; $newfilename =~ s/\([^)]*\)//g; $junk = $newfilename; $junk =~ s/\\\001/\\"/sg; push (@@MsgLog, gettext("New name: "), $junk, "\n"); } $newfilename =~ s/\"/\\\001/g; # escape quotes embedded in filename $filename = quotemeta($filename); $hdr =~ s/name\s*=\s*${filename}\s*/name="${newfilename}"/sgi; } for ($hdr =~ /name\s*=\s*"([^"]{250,})"/sgi) { $junk = $filename = $_; $junk =~ s/\\\001/\\"/sg; push (@@MsgLog, "\n", gettext("MIME body part name is excessively long."), " ", gettext("Possible buffer overflow attack."), "\n", gettext("Original name: "), $junk, "\n"); warn "MIME: ", gettext("truncating long filename"), " \"${junk}\".\n"; ($junk, $cset, $enc) = decodefilename($filename); $newfilename = substr($junk, 0, 200); # TODO: what if "extension" is very long? # preserve the extension, if any if ($junk =~ /\.[-a-z0-9{}]+$/) { $junk =~ s/^.+\.//; $newfilename .= ".$junk"; } # restore encoding, if any if ($enc eq "Q") { $newfilename = "=?${cset}?Q?" . encode_qp($newfilename) . "?="; $newfilename =~ s/=\n//sg; } elsif ($enc eq "B") { $newfilename = "=?${cset}?B?" . encode_base64($newfilename) . "?="; $newfilename =~ s/\s+//sg; } $junk = $newfilename; $junk =~ s/\\\001/\\"/sg; push (@@MsgLog, gettext("New name: "), $junk, "\n"); $filename = quotemeta($filename); $hdr =~ s/name\s*=\s*"${filename}"/name="${newfilename}"/sgi; $mangle_mime_type = 1; } for ($hdr =~ /name\s*=\s*"([^"]+)"/sgi) { $newfilename = $filename = $_; $junk = checkfilename($filename); ($policy, $logfiles) = $junk =~ /^([a-z]+)(:.+)?$/i; # if different names are used in multiple name= clauses, # different policies may match - keep them all $handling .= $policy; if ($policy =~ /M/i) { $junk = $filename; $junk =~ s/\\\001/\\"/sg; $oldfilename = decodefilename($junk); push (@@MsgLog, "\n", gettext("MIME body part name is being mangled due to site security policy."), "\n", gettext("Original name: "), $oldfilename, "\n"); warn "MIME: ", gettext("mangling filename"), " \"${junk}\".\n"; # if filename is encoded, encode the mangling if ($filename =~ /=\?[-_a-z0-9]+\?[a-z]\?/i) { $newfilename = "$filename =?ISO-8859-1?Q?" . encode_qp("-${DEFANG}") . "?="; } else { $newfilename = "${filename}-${DEFANG}"; } $junk = $newfilename; $junk =~ s/\\\001/\\"/sg; $junk = decodefilename($junk); push (@@MsgLog, gettext("New name: "), $junk, "\n"); $filename = quotemeta($filename); $hdr =~ s/name\s*=\s*"${filename}"/name="${newfilename}"/sgi; $mangle_mime_type = 1; $newfilename = $junk; } if ($Hname eq "CONTENT-DISPOSITION") { if ($dispfilename) { warn "MIME ", gettext("Multiple Content-Disposition headers/filenames"), "\n"; } else { $dispfilename = $newfilename; } } # TODO don't do this here? # there's lots more %x stuff to interpolate after the attachment has been dealt with # but does it apply for mangling? # make this a parameterized subroutine # it should also accept multiple colon-delimited filenames for ($logfiles =~ /:([^:]+)/) { # interpolate a custom status message $junk = $_; $junk =~ s/^(\.+\/)*//; # strip leading ../../ if ($junk =~ /^[^\/]/) { # relative filename may only be in policy dir if ($Pdir) { $junk = "${Pdir}/${junk}"; } else { warn "$CONF \$SECURITY_POLICY_DIR ", gettext("not given, cannot find"), " $junk\n"; $junk = ""; } } if ($junk) { if (-f $junk) { if (-r $junk) { if (open(NOTE,"<$junk")) { while () { s/\%f/${oldfilename}/g; s/\%m/${newfilename}/g; push (@@MsgLog, $_); } close (NOTE); } else { warn "$WARN ", gettext("error attempting to read"), " $junk : $!\n"; } } else { warn "$CONF \"$junk\": ", gettext("not readable"), "\n"; } } else { warn "$CONF \"$junk\": ", gettext("not a file"), "\n"; } } } } if ($Hname eq "CONTENT-TYPE") { if ($cth) { warn "MIME ", gettext("Multiple Content-Type headers"), "\n"; } else { $cth = \$hdr; } if (($junk, $junk2) = $hdata =~ /^([-\w]+)\/([^";\s]+)/is) { $MIMEtype = "\U$junk"; $MIMEsubtype = "\U$junk2"; if (($junk) = $hdata =~ /multipart\/.*boundary\s*=\s*(("")|("[^"]+")|([^"]\S+))/is) { setMIMEboundary($junk); $hdr =~ s/${mimeboundary}/${newboundary}/ if $boundarytoolong; $hdr =~ s/boundary[\s\n]*=[\s\n]*""/boundary="${newboundary}"/is if $nullboundary; } if ($mangle_mime_type) { warn "$INFO ", gettext("Mangling MIME type"), "\n" if $dbg; $junk = "${MIMEtype}/${MIMEsubtype}"; warn "$INFO ", gettext("adding header(s)"), "\n" if $dbgv; push (@@Headers, $SANHDR . gettext("original") . " Content-Type: $junk\n"); $junk = quotemeta($junk); $hdr =~ s/${junk}/APPLICATION\/OCTET-STREAM/sgi; $hdr =~ s/\stype\s*=\s*"/ X-type="/sgi; # remove x-mac-* clauses to prevent # Eudora restoring the file type $junk = ""; for ($hdata =~ /(\sx-mac-\S+\s*=\s*\S+;?)/sgi) { $junk .= $_; $junk2 = quotemeta($_); $hdr =~ s/${junk2}//sgi; } $junk =~ s/\s+/ /sg; push (@@Headers, $SANHDR . gettext("removed") . ": $junk\n") if $junk; } } if (length($hdr) > 500) { push (@@MsgLog, "\n", "Content-Type ", gettext("header is excessively long."), " ", gettext("Possible buffer overflow attack."), "\n", gettext("Original value: "), $hdata, "\n"); warn "MIME: ", gettext("truncating long header"), ": $hname\n"; $junk = $hdr; $junk =~ s/\\\001/\\"/g; $junk =~ s/\s+/ /g; $hdr = "Content-Type: X-BOGUS/X-BOGUS\n"; warn "$INFO ", gettext("adding header(s)"), "\n" if $dbgv; splice (@@Headers, $index++, 0, $SANHDR . gettext("excessively long header") . ": " . substr($junk,0,400) . "...\n"); $mangle_mime_type = 0; } } else { if (length($hdata) > 500) { push (@@MsgLog, "\n", "$hname ", gettext("header is excessively long."), " ", gettext("Possible buffer overflow attack."), "\n", gettext("Original value: "), $hdata, "\n"); warn "MIME: ", gettext("truncating long header"), ": $hname\n"; $hdr =~ s/\s+/ /sg; $hdr = $SANHDR . gettext("excessively long header") . ": " . substr($hdr,0,400) . "...\n"; } } } $hdr =~ s/\\\001/\\"/sg; $hdr =~ s/\n\s+/\n\t/sg; $index++; } unless ($MIMEtype =~ /^(multipart|message)/i) { if ($cth) { # make sure content-type header has a name # we wait until now to do this so that we can # use the attachment filename from the content-disposition header # some MIME builders only put the filename there, so if # it's there, copy it rather than naming the body part # "default.txt" unless ($$cth =~ /[;\s]name\s*=\s*"/is) { warn "MIME: ", gettext("supplying default filename"), "\n" unless $dispfilename; $$cth =~ s/\s*$/;\n/ unless $$cth =~ /;\s*$/; $$cth .= "\tname=\"" . ($dispfilename? $dispfilename : "default.txt") . "\";\n"; $$cth =~ s/\\\001/\\"/sg; } } } # Okay, at this point we should know the MIME type and encoding of the body part warn "$INFO Content-Type: $MIMEtype/$MIMEsubtype\n" if $dbgv; warn "$INFO Content-Transfer-Encoding: $MIMEencoding\n" if $dbgv; warn "$INFO ", gettext("policy"), ": $handling\n" if $dbgv; # Let's figure out what to do with it... # TODO it should be possible to define this stuff in a table # and use function references # TODO move this out of this function if ($MIMEtype eq "MESSAGE") { if ($MIMEsubtype eq "RFC822") { warn "$INFO ", gettext("recursing into attached RFC822 message"), "\n" if $dbg; for (@@Headers) { print $_; } print "\n"; doRFC822headers(); } } elsif ($MIMEtype eq "TEXT") { $junk = ""; getbodypart(); writebodypart($junk, $MIMEencoding); if ($junk =~ //si && ! $ENV{"SECURITY_TRUST_HTML"}) { $_ = $junk; s/<(META|APP|SCRIPT|OBJECT|EMBED|FRAME|IFRAME|LAYER)\s/\s+)?<\/STYLE>/ --> <\/DEFANGED_STYLE>/sgi; s/\sSTYLE\s*=/ DEFANGED_STYLE=/sgi; } unless ($ENV{"SECURITY_TRUST_WEBBUGS"}) { s/) { last if /^--${mimeboundary}(--)?$/; if ($BodyPartSize || !$BodyPart) { $BodyPart .= $_; $BodyPartSize += length($_); if ($BodyPartSize > $MAX_BP_SZ) { # Reading large attachment, redirect to file warn "$INFO ", gettext("large MIME body part, redirecting to temporary file"), "\n"; if (($bfileh, $bfilen) = mkstempt("sanitizer-XXXXXXXX", $TEMP)) { warn "$INFO $bfilen\n" if $dbgv; } else { # not possible to create temporary file die "$WARN ", gettext("error attempting to create temporary file"), ": $!\n"; } print $bfileh $BodyPart; $BodyPart = $bfilen; $BodyPartSize = 0; } } else { print $bfileh $_; } } if ($bfileh) { $bfileh->close; } else { warn "$INFO \"$BodyPart\"\n" if $dbgv; } $BNDRY = $_; } sub writebodypart { # copy the body part to a file or variable, possibly decoding # caller must open and close file my ($dest, $encoding, $junk) = @@_; my ($enc, $tofile); $tofile = $enc = 0; $encoding = "\U$encoding"; $enc = 1 if $encoding eq "BASE64"; $enc = 2 if $encoding eq "QUOTED-PRINTABLE"; $enc = 3 if $encoding eq "X-UUENCODE"; # MS-ism if ($dest) { $tofile = 1; } else { $dest = \$_[0]; } warn "$INFO \$enc=$enc \$tofile=$tofile\n" if $dbgv; if ($BodyPart) { if ($BodyPartSize) { # in memory if ($enc == 1) { if ($tofile) { print $dest decode_base64($BodyPart); } else { $$dest = decode_base64($BodyPart); } } elsif ($enc == 2) { if ($tofile) { print $dest decode_qp($BodyPart); } else { $$dest = decode_qp($BodyPart); } } elsif ($enc == 3) { if ($tofile) { print $dest unpack("u", $BodyPart); } else { $$dest = unpack("u", $BodyPart); } } else { if ($tofile) { print $dest $BodyPart; } else { $$dest = $BodyPart; } } } else { # in temporary file if (open(BP,"<$BodyPart")) { while () { if ($enc == 1) { if ($tofile) { print $dest decode_base64($_); } else { $$dest .= decode_base64($_); } } elsif ($enc == 2) { if ($tofile) { print $dest decode_qp($_); } else { $$dest .= decode_qp($_); } } elsif ($enc == 3) { if ($tofile) { print $dest unpack("u", $_); } else { $$dest .= unpack("u", $_); } } else { if ($tofile) { print $dest $_; } else { $$dest .= $_; } } } close(BP); } } return TRUE; } else { warn "$WARN ", gettext("internal error: attempt to write body part before reading it"), "\n"; return FALSE; } return TRUE; } sub passbodypart { # stream the current body part out to get to the next body part if ($BodyPart) { # already been read, stream it out if ($BodyPartSize) { # in memory print $BodyPart; } else { # in file if (open(BP,"<$BodyPart")) { while () { print $_; } close(BP); } } } else { # streaming from STDIN while (<>) { last if /^--${mimeboundary}(--)?$/; print $_; } $BNDRY = $_; } resetbodypart(); } sub discardbodypart { # discard everything up to the next boundary string # if $BodyPart exists, discard it instead of reading from STDIN my ($origname, $junk) = @@_; push (@@MsgLog, "\n", gettext("Discarding MIME body part."), "\n", gettext("Original name: "), $origname, "\n") if $origname; warn "$INFO ", gettext("Discarding MIME body part."), "\n"; unless ($BodyPart) { # if we haven't already read the body part, read and discard it. while (<>) { last if /^--${mimeboundary}(--)?$/; } $BNDRY = $_; } resetbodypart(); } sub quarantinebodypart { # quarantine the body part, decoding if appropriate my ($origname, $encoding, $junk) = @@_; my ($qfileh, $qfilen); push (@@MsgLog, "\n", gettext("Quarantining MIME body part."), "\n", gettext("Original name: "), $origname, "\n") if $origname; warn "$INFO ", gettext("Quarantining MIME body part."), "\n"; unless ($Qdir) { # not possible to quarantine push (@@MsgLog, "\n", gettext("Due to a sanitizer configuration error"), " ", gettext("the MIME body part could not be quarantined and will be discarded."), "\n", gettext("Please notify your system administrator."), "\n"); warn "$CONF \$SECURITY_QUARANTINE_DIR ", gettext("not given, cannot quarantine body part"), "\n"; discardbodypart(); return ""; } $origname =~ s/\//_/g; unless (($qfileh, $qfilen) = mkstempt($Qtemplate . $origname . "-XXXXXXXX", $Qdir)) { # not possible to quarantine push (@@MsgLog, "\n", gettext("Due to a system error"), " ", gettext("the MIME body part could not be quarantined and will be discarded."), "\n", gettext("The system error was:"), " $!", "\n", gettext("Please notify your system administrator."), "\n"); warn "$WARN ", gettext("error attempting to quarantine"), ": $!\n"; discardbodypart(); return ""; } push (@@MsgLog, "\n", gettext("Quarantine file name:"), " $qfilen", "\n"); warn "$INFO ", gettext("Quarantine file name:"), " $qfilen\n"; writebodypart($qfileh, $encoding); $qfileh->close; resetbodypart(); return $qfilen; } sub savebodypart { # copy the body part to a file, decoding if appropriate # return the file name my ($encoding, $junk) = @@_; my ($tfileh, $tfilen); if (($tfileh, $tfilen) = mkstempt("sanitizer-XXXXXXXX", $TEMP)) { writebodypart($tfileh, $encoding); $tfileh->close; return $tfilen; } else { # not possible to create temporary file warn "$WARN ", gettext("error attempting to create temporary file"), ": $!\n"; return ""; } } initialize(); readpolicy(); for (@@ARGV) { print "$_ = ", checkfilename($_), "\n"; } @@ARGV = (); doRFC822headers(); # temporary if (@@MsgLog) { for (@@MsgLog) { print $_; } } exit; if ($mimeboundary || ($gotboundary && $nullboundary) || $inmimehdr) { if (/^\s*$/) { $inmimehdr = 0; if ($recursemsg) { push @@mimeboundaries, $mimeboundary; push @@newboundaries, $newboundary; push @@rawboundaries, $rawboundary; push @@boundariestoolong, $boundarytoolong; push @@gotboundaries, $gotboundary; push @@nullboundaries, $nullboundary; $mimeboundary = $newboundary = ""; $recursemsg = $pastmsghdr = $boundarytoolong = $gotboundary = 0; } } elsif (/^--${mimeboundary}(--)?$/) { $mend = $1; s/${mimeboundary}/${newboundary}/ if $boundarytoolong; s/^--/--${newboundary}${mend}/ if $nullboundary; if ($mend) { if ($mimeboundaries[0]) { warn " End of RFC822/Multipart attachment.\n" if $ENV{"DEBUG"}; $mimeboundary = pop @@mimeboundaries; $newboundary = pop @@newboundaries; $rawboundary = pop @@rawboundaries; $boundarytoolong = pop @@boundariestoolong; $gotboundary = pop @@gotboundaries; $nullboundary = pop @@nullboundaries; } } else { $inmimehdr = 1; $recursemsg = $strip_attachment = $check_attachment = 0; } } elsif (!$inmimehdr && $strip_attachment) { $_ = ""; } elsif (!$inmimehdr && $check_attachment) { $check_attachment = 0; if ($destf = `mktemp /tmp/mailchk.XXXXXX`) { chomp($destf); if (open(DECODE,"|mimencode -u -o $destf")) { do { print $_; print DECODE $_; $_ = <>; $lastline = $_; } until (/^\s*$/ || /^--/); close(DECODE); # Run virus-checker here. open(ATTCH,"< $destf"); $msapp = $score = 0; @@scores = (); while () { $score+= 99 if /\000VirusProtection/i; $score+= 99 if /\000select\s[^\000]*shell\s*\(/i; $score+= 9 if /\000regedit/i; $score+= 9 if /\000SaveNormalPrompt/i; $score+= 9 if /\000Outlook.Application\000/i; $score+= 9 if /\000CountOfLines/i; $score+= 9 if /\000AddFromString/i; $score+= 9 if /\000StartupPath/i; $score+= 4 if /\000ID="{[-0-9A-F]+$/i; $score+= 4 if /\000CreateObject/i; $score+= 4 if /(\000|\004)([a-z0-9_]\.)*(Autoexec|Workbook_(Open|BeforeClose|Window(De)?activate)|Document_(Open|New|Close))/i; $score+= 4 if /(\000|\004)(Logon|AddressLists|AddressEntries|Recipients|Attachments|Logoff)/i; $scores[0] = 4 if /(\000|\004)(Subject|Body)/i; $score+= 2 if /\000Shell/i; $score+= 2 if /\000Options[^\w\s]/i; $score+= 2 if /\000CodeModule/i; $score+= 2 if /\000([a-z]+\.)?Application\000/i; $score+= 2 if /(\000|\004)stdole/i; $score+= 2 if /(\000|\004)NormalTemplate/i; $score+= 2 if /\000ID="{[-0-9A-F]+}"/i; $score+= 1 if /\000ThisWorkbook\000/i; $score+= 1 if /\000PrivateProfileString/i; $score+= 1 if /(\000|\004)(ActiveDocument|ThisDocument|ThisWorkbook)/i; $score+= 1 if /\000\[?HKEY_(CLASSES_ROOT|CURRENT_USER|LOCAL_MACHINE)/; $msapp+= 1 if /\000(Microsoft (Word Document|Excel Worksheet|Excel|PowerPoint)|MSWordDoc|Word\.Document\.[0-9]+|Excel\.Sheet\.[0-9]+)\000/; } close(ATTCH); unlink($destf); if ($msapp) { for (@@scores) { $score += $_; } if ($histfile = $ENV{"SCORE_HISTORY"}) { if (open(HIST,">>$histfile")) { print HIST "score=$score msgid=".$ENV{"MSGID"}." from=".$ENV{"FROM"}."\n"; close HIST; } } $poison_score = $ENV{"POISONED_SCORE"}; $poison_score = 5 if $poison_score < 5; if ($score > $poison_score && !$ENV{"SCORE_ONLY"}) { warn " POSSIBLE MACRO EXPLOIT: Score=$score\n"; print "\n\n--$rawboundary\n"; print "Content-Type: TEXT/PLAIN;\n"; print "X-Content-Security: NOTIFY\n" if $ENV{"SECURITY_NOTIFY"} || $ENV{"SECURITY_NOTIFY_VERBOSE"}; print "X-Content-Security: REPORT: Trapped poisoned Microsoft attachment\n" if $ENV{"SECURITY_NOTIFY"} || $ENV{"SECURITY_NOTIFY_VERBOSE"}; print "X-Content-Security: QUARANTINE\n" if $ENV{"SECURITY_QUARANTINE"}; print "Content-Description: SECURITY WARNING\n\n"; print "SECURITY WARNING!\n"; print "The mail delivery system has detected that the preceding\n"; print "document attachment appears to contain hazardous macro code.\n"; print "Macro Scanner score: $score\n"; print "Contact your system administrator immediately!\n\n"; } } else { $score = 0; } if ($lastline =~ /^--${mimeboundary}(--)?$/) { $inmimehdr = 1; $check_attachment = 0; $lastline =~ s/${mimeboundary}/${newboundary}/ if $boundarytoolong; } print $lastline; } else { warn "*** Cannot decode attachment: $! - is mimencode installed?\n"; } } else { warn "*** Cannot extract attachment - is mktemp installed?\n"; } } if ($inmimehdr || $hdrcnt) { if (/^(\s+\S|(file)?name)/) { s/^\s*/ /; s/^\s*// if $hdrtxt =~ /"[^"]*[^;]$/; s/\s*\n$//; $hdrtxt .= $_; $_ = ""; } else { if ($hdrtxt) { while (($hdr, $val) = $hdrtxt =~ /^([-\w]+)\s*:.*\s(\S+)\s*=\s*""/i) { warn " Null $val in $hdr header.\n"; $sval = quotemeta($val); $hdrtxt =~ s/\s$sval\s*=\s*""/ X-$val="{null value sanitized}"/; } while (($junk,$filen) = $hdrtxt =~ /^Content-[-\w]+\s*:[^"]*("[^"]*"[^"]+)*name\s*=\s*([^"\s][^;]+)/i) { warn " Fixing unquoted filename \"$filen\".\n"; $newfilen = $filen; $newfilen =~ s/\"/\\"/g; if ($newfilen =~ /\([^)]*\)/) { warn " Filename contains embedded RFC822 comment - removing.\n"; $newfilen =~ s/\([^)]*\)//g; } $filen = quotemeta($filen); $hdrtxt =~ s/name\s*=\s*${filen}/name="$newfilen"/ig; } while (($filen) = $hdrtxt =~ /^Content-[-\w]+\s*:.*name\s*=\s*"(=\?[^"]+=2E[^"]+\?=)"/i) { warn " Fixing encoded periods in \"$filen\".\n"; $newfilen = $filen; $newfilen =~ s/=2E/./ig; $filen = quotemeta($filen); $hdrtxt =~ s/name\s*=\s*"${filen}"/name="$newfilen"/ig; } while (($filen) = $hdrtxt =~ /^Content-[-\w]+\s*:.*name\s*=\s*"([^"]{120})[^"]{16,}"/i) { warn " Truncating long filename \"$filen...\".\n"; $filen .= "..."; $filen .= "?=" if $filen =~ /^=\?/; $hdrtxt =~ s/name\s*=\s*"[^"]{128,}"/name="$filen"/i; $mangle_mime_type = 1; } if (($mtype) = $hdrtxt =~ /Content-Type:\s+([a-z0-9-_]+\/[a-z0-9-_]+)/i) { unless ($mtype =~ /^(multipart|text|message)\//i) { unless ($hdrtxt =~ /name\s*=\s*"/i) { warn "*** Supplying default filename.\n"; $hdrtxt .= "; " unless $hdrtxt =~ /;\s*$/; $hdrtxt .= "name=\"default\";"; } } } if (($filen) = $hdrtxt =~ /^Content-[-\w]+\s*:.*name\s*=\s*"([^"]+\.(do[ct]|xl[swt]|p[po]t|rtf|pps)(\?=)?)"/i) { warn " Scanning \"$filen\".\n"; if (!$poisoned && ($specf = $ENV{"POISONED_EXECUTABLES"})) { if (open(POISONED,$specf)) { while (chomp($poisoned_spec = )) { $poisoned_spec =~ s/^\s+//g; $poisoned_spec =~ s/\s+$//g; next unless $poisoned_spec; $poisoned_spec =~ s/([^\\])\./$1\\./g; $poisoned_spec =~ s/\*/.*/g; $poisoned_spec =~ s/\?/./g; $poisoned_spec .= "(\\?=)?"; warn "Checking against \"$poisoned_spec\"\n" if $ENV{"DEBUG"}; if ($filen =~ /^${poisoned_spec}$/i) { warn " Trapped poisoned document \"$filen\".\n"; $poisoned = 1; print "Content-Type: TEXT/PLAIN;\n"; print "X-Content-Security: NOTIFY\n" if $ENV{"SECURITY_NOTIFY"} || $ENV{"SECURITY_NOTIFY_VERBOSE"}; print "X-Content-Security: REPORT: Trapped poisoned Microsoft attachment \"$filen\"\n" if $ENV{"SECURITY_NOTIFY"} || $ENV{"SECURITY_NOTIFY_VERBOSE"}; print "X-Content-Security: QUARANTINE\n" if $ENV{"SECURITY_QUARANTINE"}; print "Content-Description: SECURITY WARNING\n\n"; print "SECURITY WARNING!\n"; print "The mail system has detected that the following\n"; print "attachment may contain hazardous macro code,\n"; print "is a suspicious file type or has a suspicious file name.\n"; print "Contact your system administrator immediately!\n"; print "Macro Scanner score: 0 (not scanned due to poisoning policy)\n\n"; last; } } close(POISONED); } else { warn " Unable to open poisoned-executables file \"$specf\".\n"; } } $check_attachment = 1 unless $ENV{"DISABLE_MACRO_CHECK"}; } if (($bndry) = $hdrtxt =~ /^Content-Type:\s+multipart\/.*\s+boundary\s*=\s*"([^"]+)"/i) { warn " Recursing into multipart attachment.\n" if $ENV{"DEBUG"}; if (!$inmimehdr) { push @@mimeboundaries, $mimeboundary; push @@newboundaries, $newboundary; push @@rawboundaries, $rawboundary; push @@boundariestoolong, $boundarytoolong; push @@gotboundaries, $gotboundary; push @@nullboundaries, $nullboundary; $mimeboundary = $newboundary = $bndry; $recursemsg = $pastmsghdr = $boundarytoolong = $gotboundary = 0; } else { $recursemsg = 1; } } if ($hdrtxt =~ /^Content-Type:\s+message\/rfc822/i) { warn " Recursing into RFC822 attachment.\n" if $ENV{"DEBUG"}; if (!$inmimehdr) { push @@mimeboundaries, $mimeboundary; push @@newboundaries, $newboundary; push @@rawboundaries, $rawboundary; push @@boundariestoolong, $boundarytoolong; push @@gotboundaries, $gotboundary; push @@nullboundaries, $nullboundary; $mimeboundary = $newboundary = ""; $recursemsg = $pastmsghdr = $boundarytoolong = $gotboundary = 0; } else { $recursemsg = 1; } } if ($ENV{"SECURITY_STRIP_MSTNEF"} && $hdrtxt =~ /^Content-Type:\s+application\/MS-TNEF/i) { print "Content-Type: TEXT/PLAIN;\n"; print "X-Content-Security: REPORT: Stripped MS-TNEF attachment\n"; print "Content-Description: SECURITY NOTICE\n\n"; print "SECURITY NOTICE\n"; print "The mail system has removed a Microsoft attachment for security reasons.\n"; print "The sender should disable sending Rich Text format in Outlook and\n"; print "disable sending TNEF to the Internet from their Microsoft Exchange gateway.\n\n"; print "See http://support.microsoft.com/support/kb/articles/Q241/5/38.ASP\n"; print "and http://www.microsoft.com/TechNet/exchange/2505ch10.asp for more information.\n\n"; $_ = $hdrtxt = ""; $strip_attachment = 1; $inmimehdr = 0; } while (($filen) = $hdrtxt =~ /^Content-[-\w]+\s*:.*name\s*=\s*"([^"]+\.($ENV{"MANGLE_EXTENSIONS"})(\?=)?)"/io) { if (!$poisoned && ($specf = $ENV{"POISONED_EXECUTABLES"})) { if (open(POISONED,$specf)) { while (chomp($poisoned_spec = )) { $poisoned_spec =~ s/^\s+//g; $poisoned_spec =~ s/\s+$//g; next unless $poisoned_spec; $poisoned_spec =~ s/([^\\])\./$1\\./g; $poisoned_spec =~ s/\*/.*/g; $poisoned_spec =~ s/\?/./g; $poisoned_spec .= "(\\?=)?"; warn "Checking against \"$poisoned_spec\"\n" if $ENV{"DEBUG"}; if ($filen =~ /^${poisoned_spec}$/i) { warn " Trapped poisoned executable \"$filen\".\n"; $poisoned = 1; print "Content-Type: TEXT/PLAIN;\n"; print "X-Content-Security: NOTIFY\n" if $ENV{"SECURITY_NOTIFY"} || $ENV{"SECURITY_NOTIFY_VERBOSE"}; print "X-Content-Security: REPORT: Trapped poisoned executable \"$filen\"\n" if $ENV{"SECURITY_NOTIFY"} || $ENV{"SECURITY_NOTIFY_VERBOSE"}; print "X-Content-Security: QUARANTINE\n" if $ENV{"SECURITY_QUARANTINE"}; print "Content-Description: SECURITY WARNING\n\n"; print "SECURITY WARNING!\n"; print "The mail system has detected that the following\n"; print "attachment may contain hazardous executable code,\n"; print "is a suspicious file type or has a suspicious file name.\n"; print "Contact your system administrator immediately!\n\n"; last; } } close(POISONED); } else { warn " Unable to open poisoned-executables file \"$specf\".\n"; } } warn " Mangling executable filename \"$filen\".\n"; $newfilen = $filen; $newfilen =~ s/\.([a-z0-9]+(\?=)?)$/.${$}DEFANGED-$1/i; $filen = quotemeta($filen); $hdrtxt =~ s/name\s*=\s*"?${filen}"?/name="$newfilen"/ig; $mangle_mime_type = 1; } if ($mangle_mime_type && $hdrtxt =~ /^Content-Type:\s/i) { ($oct) = $hdrtxt =~ /^Content-Type:.*\s(\S+\/\S+;?)/i; unless ($oct =~ /application\/octet-stream;/i) { print "X-Content-Security: original Content-Type was $oct\n"; $oct = quotemeta($oct); $hdrtxt =~ s/${oct}/application\/octet-stream;/i; } } if ($mangle_mime_type && $hdrtxt =~ /\sx-mac-\S+/i) { $eudora = ""; while (($eh) = $hdrtxt =~ /(\sx-mac-\S+\s*=\s*\S+;?)/i) { $eudora .= $eh; $eh = quotemeta($eh); $hdrtxt =~ s/${eh}//i; } print "X-Content-Security: removed$eudora\n"; } if (($junk) = $hdrtxt =~ /^Content-Type\s*:\s+(.{128}).{100,}$/i) { warn " Truncating long Content-Type header.\n"; $junk =~ s/"/\\"/g; $hdrtxt = "Content-Type: X-BOGUS\/X-BOGUS; originally=\"$junk...\""; } elsif (($junk) = $hdrtxt =~ /^Content-Description\s*:\s+(.{128}).{100,}$/i) { warn " Truncating long Content-Description header.\n"; $hdrtxt = "Content-Description: $junk..."; } elsif (($junk) = $hdrtxt =~ /^Content-[-\w]+\s*:\s+(.{128}).{100,}$/i) { warn " Truncating long MIME header.\n"; $junk =~ s/"/\\"/g; $hdrtxt =~ s/^Content-([-\w]+)\s*:.*$/X-Overflow: Content-$1; originally="$junk..."/i; } #if ($hdrtxt =~ /^Content-Transfer-Encoding\s*:\s+base64/i) { # $check_attachment = 1; #} $hdrtxt =~ s/\\ÿ/\\"/g; print $hdrtxt, "\n"; $hdrtxt = ""; } if (/^\S/) { s/\s*\n$//; $hdrtxt = $_; $_ = ""; $hdrcnt++; } else { $hdrcnt = 0; $hdrtxt = ""; } } } else { $poisoned = 0; } } @ 0.45 log @*** empty log message *** @ text @d3 4 a6 3 # (C) 2001 John D. Hardin # License: GPL/Artistic # $Id: sanitizer.pl,v 0.44 2001-04-06 15:53:56-07 jhardin Exp jhardin $ d415 1 a415 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.44 $x\n"; @ 0.44 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.43 2001-03-25 14:13:58-08 jhardin Exp jhardin $ d61 1 d65 1 d110 2 a111 2 # Read the attachment security policy files # Create the Policy array d113 1 a113 1 my($list, $dir, $file, $glob, $policy); d115 49 a163 1 return if @@Policy; # read it only once d165 12 a176 6 warn "$INFO ", gettext("reading policies"), "\n" if $dbg; if ($list = $ENV{"SECURITY_POLICY"}) { foreach $file (split(/:/, $list)) { $file =~ s/^((\s+)|(\.+\/))+//; $file =~ s/\s+$//; next unless $file; d181 2 a182 2 warn "$INFO ", gettext("policy"), " $file\n" if $dbg; if (open(POLICY,"<$file")) { d184 7 a190 8 s/#.*//; if (($glob, $policy) = /^\s*(\S+)\s+(\S+)/) { $policy =~ s/^([a-np-z]*)O/$1/ig; # ignore O, we know better unless ($policy =~ /^[b-z]*[AMSP]/i) { warn "$CONF ", gettext("no valid primary policy in"), " \"$policy\"\n"; warn "$CONF ...file $file, glob $glob\n"; warn "$CONF ...", gettext("defaulting to"), " $default_policy\n"; $policy = $default_policy; a191 8 die "$CONF \$SECURITY_QUARANTINE_DIR ", gettext("not given"), "\n" if $policy =~ /^[a-z]*SQ/i && ! $Qdir; die "$CONF \$SECURITY_QUARANTINE ", gettext("not given"), "\n" if $policy =~ /^[a-z]*PQ/i && ! $Qbox; die "$CONF \$SECURITY_FILENAME_LOG ", gettext("not given"), "\n" if $policy =~ /^[a-z]*L/i && ! $Flog; $glob =~ s/([^\\])\./$1\\./g; $glob =~ s/\*/.*/g; $glob =~ s/\?/./g; push(@@Policy, "${glob}\034${policy}"); warn "$INFO $glob $policy\n" if $dbgv; d198 2 a200 9 if ($dbgv) { warn "$INFO *** ", gettext("policy dump"), " ***\n"; for (@@Policy) { warn "$INFO $_\n"; } } warn "$WARN ", gettext("no policy defined"), " - ", gettext("defaulting to"), " $default_policy\n" unless @@Policy; } else { warn "$WARN ", gettext("no policy files defined by"), " \$SECURITY_POLICY - ", gettext("defaulting to"), " $default_policy\n"; d335 1 d338 1 a338 1 @@Headers = (); d341 1 a341 1 while (<>) { d343 2 a344 2 if (@@Headers) { # blank line, end of headers d347 1 a347 1 push(@@Headers, $hdr); d361 1 a361 1 push(@@Headers, $hdr); d369 1 d374 2 a375 1 my($hdr, $type, $junk, $hasmime, $index); d378 1 a378 1 readheaders(); d380 2 a381 2 $index = $hasmime = 0; foreach $hdr (@@Headers) { d383 1 a383 25 if (($type, $junk) = $hdr =~ /^(Mime-Version|Date|Resent-Date|Message-ID|From|Status|Subject)\s*:\s+(.{251,})$/is) { push (@@MsgLog, "\n", gettext("Message header is excessively long."), " ", gettext("Possible buffer overflow attack."), "\n", gettext("Header: "), $type, "\n", gettext("Original value:"), " \"$junk\"", "\n"); warn "RFC822: ", gettext("truncating long header"), " ${type}: $junk\n"; $hdr = "${type}: " . substr($junk, 0, 250) . "\n"; } if (($type, $junk) = $hdr =~ /^(Subject|Return-Path|X-[-\w]+)\s*:\s+(.{511,})$/is) { push (@@MsgLog, "\n", gettext("Message header is excessively long."), " ", gettext("Possible buffer overflow attack."), "\n", gettext("Header: "), $type, "\n", gettext("Original value:"), " \"$junk\"", "\n"); warn "RFC822: ", gettext("truncating long header"), " ${type}: $junk\n"; $hdr = "${type}: " . substr($junk, 0, 510) . "\n"; } if ($hdr =~ /`\s*`/) { a384 1 ($type, $junk) = $hdr =~ /^([^\s:])\s*:\s+(.+)$/; d389 1 a389 3 gettext("Header: "), $type, "\n", gettext("Original value:"), " \"$junk\"", d395 1 a395 1 $MSGID = $junk unless $MSGID; d397 13 a409 1 next if $hasmime; d411 1 a411 1 $hasmime = 1; d414 1 a414 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.43 $x\n"; d416 1 a416 1 splice (@@Headers, $index++, 0, $junk); d419 1 a419 1 splice (@@Headers, $index++, 0, $junk); a423 11 if ($hasmime) { # okay, sanitize the MIME bits # note that it may decide to discard the RFC822 headers... doMIMEheaders(TRUE); # process array rather than reading from input } else { for (@@Headers) { print $_; } print "\n"; } d429 1 a429 1 my($alreadyread, $junk) = @@_; d435 1 a435 1 if ($alreadyread) { d439 1 a439 1 readheaders(); d447 1 a447 1 foreach $hdr (@@Headers) { d469 1 a469 3 gettext("Header: "), $hname, "\n", gettext("Original value:"), " \"$hdata\"", d533 1 d535 1 a535 1 if ($junk =~ /\.[a-z0-9]+$/) { d747 1 @ 0.43 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.42 2001-03-11 10:32:50-08 jhardin Exp jhardin $ d340 1 a340 1 if (($type, $junk) = $hdr =~ /^(Mime-Version|Date|Resent-Date|Message-ID|From|Status)\s*:\s+(.{251,})$/is) { d386 1 a386 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.42 $x\n"; @ 0.42 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.41 2001-03-11 09:13:29-08 jhardin Exp jhardin $ d69 1 a69 1 die "$CONF \$SECURITY_QUARANTINE=\"$Qbox\": ", gettext("not a file"), "\n" unless -f $Qbox; d287 1 d386 1 a386 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.41 $x\n"; d471 1 a471 1 $hdr =~ s/\s${junk2}\s*=\s*""\s*/ X-${junk}="[${nulls}]"/sgi; d744 33 a776 1 # TODO perform HTML sanitization here d850 1 a850 1 $dest = \@@_[0]; @ 0.41 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.40 2001-03-10 11:03:37-08 jhardin Exp jhardin $ d385 1 a385 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.40 $x\n"; d413 1 a413 1 $cth, $mangle_mime_type, $filename, $oldfilename, $newfilename, $dispfilename, d435 5 a713 3 push (@@MsgLog, "\n", gettext("MIME body part did not include a name, supplying a default name."), "\n") unless $dispfilename; d729 1 d739 16 d780 3 a782 1 unless (($bfileh, $bfilen) = mkstempt("sanitizer-XXXXXXXX", $TEMP)) { d795 5 a799 1 $bfileh->close if $bfileh; d804 1 a804 1 # copy the body part to a file, possibly decoding d806 2 a807 2 my ($fh, $encoding, $junk) = @@_; my ($enc); d809 1 a809 1 $enc = 0; d814 6 d825 5 a829 1 print $fh decode_base64($BodyPart); d831 5 a835 1 print $fh decode_qp($BodyPart); d837 5 a841 1 print $fh unpack("u", $BodyPart); d843 5 a847 1 print $fh $BodyPart; d854 5 a858 1 print $fh decode_base64($_); d860 5 a864 1 print $fh decode_qp($_); d866 5 a870 1 print $fh unpack("u", $_); d872 5 a876 1 print $fh $BodyPart; @ 0.40 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.39 2001-03-05 21:17:23-08 jhardin Exp jhardin $ d30 1 a30 1 # meximum size of encoded in-memory body part a37 1 # somebody may want to localize this d39 1 a39 1 die "$CONF ", gettext("dangerous characters in localized string"), " \"$DEFANG\"\n" if $DEFANG =~ /[^-0-9a-zA-Z_]/; d51 1 d68 4 a71 2 die "$CONF \$SECURITY_QUARANTINE=\"$Qbox\": ", gettext("not a file"), "\n" unless -f $Qbox; die "$CONF \$SECURITY_QUARANTINE=\"$Qbox\": ", gettext("not writable"), "\n" unless -w $Qbox; d90 4 a93 2 die "$CONF \$SECURITY_FILENAME_LOG=\"$Flog\": ", gettext("not a file"), "\n" unless -f $Flog; die "$CONF \$SECURITY_FILENAME_LOG=\"$Flog\": ", gettext("not writable"), "\n" unless -w $Flog; a165 1 # TODO filename handling (length-limit, mangle) that properly handles encoded filenames d226 1 a226 1 print FLOG "[", time(), "] $filename\n"; d377 3 d385 1 a385 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.39 $x\n"; d413 1 a413 1 $cth, $mangle_mime_type, $filename, $newfilename, $dispfilename, d550 1 d554 1 a554 1 gettext("Original name: "), decodefilename($junk), d567 1 d569 1 a569 1 gettext("New name: "), decodefilename($junk), d575 1 d579 5 a583 1 $dispfilename = $newfilename; d608 5 a612 1 push (@@MsgLog, , "\n"); d628 5 a632 1 $cth = \$hdr; @ 0.39 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.38 2001-03-03 22:27:39-08 jhardin Exp jhardin $ d379 1 a379 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.38 $x\n"; d406 2 a407 2 my($hdr, $index, $hname, $hdata, $mangle_mime_type, $filename, $newfilename, d432 1 d533 1 a533 1 $filename = $_; d569 4 d610 2 a611 1 if ("\U$hname" eq "CONTENT-TYPE") { a640 11 unless ($MIMEtype =~ /^(multipart|message)/i) { unless ($hdata =~ /name\s*=\s*"/is) { push (@@MsgLog, "\n", gettext("MIME body part did not include a name, supplying a default name."), "\n"); warn "MIME: ", gettext("supplying default filename"), "\n"; $hdr =~ s/\s*$/;\n/ unless $hdr =~ /;\s*$/; $hdr .= "\tname=\"default.txt\";\n"; } } d677 20 @ 0.38 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.37 2001-03-03 21:53:37-08 jhardin Exp jhardin $ d379 1 a379 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.37 $x\n"; d408 1 a408 1 $policy, $handling, d418 1 a418 1 $policy = $logfiles = $MIMEencoding = $MIMEtype = $MIMEsubtype = ""; d709 82 d845 2 a846 4 # quarantine everything up to the next boundary string # TODO support MS' x-uue encoding # TODO split the decode-and-write out to a subroutine my ($origname, $debase64, $junk) = @@_; d867 1 d883 1 d892 1 a892 34 # TODO move this to a subroutine if ($BodyPart) { # already been read if ($BodyPartSize) { if ($debase64) { print $qfileh decode_base64($BodyPart); } else { print $qfileh $BodyPart; } } else { if (open(BP,"<$BodyPart")) { while () { if ($debase64) { print $qfileh decode_base64($_); } else { print $qfileh $_; } } close(BP); } } } else { # stream it while (<>) { last if /^--${mimeboundary}(--)?$/; if ($debase64) { print $qfileh decode_base64($_); } else { print $qfileh $_; } } $BNDRY = $_; } d896 1 a896 33 } sub getbodypart { # read a MIME body part for further processing # if we read more than $MAX_BP_SIZE bytes, put it in a file to control memory use my ($bfileh, $bfilen); resetbodypart(); while (<>) { last if /^--${mimeboundary}(--)?$/; if ($BodyPartSize || !$BodyPart) { $BodyPart .= $_; $BodyPartSize += length($_); if ($BodyPartSize > $MAX_BP_SZ) { # Reading large attachment, redirect to file warn "$INFO ", gettext("large MIME body part, redirecting to temporary file"), "\n"; unless (($bfileh, $bfilen) = mkstempt("sanitizer-XXXXXXXX", $TEMP)) { # not possible to create temporary file die "$WARN ", gettext("error attempting to create temporary file"), ": $!\n"; } print $bfileh $BodyPart; $BodyPart = $bfilen; $BodyPartSize = 0; } } else { print $bfileh $_; } } $bfileh->close if $bfileh; $BNDRY = $_; d900 3 a902 5 # copy the body part to a file, possibly decoding # TODO merge this with quarantinebodypart()? # TODO support MS' x-uue encoding # TODO genericise my ($debase64, $junk) = @@_; d905 2 a906 27 if ($BodyPart) { unless (($tfileh, $tfilen) = mkstempt("sanitizer-XXXXXXXX", $TEMP)) { # not possible to create temporary file warn "$WARN ", gettext("error attempting to create temporary file"), ": $!\n"; return ""; } if ($BodyPartSize) { # in memory if ($debase64) { print $tfileh decode_base64($BodyPart); } else { print $tfileh $BodyPart; } } else { # in temporary file if (open(BP,"<$BodyPart")) { while () { if ($debase64) { print $tfileh decode_base64($_); } else { print $tfileh $_; } } close(BP); } } d910 2 a911 1 warn "$WARN ", gettext("internal error: attempt to save body part before reading it"), "\n"; @ 0.37 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.36 2001-03-03 18:03:39-08 jhardin Exp jhardin $ d164 1 a164 1 my($dec, $charset, $enc, $enw); d170 4 a173 2 while (($charset, $enc, $enw) = $filename =~ /^=\?([-\w]+)\?([a-z])\?([^?\s\n]+)\?=[\s\n]*/is) { if ($enc eq "Q" || $enc eq "q") { d175 1 a175 1 } elsif ($enc eq "B" || $enc eq "b") { d178 1 a178 1 warn "MIME: \"$filename\" ", gettext("uses unrecognized text encoding"), " \"$enc\"\n"; d181 1 a181 1 $filename =~ s/^=\?[-\w]+\?[a-z]\?[^?\s\n]+\?=[\s\n]*//is; d187 1 a187 1 return wantarray? ($filename, $charset, $enc) : $filename; d379 1 a379 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.36 $x\n"; a465 1 # TODO revisit this to check RFC2047 encoding side effects, esp. w/base64 encoding d471 1 a471 1 if ($newfilename =~ /\([^)]*\)/) { a490 1 # TODO revisit this to check RFC2047 encoding side effects, esp. w/base64 encoding d501 4 a504 1 $newfilename = substr($filename, 0, 200); a505 1 $junk = decodefilename($filename); d510 10 a519 2 # make some pretense of supporting encoded filenames here... $newfilename .= "?=" if $newfilename =~ /^=\?/; d525 1 d537 1 a537 1 # different policies may match d540 1 a540 1 if ($policy =~ /M/) { d549 1 d556 1 d562 1 @ 0.36 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.35 2001-03-03 17:54:58-08 jhardin Exp jhardin $ d185 1 a185 1 return $filename; d377 1 a377 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.35 $x\n"; d406 2 a407 1 $policy, $handling, $logf, $depthatentry, $junk2, $nulls); d469 1 a469 1 warn "MIME: ", gettext("fixing unquoted filename"), " \"${junk}\".\n"; @ 0.35 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.34 2001-03-03 17:44:59-08 jhardin Exp jhardin $ d377 1 a377 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.34 $x\n"; d524 2 d672 1 @ 0.34 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.33 2001-03-03 16:49:41-08 jhardin Exp jhardin $ d377 1 a377 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.33 $x\n"; d406 1 a406 1 $policy, $handling, $logf, $depthatentry, $junk2); d454 2 a455 1 $hdr =~ s/\s${junk2}\s*=\s*""\s*/ X-${junk}="{null value sanitized}"/sgi; d639 1 a639 1 $junk =~ s/("|\\\001)/\\"/g; d643 1 a643 1 splice (@@Headers, $index++, 0, $SANHDR . "long header: " . substr($junk,0,200) . "...\n"); d657 1 a657 1 $hdr = $SANHDR . "long header: " . substr($hdr,0,200) . "...\n"; @ 0.33 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.32 2001-03-03 16:46:06-08 jhardin Exp jhardin $ d250 1 a250 1 gettext("MIME boundary string excessively long."), " ", d336 1 a336 1 gettext("Message header excessively long."), " ", d348 1 a348 1 gettext("Message header excessively long."), " ", d377 1 a377 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.32 $x\n"; d430 1 a430 1 if ($hdata =~ /`\s*`/) { d444 1 a444 1 for ($hdata =~ /\s(\S+)\s*=\s*""/sgi) { d457 1 a457 1 if ($hdata =~ /name\s*=\s*"[^"]+$/is) { d463 1 a463 1 for ($hdata =~ /name\s*=\s*([^"\s][^;]+)/sgi) { d489 1 a489 1 for ($hdata =~ /name\s*=\s*"([^"]{250,})"/sgi) { d500 1 a500 1 # preserve the extension d502 1 a502 1 if ($junk =~ /\./) { d518 1 a518 1 for ($hdata =~ /name\s*=\s*"([^"]+)"/sgi) { d626 31 @ 0.32 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.31 2001-03-03 13:46:37-08 jhardin Exp jhardin $ d257 2 a258 1 gettext("MIME boundary string explicitly empty. Denial-of-Service attack."), d377 1 a377 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.31 $x\n"; @ 0.31 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.30 2001-03-03 13:13:15-08 jhardin Exp jhardin $ d200 1 d249 1 a249 1 push (@@MsgLog, d256 1 a256 1 push (@@MsgLog, d334 1 a334 1 push (@@MsgLog, d346 1 a346 1 push (@@MsgLog, d360 1 a360 1 push (@@MsgLog, d376 2 a377 2 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.30 $x\n"; warn "$INFO ", gettext("inserting header(s)"), "\n" if $dbgv; d403 3 a405 1 my($hdr, $index, $mangle_mime_type, $filename, $newfilename, $policy, $depthatentry, $junk2); d414 1 a414 1 $policy = $MIMEencoding = $MIMEtype = $MIMEsubtype = ""; d421 1 a421 1 $hdr =~ s/([^\\])\\"/$1\\\001/g; # hide escaped quotes to simplify things d423 1 a423 1 if (($junk) = $hdr =~ /^Content-Transfer-Encoding[\s\n]*:[\s\n]+([78]bit|binary|quoted-printable|base64|x-uuencode)/is) { d427 1 a427 14 if ($hdr =~ /`\s*`/) { # Unix shell escape attack ($junk, $junk2) = $hdr =~ /^([^\s:])\s*:\s+(.+)$/; push (@@MsgLog, gettext("Header contained double backquotes."), " ", gettext("Possible UNIX shell-script attack."), "\n", gettext("Header: "), $junk, "\n", gettext("Original value:"), " \"$junk2\"", "\n"); warn "MIME: ", gettext("fixing double backquotes"), "\n"; $hdr =~ s/`[\s\n]*`/\\"/sg; } d429 7 a435 26 while (($junk, $junk2) = $hdr =~ /^([-\w]+)\s*:.*\s(\S+)\s*=\s*""/si) { push (@@MsgLog, gettext("Header contained null value."), " ", gettext("Denial-of-Service attack."), "\n", gettext("Header: "), "${junk}: ${junk2}=\"\"", "\n"); warn "MIME: ", gettext("null value in header"), " ${junk}: ${junk2}=\"\"\n"; $junk = quotemeta($junk2); $hdr =~ s/\s${junk}\s*=\s*""/ X-${junk2}="{null value sanitized}"/sgi; } if ($hdr =~ /^Content-[-\w]+[\s\n]*:.*[\s\n](file)?name[\s\n]*=[\s\n]*"[^"]+$/is) { warn "MIME: ", gettext("fixing missing close quote on filename"), "\n"; $hdr =~ s/$/"/; } # TODO revisit this to check RFC2047 encoding side effects, esp. w/base64 encoding while (($junk, $junk2, $filename) = $hdr =~ /^Content-[-\w]+[\s\n]*:[^"]*("[^"]*"[^"]+)*[\s\n](file)?name[\s\n]*=[\s\n]*([^"\s\n]][^;]+)/is) { warn "MIME: ", gettext("fixing unquoted filename"), " \"$filename\".\n"; $newfilename = $filename; $newfilename =~ s/\"/\\"/g; # escape quotes embedded in filename if ($newfilename =~ /\([^)]*\)/) { push (@@MsgLog, gettext("MIME body part name contained an RFC822 comment."), " ", gettext("Possible attempt to bypass filename filtering."), d437 1 a437 1 gettext("Original name: "), $filename, d439 11 a449 4 warn "MIME: ", gettext("filename contains embedded RFC822 comment - removing"), "\n"; $newfilename =~ s/\([^)]*\)//g; push (@@MsgLog, gettext("New name: "), $newfilename, d451 34 a485 28 $filename = quotemeta($filename); $hdr =~ s/name[\s\n]*=[\s\n]*${filename}/name="${newfilename}"/isg; } # TODO revisit this to check RFC2047 encoding side effects, esp. w/base64 encoding while (($junk, $filename) = $hdr =~ /^Content-[-\w]+[\s\n]*:.*[\s\n](file)?name[\s\n]*=[\s\n]*"([^"]{250,})"/is) { push (@@MsgLog, gettext("MIME body part name is excessively long."), " ", gettext("Possible buffer overflow attack."), "\n", gettext("Original name: "), $filename, "\n"); warn "MIME: ", gettext("truncating long filename"), " \"${filename}\".\n"; $newfilename = substr($filename, 0, 200); # preserve the extension $junk = decodefilename($filename); if ($junk =~ /\./) { $junk =~ s/^.+\.//; $newfilename .= ".$junk"; } $newfilename .= "?=" if $newfilename =~ /^=\?/; push (@@MsgLog, gettext("New name: "), $newfilename, "\n"); $filename = quotemeta($filename); $hdr =~ s/name[\s\n]*=[\s\n]*"${filename}"/name="${newfilename}"/isg; $mangle_mime_type = 1; } d487 7 a493 6 if (($junk, $filename) = $hdr =~ /^Content-[-\w]+[\s\n]*:.*[\s\n](file)?name[\s\n]*=[\s\n]*"([^"]+)"/is) { $policy = checkfilename($filename); warn "$INFO \"$filename\" ", gettext("policy is"), " \"$policy\"\n" if $dbg; if ($policy =~ /^[a-z]*M/) { push (@@MsgLog, gettext("MIME body part name is being mangled due to site security policy."), d495 1 a495 1 gettext("Original name: "), decodefilename($filename), d497 7 a503 6 warn "MIME: ", gettext("mangling filename"), " \"${filename}\".\n"; # if filename is encoded, encode the mangling if ($filename =~ /=\?[-_a-z0-9]+\?[a-z]\?/i) { $newfilename = "$filename =?ISO-8859-1?Q?" . encode_qp("-${DEFANG}") . "?="; } else { $newfilename = "${filename}-${DEFANG}"; d505 4 d510 1 a510 1 gettext("New name: "), decodefilename($newfilename), d513 1 a513 1 $hdr =~ s/name[\s\n]*=[\s\n]*"${filename}"/name="${newfilename}"/isg; d516 20 a535 12 # TODO don't do this here? # there's lots more %x stuff to interpolate after the attachment has been dealt with # but does it apply for mangling? # make this a parameterized subroutine # it should also accept multiple colon-delimited filenames if (($junk) = $policy =~ /:(.+)/) { # interpolate a custom status message $junk =~ s/^(\.+\/)*//; # strip leading ../../ if ($junk =~ /^[^\/]/) { # relative filename may only be in policy dir if ($Pdir) { $junk = "${Pdir}/${junk}"; d537 1 a537 2 warn "$CONF \$SECURITY_POLICY_DIR ", gettext("not given, cannot find"), " $junk\n"; $junk = ""; d539 8 d548 28 a575 6 if ($junk) { if (-f $junk) { if (-r $junk) { if (open(NOTE,"<$junk")) { push (@@MsgLog, , "\n"); close (NOTE); d577 1 a577 1 warn "$WARN ", gettext("error attempting to read"), " $junk : $!\n"; d580 1 a580 1 warn "$CONF \"$junk\": ", gettext("not readable"), "\n"; a581 2 } else { warn "$CONF \"$junk\": ", gettext("not a file"), "\n"; a584 1 } d586 28 a613 22 if (($junk, $junk2) = $hdr =~ /^Content-Type[\s\n]*:.*[\s\n]([-\w]+)\/([^";\s\n]+)/is) { $MIMEtype = "\U$junk"; $MIMEsubtype = "\U$junk2"; if (($junk) = $hdr =~ /multipart\/.*boundary[\s\n]*=[\s\n]*(("")|("[^"]+")|([^"]\S+))/is) { setMIMEboundary($junk); $hdr =~ s/${mimeboundary}/${newboundary}/ if $boundarytoolong; $hdr =~ s/boundary[\s\n]*=[\s\n]*""/boundary="${newboundary}"/is if $nullboundary; } if ($mangle_mime_type) { warn "$INFO ", gettext("Mangling MIME type"), "\n" if $dbg; $junk = "${MIMEtype}/${MIMEsubtype}"; warn "$INFO ", gettext("inserting header(s)"), "\n" if $dbgv; splice (@@Headers, $index++, 0, $SANHDR . " " . gettext("original") . " Content-Type: $junk\n"); $junk = quotemeta($junk); $hdr =~ s/${junk}/APPLICATION\/OCTET-STREAM/sgi; # remove x-mac-* clauses to keep Eudora from # restoring the file type $junk = ""; while (($junk2) = $hdr =~ /(\sx-mac-\S+\s*=\s*\S+;?)/is) { $junk .= $junk2; $junk2 = quotemeta($junk2); $hdr =~ s/${junk2}//sgi; a614 4 $junk =~ s/\s+/ /sg; splice (@@Headers, $index++, 0, $SANHDR . " " . gettext("removed") . ": $junk\n") if $junk; } } d616 9 a624 11 if ($hdr =~ /^Content-Type[\s\n]*:/is) { unless ($MIMEtype =~ /^(multipart|message)/i) { unless ($hdr =~ /^Content-[-\w]+[\s\n]*:.*[\s\n](file)?name[\s\n]*=[\s\n]*"/is) { push (@@MsgLog, gettext("MIME body part did not include a name, supplying a default name."), "\n"); warn "MIME: ", gettext("supplying default filename"), "\n"; $hdr =~ s/[\s\n]*$/;\n/ unless $hdr =~ /;[\s\n]*$/; # this could be friendlier (see Anomy) $hdr .= "\tname=\"default.txt\";\n"; $newfilename = 1; d629 2 a630 1 $hdr =~ s/\\\001/\\"/g; d692 1 a692 1 push (@@MsgLog, d694 1 a694 2 "\n"); push (@@MsgLog, d718 1 a718 1 push (@@MsgLog, d720 1 a720 2 "\n"); push (@@MsgLog, d728 1 a728 1 push (@@MsgLog, d741 1 a741 1 push (@@MsgLog, d753 1 a753 1 push (@@MsgLog, @ 0.30 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.29 2001-03-03 10:43:00-08 jhardin Exp jhardin $ d200 2 d204 1 d212 1 a212 1 warn "$WARN ", gettext("no policy found for"), " $filename - ", gettext("defaulting to"), " $default_policy\n"; d216 2 d224 2 d375 2 a376 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.29 $x\n"; d457 1 a457 1 while (($junk, $filename) = $hdr =~ /^Content-[-\w]+[\s\n]*:[^"]*("[^"]*"[^"]+)*[\s\n](file)?name[\s\n]*=[\s\n]*([^"\s\n]][^;]+)/is) { d479 1 a479 1 while (($filename) = $hdr =~ /^Content-[-\w]+[\s\n]*:.*[\s\n](file)?name[\s\n]*=[\s\n]*"([^"]{129,})"/is) { d487 1 d490 4 a493 2 $junk =~ s/^.+\.//; $newfilename = substr($filename, 0, 128) . ".$junk"; d503 1 a503 1 if (($filename) = $hdr =~ /^Content-[-\w]+[\s\n]*:.*[\s\n](file)?name[\s\n]*=[\s\n]*"([^"]+)"/is) { d573 1 d861 7 @ 0.29 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.28 2001-03-03 10:40:34-08 jhardin Exp jhardin $ d49 2 d368 1 a368 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.28 $x\n"; d431 12 d561 14 a574 2 $junk = quotemeta($MIMEtype) . "\/" . quotemeta($MIMEsubtype); $hdr =~ s/${junk}/APPLICATION\/OCTET-STREAM/ig; a981 10 $mangle_mime_type = 0; $hdrtxt =~ s/([^\\])\\"/\1\\ÿ/g; if ($hdrtxt =~ /`\s*`/) { warn " Fixing double backquotes.\n"; $hdrtxt =~ s/`\s*`/\\"/g; } if ($hdrtxt =~ /^[-\w]+\s*:.*name\s*=\s*"[^"]+$/i) { warn " Fixing missing close quote on filename.\n"; $hdrtxt .= "\""; } @ 0.28 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.27 2001-03-03 10:38:02-08 jhardin Exp jhardin $ d330 1 a330 1 gettext("Original value: "), "\"$junk\"", d342 1 a342 1 gettext("Original value: "), "\"$junk\"", d356 1 a356 1 gettext("Original value: "), "\"$junk\"", d366 1 a366 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.27 $x\n"; d423 1 a423 1 gettext("Original value: "), "\"$junk2\"", d634 1 a634 1 "$origname", d661 1 a661 1 "$origname", d684 1 a684 1 gettext("The system error was: "), $!, @ 0.27 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.26 2001-03-03 10:36:53-08 jhardin Exp jhardin $ d325 1 a325 1 gettext("RFC-822 header excessively long."), " ", d337 1 a337 1 gettext("RFC-822 header excessively long."), " ", d366 1 a366 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.26 $x\n"; @ 0.26 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.25 2001-03-03 10:32:02-08 jhardin Exp jhardin $ d366 1 a366 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.25 $x\n"; a429 3 push (@@MsgLog, gettext("MIME body part name had no closing quotation mark."), "\n"); a435 3 push (@@MsgLog, gettext("MIME body part name had no enclosing quotes."), "\n"); @ 0.25 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.24 2001-02-28 20:59:30-08 jhardin Exp jhardin $ d240 2 a241 1 gettext("MIME boundary string excessively long. Possible buffer overflow attack."), d325 2 a326 1 gettext("RFC-822 header excessively long. Possible buffer overflow attack."), d337 2 a338 1 gettext("RFC-822 header excessively long. Possible buffer overflow attack."), d366 1 a366 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.24 $x\n"; @ 0.24 log @, @ text @d3 1 a3 1 # (C) 2001 John D. Hardin d5 1 a5 1 # $Id: sanitizer.pl,v 0.23 2001-02-27 22:17:00-08 jhardin Exp jhardin $ d7 3 d30 1 d38 1 d104 1 d107 1 a107 1 return if @@Policy; # create it only once d152 1 d160 1 d263 9 d325 4 d336 4 d344 14 d363 1 a363 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.23 $x\n"; d407 1 a407 1 if (($junk) = $hdr =~ /^Content-Transfer-Encoding[\s\n]*:[\s\n]+([78]bit|binary|quoted-printable|base64)/is) { d413 1 d415 1 a415 1 gettext("Message header contained double backquotes."), " ", d417 4 d504 5 a508 1 # TODO don't do this here... a597 9 sub resetbodypart { # clean up BodyPart temporary file if necessary if ($BodyPart && !$BodyPartSize) { unlink($BodyPart); } $BodyPart = ""; $BodyPartSize = 0; } d604 1 d607 1 d616 1 d634 2 a635 1 "\n", d638 1 a638 1 "\n"); d654 2 d661 2 a662 1 "\n", d665 1 a665 1 "\n"); d701 1 a758 1 return ""; d776 2 @ 0.23 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.22 2001-02-27 22:08:17-08 jhardin Exp jhardin $ d36 1 a36 1 $DEFANG = sprintf("%05d-%s", $$, $DEFANG); d324 1 a324 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.22 $x\n"; d451 1 a451 2 $newfilename = $filename; $newfilename =~ s/\.([a-z0-9]+)$/.${DEFANG}-$1/i; @ 0.22 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.21 2001-02-25 11:08:01-08 jhardin Exp jhardin $ d324 1 a324 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.21 $x\n"; d375 2 a376 1 gettext("Message header contained double backquotes. Possible UNIX shell-script attack."), d400 2 a401 1 gettext("MIME body part name contained an RFC822 comment. Possible attempt to bypass filename filtering."), d418 2 a419 1 gettext("MIME body part name is excessively long. Possible buffer overflow attack."), d594 2 a595 2 gettext("Original name:"), " $origname", d618 2 a619 2 gettext("Original name:"), " $origname", d626 2 a627 2 gettext("Due to a sanitizer configuration"), " ", gettext("error the MIME body part could not be quarantined and will be discarded."), d639 2 a640 2 gettext("due to a system"), " ", gettext("error the MIME body part could not be quarantined and will be discarded."), @ 0.21 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.20 2001-02-25 09:13:27-08 jhardin Exp jhardin $ d27 1 d118 2 a119 2 $policy =~ s/^([a-z]*)O/$1/ig; # ignore O, we know better unless ($policy =~ /^[a-z]*[AMSP]/i) { d305 1 a305 1 if (($type, $junk) = $hdr =~ /^(Mime-Version|Date|Resent-Date|Message-ID|From|Status)\s*:\s+(.{256,})$/is) { d310 1 a310 1 $hdr = "${type}: " . substr($junk, 0, 255) . "\n"; d312 1 a312 1 if (($type, $junk) = $hdr =~ /^(Subject|Return-Path|X-[-\w]+)\s*:\s+(.{513,})$/is) { d317 1 a317 1 $hdr = "${type}: " . substr($junk, 0, 512) . "\n"; d324 1 a324 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.20 $x\n"; d362 1 d458 1 d548 9 d560 18 a577 6 $BodyPart = ""; while (<>) { last if /^--${mimeboundary}(--)?$/; print $_; d580 1 a580 1 $BNDRY = $_; d590 3 d597 1 d604 1 a604 1 $BodyPart = ""; d608 1 a608 2 # quarantine everything up to the next boundary string # if $BodyPart exists, quarantine it instead of reading from STDIN d614 3 d632 1 d654 7 a660 2 if ($debase64) { print $qfileh decode_base64($BodyPart); d662 10 a671 1 print $qfileh $BodyPart; d674 1 d688 1 a688 1 $BodyPart = ""; d693 2 d696 1 a696 1 $BodyPart = ""; d701 18 a718 1 $BodyPart .= $_; d721 1 d727 1 a727 1 # write the body part back out as it is read d731 6 a736 5 unless (($tfileh, $tfilen) = mkstempt($Qtemplate . $origname . "-XXXXXXXX", $TEMP)) { # not possible to create temporary file warn "$WARN ", gettext("error attempting to create temporary file"), ": $!\n"; return ""; } d738 22 a759 2 if ($debase64) { print $tfileh decode_base64($BodyPart); d761 2 a762 1 print $tfileh $BodyPart; a763 3 $tfileh->close; return $tfilen; @ 0.20 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.19 2001-02-24 20:20:55-08 jhardin Exp jhardin $ d32 9 a40 1 $DEFANG = sprintf("%05d-%s", $$, gettext("DEFANGED")); d85 8 a103 7 if ($dir = $ENV{"SECURITY_POLICY_DIR"}) { $dir =~ s/(^\s+|\s+$)//g; die "$CONF \$SECURITY_POLICY_DIR ", gettext("is not valid if relative"), "\n" if $dir !~ /^\//; $dir =~ s/\/$// if $dir ne "/"; die "$CONF \$SECURITY_POLICY_DIR=\"$dir\": ", gettext("not a directory"), "\n" unless -d $dir; die "$CONF \$SECURITY_POLICY_DIR=\"$dir\": ", gettext("not readable"), "\n" unless -r $dir; } d109 2 a110 2 die "$CONF \$SECURITY_POLICY_DIR ", gettext("not given, cannot find"), " $file\n" unless $dir; $file = "${dir}/${file}"; d321 1 a321 2 warn "RFC822: ", gettext("message has MIME formatting"), "\n"; $junk = "X-Security: " . gettext("message sanitized on") . " $HOST\n"; d323 1 a323 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.19 $x\$Date: 2001-02-24 20:20:55-08 $x\n"; d349 1 a349 1 my($hdr, $index, $mangle_mime_type, $filename, $newfilename, $policy, $recurse822, $depthatentry); d358 2 a359 2 $MIMEencoding = $MIMEtype = $MIMEsubtype = ""; $mangle_mime_type = $recurse822 = $index = 0; d366 2 a367 2 if (($MIMEencoding) = $hdr =~ /^Content-Transfer-Encoding[\s\n]*:[\s\n]+([78]bit|binary|quoted-printable|base64)/is) { warn "$INFO Content-Transfer-Encoding: $MIMEencoding\n" if $dbgv; d376 1 a376 1 $hdr =~ s/`\s*`/\\"/g; d381 1 a381 1 gettext("MIME body part name had mismatched quotes."), d387 1 d398 2 d403 3 d408 1 a408 1 $hdr =~ s/name[\s\n]*=[\s\n]*${filename}/name="${newfilename}"/ig; d411 1 a411 1 # TODO revisit this to check RFC2047 encoding side effects d414 3 a416 1 gettext("MIME body part name excessively long. Possible buffer overflow attack."), d418 6 d425 1 a425 1 gettext("Filename: "), $filename, d427 2 a428 4 warn "MIME: ", gettext("truncating long filename"), " \"${filename}\".\n"; $filename = substr($filename, 0, 128) . "..."; $filename .= "?=" if $filename =~ /^=\?/; $hdr =~ s/name[\s\n]*=[\s\n]*"[^"]{128,}"/name="${filename}"/is; d432 58 a489 4 if (($MIMEtype, $MIMEsubtype) = $hdr =~ /^Content-Type[\s\n]*:.*[\s\n]([-\w]+)\/([^";\s\n]+)/is) { $MIMEtype = "\U$MIMEtype"; $MIMEsubtype = "\U$MIMEsubtype"; warn "$INFO Content-Type: $MIMEtype/$MIMEsubtype\n" if $dbgv; a501 1 $newfilename = 0; a516 5 if (!$newfilename && (($filename) = $hdr =~ /^Content-[-\w]+[\s\n]*:.*[\s\n](file)?name[\s\n]*=[\s\n]*"([^"]+)"/i)) { $policy = checkfilename($filename); warn "$INFO \"$filename\" ", gettext("policy is"), " \"$policy\"\n" if $dbg; } d522 3 d526 1 d530 10 a539 1 $recurse822 = 1; d541 1 a541 9 } for (@@Headers) { print $_; } print "\n"; if ($recurse822) { doRFC822headers(); @ 0.19 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.18 2001-02-22 20:08:07-08 jhardin Exp jhardin $ d32 1 a32 1 $DEFANG = printf("%05d-%s", $$, gettext("DEFANGED")); d315 1 a315 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.18 $x\$Date: 2001-02-22 20:08:07-08 $x\n"; d339 1 a339 1 # and setting up to process body d350 1 a350 1 $MIMEtype = $MIMEsubtype = ""; d358 4 d412 16 d430 1 a430 1 unless ($MIMEtype =~ /^(multipart|text|message)/i) { d436 1 a448 18 if (($MIMEtype, $MIMEsubtype, $junk) = $hdr =~ /^Content-Type\s*:.*\s([-\w]+)\/([^"\s]+)(;.*)?$/is) { warn "$INFO Content-Type: $MIMEtype/$MIMEsubtype\n" if $dbgv; if ($MIMEtype =~ /message/i && $MIMEsubtype =~ /rfc822/i) { warn "$INFO ", gettext("recursing into attached RFC822 message"), "\n" if $dbg; $recurse822 = 1; } if (($junk) = $hdr =~ /multipart\/.*boundary[\s\n]*=[\s\n]*(("")|("[^"]+")|([^"]\S+))/is) { setMIMEboundary($junk); $hdr =~ s/${mimeboundary}/${newboundary}/ if $boundarytoolong; $hdr =~ s/boundary[\s\n]*=[\s\n]*""/boundary="${newboundary}"/is if $nullboundary; } if ($mangle_mime_type) { warn "$INFO ", gettext("Mangling MIME type"), "\n" if $dbg; $junk = quotemeta($MIMEtype) . "\/" . quotemeta($MIMEsubtype); $hdr =~ s/${junk}/APPLICATION\/OCTET-STREAM/i; } } d453 9 d475 1 a475 1 $BODYPART = ""; d488 1 a488 1 # if $BODYPART exists, discard it instead of reading from STDIN d496 1 a496 1 unless ($BODYPART) { d503 1 a503 1 $BODYPART = ""; d508 1 a508 1 # if $BODYPART exists, quarantine it instead of reading from STDIN d549 1 a549 1 if ($BODYPART) { d551 1 a551 1 print $qfileh decode_base64($BODYPART); d553 1 a553 1 print $qfileh $BODYPART; d569 1 a569 1 $BODYPART = ""; d575 1 a575 1 $BODYPART = ""; d580 1 a580 1 $BODYPART .= $_; d599 1 a599 1 print $tfileh decode_base64($BODYPART); d601 1 a601 1 print $tfileh $BODYPART; a970 1 } @ 0.18 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.17 2001-02-21 22:17:41-08 jhardin Exp jhardin $ d15 2 d18 1 d24 1 d32 2 a33 1 $DEFANG = gettext("DEFANGED"); a47 2 $sanhdr = "X-Content-Security: [${HOST}] "; d64 2 d223 1 a223 1 "\n\n"); d229 1 a229 1 "\n\n"); d298 1 a298 1 "\n\n"); d305 1 a305 1 "\n\n"); d315 1 a315 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.17 $x\$Date: 2001-02-21 22:17:41-08 $x\n"; d362 1 a362 1 "\n\n"); d369 2 a370 2 gettext("MIME body-part name had mismatched quotes."), "\n\n"); d377 2 a378 2 gettext("MIME body-part name had no enclosing quotes."), "\n\n"); d384 2 a385 2 gettext("MIME body-part name contained an RFC822 comment. Possible attempt to bypass filename filtering."), "\n\n"); d396 1 a396 1 gettext("MIME body-part name excessively long. Possible buffer overflow attack."), d400 1 a400 1 "\n\n"); d413 2 a414 2 gettext("MIME body-part did not include a name."), "\n\n"); d460 134 a593 2 sub dobodypart { # state: reading MIME body part @ 0.17 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.16 2001-02-20 20:43:47-08 jhardin Exp jhardin $ d136 2 a137 4 sub checkfilename { # see if file has a policy # if not, default to $default_policy # if a Microsoft Office document, tag for the VBA scanner d139 1 a139 1 my($glob, $policy, $dec, $enc, $enw, $scan, $handling); a141 1 # decode RFC2047-encoded text d145 1 a145 1 while (($enc, $enw) = $filename =~ /^=\?[-\w]+\?([a-z])\?([^?\s\n]+)\?=[\s\n]*/is) { d158 1 a158 1 die "$FATAL ", gettext("catastrophic failure in"), " checkfilename()\n" unless $filename; d160 9 d171 2 d310 1 a310 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.16 $x\$Date: 2001-02-20 20:43:47-08 $x\n"; @ 0.16 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.15 2001-02-19 21:41:06-08 jhardin Exp jhardin $ d40 2 a41 1 @@Headers = (); d208 3 d214 3 d268 1 a268 1 # Eep. should not hit EOF at this point. d283 3 d290 3 d302 1 a302 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.15 $x\$Date: 2001-02-19 21:41:06-08 $x\n"; d314 1 d328 1 a328 1 my($hdr, $index, $mangle_mime_type, $filename, $newfilename, $policy, $recurse822); d339 2 a342 13 if (($MIMEtype, $MIMEsubtype, $junk) = $hdr =~ /^Content-Type\s*:.*\s([-\w]+)\/([^"\s]+)(;.*)?$/is) { warn "$INFO Content-Type: $MIMEtype/$MIMEsubtype\n" if $dbgv; if ($MIMEtype =~ /message/i && $MIMEsubtype =~ /rfc822/i) { warn "$INFO ", gettext("recursing into attached RFC822 message"), "\n" if $dbg; $recurse822 = 1; } if (($junk) = $hdr =~ /boundary[\s\n]*=[\s\n]*(("")|("[^"]+")|([^"]\S+))/is) { setMIMEboundary($junk); $hdr =~ s/${mimeboundary}/${newboundary}/ if $boundarytoolong; $hdr =~ s/boundary[\s\n]*=[\s\n]*""/boundary="${newboundary}"/is if $nullboundary; } } d346 4 d355 3 d363 3 d370 3 d381 9 a389 3 while (($filename) = $hdr =~ /^Content-[-\w]+[\s\n]*:.*[\s\n](file)?name[\s\n]*=[\s\n]*"([^"]{120})[^"]{16,}"/is) { warn "MIME: ", gettext("truncating long filename"), " \"${filename}...\".\n"; $filename .= "..."; d391 1 a391 1 $hdr =~ s/name[\s\n]*=[\s\n]*"[^"]{128,}"/name="$filename"/is; d399 3 d413 18 @ 0.15 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.14 2001-02-19 21:35:16-08 jhardin Exp jhardin $ d20 1 a20 1 $HOST = $ENV{"HOST"} || $ENV{"HOSTNAME"}; d42 2 d102 2 a103 2 $policy =~ s/^([a-z]+)o/$1/ig; # ignore O, we know better unless ($policy =~ /^[a-z]*[amsp]/i) { d139 2 a140 2 my($file, $logit, $junk) = @@_; my($glob, $policy, $dec, $enc, $enw, $scan); d142 1 a142 1 if ($file =~ /^=\?.*\?=$/s) { d144 1 a144 1 warn "$INFO ", gettext("decoding filename"), " \"$file\"\n" if $dbg; d147 1 a147 1 while (($enc, $enw) = $file =~ /^=\?[-\w]+\?([a-z])\?([^?\s\n]+)\?=[\s\n]*/is) { d153 1 a153 1 warn "MIME: \"$file\" ", gettext("uses unrecognized text encoding"), " \"$enc\"\n"; d156 1 a156 1 $file =~ s/^=\?[-\w]+\?[a-z]\?[^?\s\n]+\?=[\s\n]*//is; d158 3 a160 3 $file = $dec; warn "$INFO ", gettext("decoded filename"), " \"$file\"\n" if $dbg; die "$FATAL ", gettext("catastrophic failure in"), " checkfilename()\n" unless $file; d163 8 a170 4 if ($logit) { if (open (FLOG, ">>$Flog")) { print FLOG "[", time(), "] $file\n"; close(FLOG); d174 3 a176 4 if ($file =~ /\.(do[ct]|xl[swt]|p[po]t|rtf|pps)$/i) { $scan = "O"; } else { $scan = ""; d179 5 a183 3 for (@@Policy) { ($glob, $policy) = split(/\034/); return "${scan}${policy}" if $file =~ /^${glob}$/i; a184 3 warn "$WARN ", gettext("no policy found for"), " $file - ", gettext("defaulting to"), " $default_policy\n"; return "${scan}${default_policy}"; d289 1 a289 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.14 $x\$Date: 2001-02-19 21:35:16-08 $x\n"; d340 1 a340 1 $hdr =~ s/([^\\])\\"/$1\\\001/g; d373 1 d380 1 d385 1 a385 1 if (($filename) = $hdr =~ /^Content-[-\w]+[\s\n]*:.*[\s\n](file)?name[\s\n]*=[\s\n]*"([^"]+)"/i) { d390 1 a421 33 while (<>) { $pastmsghdr = 1 if /^\s*$/; if ($pastmsghdr) { if (!$mimeboundary && $mimeboundaries[0]) { warn " Found no MIME boundary.\n" if $ENV{"DEBUG"}; $mimeboundary = pop @@mimeboundaries; $newboundary = pop @@newboundaries; $rawboundary = pop @@rawboundaries; $boundarytoolong = pop @@boundariestoolong; $gotboundary = pop @@gotboundaries; $nullboundary = pop @@nullboundaries; } } else { if (($type,$format,$junk) = /^Content-Type\s*:\s.*(application|multipart|message)\/(\S+)(;.*)?$/i) { $wanthdr = 1; print "X-Security: MIME headers sanitized on ", $ENV{"HOST"}, "\n"; print "\tSee http://www.impsec.org/email-tools/procmail-security.html\n"; print "\tfor details. \$Revision: 0.14 $x\$Date: 2001-02-19 21:35:16-08 $x\n"; print "X-Security: The postmaster has not enabled quarantine of poisoned messages.\n" unless $ENV{"SECURITY_QUARANTINE"}; if ($type =~ /application/i) { $inmimehdr = 1; } elsif ($type =~ /message/i && $format =~ /rfc822/i) { $recursemsg = $inmimehdr = 1; } } elsif (/^\S/) { $wanthdr = 0; } if ($wanthdr) { if (($mimeboundary) = /boundary\s*=\s*(("")|(".+")|([^"]\S+))/i) { } } } d470 1 d484 1 a484 1 $score+= 1 if /(\000|\004)(Subject|Body)/i; d501 3 @ 0.14 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.13 2001-02-19 20:38:10-08 jhardin Exp jhardin $ d100 1 d285 1 a285 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.13 $x\$Date: 2001-02-19 20:38:10-08 $x\n"; d432 1 a432 1 print "\tfor details. \$Revision: 0.13 $x\$Date: 2001-02-19 20:38:10-08 $x\n"; @ 0.13 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.12 2001-02-19 19:29:30-08 jhardin Exp jhardin $ d135 1 d137 1 a137 1 my($glob, $policy, $dec, $enc, $enw); d167 6 d175 1 a175 1 return $policy if $file =~ /^${glob}$/i; d179 1 a179 1 return $default_policy; a252 1 $skipblank = 0; a259 39 sub doMIMEheaders { # state: reading MIME headers and setting up to process body my($alreadyread, $junk) = @@_; my($hdr, $type, $subtype, $mangletype, $filename, $policy, $recurse, $recurse822); if ($alreadyread) { warn "$INFO ", gettext("Processing MIME headers"), "\n" if $dbg; } else { warn "$INFO ", gettext("Reading MIME headers"), "\n" if $dbg; readheaders(); } foreach $hdr (@@Headers) { warn "$INFO ", gettext("MIME header"), " \"$hdr\"\n" if $dbg; if (($type, $subtype, $junk) = $hdr =~ /^Content-Type\s*:.*\s([-\w]+)\/([^"\s]+)(;.*)?$/is) { warn "$INFO $type/$subtype\n" if $dbgv; if ($type =~ /message/i && $subtype =~ /rfc822/i) { warn "$INFO ", gettext("recursing into attached RFC822 message"), " \"$hdr\"\n" if $dbg; $recurse822 = 1; } if (($junk) = $hdr =~ /boundary[\s\n]*=[\s\n]*(("")|("[^"]+")|([^"]\S+))/is) { setMIMEboundary($junk); $hdr =~ s/${mimeboundary}/${newboundary}/ if $boundarytoolong; $hdr =~ s/boundary[\s\n]*=[\s\n]*""/boundary="${newboundary}"/is if $nullboundary; } } $index++; } for (@@Headers) { print $_; } print "\n"; if ($recurse822) { doRFC822headers(); } } d269 1 a269 1 warn "$INFO ", gettext("RFC822 header"), " \"$hdr\"\n" if $dbg; d284 1 a284 1 $junk .= "\t" . gettext("for details.") . " \$Revision: 0.12 $x\$Date: 2001-02-19 19:29:30-08 $x\n"; d305 95 d431 1 a431 1 print "\tfor details. \$Revision: 0.12 $x\$Date: 2001-02-19 19:29:30-08 $x\n"; @ 0.12 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.11 2001-02-19 12:56:08-08 jhardin Exp jhardin $ d30 1 a30 1 $default_policy = "SQL"; # fail securely - strip, quarantine and log filename d42 8 d57 10 d68 1 d106 3 a108 1 die "$CONF \$SECURITY_QUARANTINE_DIR ", gettext("not given"), "\n" if $policy =~ /^[a-z]*q/i && ! $Qdir; d135 1 a135 1 my($file, $junk) = @@_; d159 7 d216 1 a216 1 # retain the whitespace for writing it back out a217 1 my($skipblank, $junk) = @@_; d225 1 a225 3 if ($skipblank) { next; } else { d232 3 d254 4 a257 3 sub doRFC822headers { # state: reading RFC822 headers and setting up to process body my($hdr, $type, $subtype, $junk, $hasmime, $index, $inmimehdr); d259 6 a264 2 warn "$INFO ", gettext("reading RFC822 headers"), "\n" if $dbg; readheaders($gotboundary > 0); # skip blank lines before header if an attachment a265 1 $inmimehdr = $recurse = $index = $hasmime = 0; d267 2 a268 13 warn "$INFO ", gettext("RFC822 header"), " \"$hdr\"\n" if $dbg; if (($type, $junk) = $hdr =~ /^(Mime-Version|Date|Resent-Date|Message-ID|From|Status)\s*:\s+(.{256,})$/is) { warn "RFC822: ", gettext("truncating long header"), " $type: $junk\n"; $hdr = "$type: " . substr($junk, 0, 255) . "\n"; } if (($type, $junk) = $hdr =~ /^(Subject|Return-Path|X-[-\w]+)\s*:\s+(.{513,})$/is) { warn "RFC822: ", gettext("truncating long header"), " $type: $junk\n"; $hdr = "$type: " . substr($junk, 0, 512) . "\n"; } next if $hasmime; if (($type, $subtype, $junk) = $hdr =~ /^Content-Type\s*:\s.*(application|multipart|message)\/([^"\s]+)(;.*)?$/is) { $hasmime = 1; d270 3 a272 12 $junk = "X-Security: " . gettext("message sanitized on") . " $HOST\n"; splice (@@Headers, $index++, 0, $junk); $junk = "\t" . gettext("see") . " http://www.impsec.org/email-tools/procmail-security.html\n"; splice (@@Headers, $index++, 0, $junk); $junk = "\t" . gettext("for details.") . " \$Revision: 0.11 $x\$Date: 2001-02-19 12:56:08-08 $x\n"; splice (@@Headers, $index++, 0, $junk); if ($type =~ /application/i) { # just an attachment, no text parts $inmimehdr = 1; } elsif ($type =~ /message/i && $subtype =~ /rfc822/i) { $recurse = $inmimehdr = 1; a282 4 if ($inmimehdr) { doMIMEheaders(FALSE); } d288 2 a289 3 if ($recurse) { warn "$INFO ", gettext("recursing into RFC822 attachment"), "\n" if $dbg; doRFC822headers(); d293 3 a295 6 sub doMIMEheaders { # state: reading MIME headers and setting up to process body # also: processing MIME attachment information in RFC822 header # for attachment-only messages my($readheaders, $junk) = @@_; my($hdr); d297 2 a298 4 if ($readheaders) { warn "$INFO ", gettext("Reading MIME headers"), "\n" if $dbg; readheaders(); } d300 1 d302 23 d327 4 a330 1 if ($readheaders) { d334 1 d369 1 a369 1 print "\tfor details. \$Revision: 0.11 $x\$Date: 2001-02-19 12:56:08-08 $x\n"; @ 0.11 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.10 2001-02-18 18:53:20-08 jhardin Exp jhardin $ d33 6 a38 6 @@boundariestoolong = @@gotboundaries = @@mimeboundaries = @@newboundaries = @@nullboundaries = @@rawboundaries = d88 3 a90 3 $glob =~ s/([^\\])\./$1\\./g; $glob =~ s/\*/.*/g; $glob =~ s/\?/./g; d154 4 a157 6 push @@boundariestoolong, $boundarytoolong; push @@gotboundaries, $gotboundary; push @@mimeboundaries, $mimeboundary; push @@newboundaries, $newboundary; push @@nullboundaries, $nullboundary; push @@rawboundaries, $rawboundary; d163 2 a164 1 $gotboundary = 1; d171 1 a171 1 $newboundary = "==NULL_MIME_BOUNDARY_SANITIZED-${HOST}-${$}=="; d174 1 d178 5 a182 6 $boundarytoolong = pop @@boundariestoolong; $gotboundary = pop @@gotboundaries; $mimeboundary = pop @@mimeboundaries; $newboundary = pop @@newboundaries; $nullboundary = pop @@nullboundaries; $rawboundary = pop @@rawboundaries; d190 1 d198 10 a207 3 # blank line, end of headers push(@@Headers, $hdr) if $hdr; return; d213 4 a216 1 push(@@Headers, $hdr) if $hdr; d218 1 d221 3 d226 1 a226 1 sub doRFC822 { d228 1 a228 1 my($hdr); d230 2 a231 2 warn "$INFO ", gettext("Reading RFC822 headers"), "\n" if $dbg; readheaders(); d233 1 d235 34 d271 26 d298 2 d301 5 d314 1 d316 1 d325 1 a325 1 if (!$mimeboundary && $mimeboundaries[0]) { d327 7 a333 7 $mimeboundary = pop @@mimeboundaries; $newboundary = pop @@newboundaries; $rawboundary = pop @@rawboundaries; $boundarytoolong = pop @@boundariestoolong; $gotboundary = pop @@gotboundaries; $nullboundary = pop @@nullboundaries; } d339 1 a339 1 print "\tfor details. \$Revision: 0.10 $x\$Date: 2001-02-18 18:53:20-08 $x\n"; d343 1 a343 1 } elsif ($type =~ /message/i && $format =~ /rfc822/i) { a350 17 $mimeboundary =~ s/(^"|"$)//g; $rawboundary = $mimeboundary; $gotboundary = 1; $boundarytoolong = $nullboundary = 0; if ($boundarytoolong = (length($mimeboundary) > 80)) { warn " Truncating long MIME body-part boundary string.\n"; $newboundary = substr($mimeboundary,0,64); $mimeboundary = quotemeta($mimeboundary); s/${mimeboundary}/${newboundary}/; $rawboundary =~ s/${mimeboundary}/${newboundary}/; } elsif ($nullboundary = (length($mimeboundary) < 1)) { warn " Replacing null MIME body-part boundary string.\n"; $newboundary = "==NULL_MIME_BOUNDARY_ATTACK_SANITIZED-${$}=="; s/boundary\s*=\s*""/boundary = "${newboundary}"/i; } else { $mimeboundary = quotemeta($mimeboundary); } d354 1 d358 10 a367 10 if ($recursemsg) { push @@mimeboundaries, $mimeboundary; push @@newboundaries, $newboundary; push @@rawboundaries, $rawboundary; push @@boundariestoolong, $boundarytoolong; push @@gotboundaries, $gotboundary; push @@nullboundaries, $nullboundary; $mimeboundary = $newboundary = ""; $recursemsg = $pastmsghdr = $boundarytoolong = $gotboundary = 0; } d369 1 a369 1 $mend = $1; d372 2 a373 2 if ($mend) { if ($mimeboundaries[0]) { d375 8 a382 8 $mimeboundary = pop @@mimeboundaries; $newboundary = pop @@newboundaries; $rawboundary = pop @@rawboundaries; $boundarytoolong = pop @@boundariestoolong; $gotboundary = pop @@gotboundaries; $nullboundary = pop @@nullboundaries; } } else { d533 8 a540 8 while (chomp($poisoned_spec = )) { $poisoned_spec =~ s/^\s+//g; $poisoned_spec =~ s/\s+$//g; next unless $poisoned_spec; $poisoned_spec =~ s/([^\\])\./$1\\./g; $poisoned_spec =~ s/\*/.*/g; $poisoned_spec =~ s/\?/./g; $poisoned_spec .= "(\\?=)?"; d542 1 a542 1 if ($filen =~ /^${poisoned_spec}$/i) { d556 1 a556 1 last; d568 13 a580 13 if (!$inmimehdr) { push @@mimeboundaries, $mimeboundary; push @@newboundaries, $newboundary; push @@rawboundaries, $rawboundary; push @@boundariestoolong, $boundarytoolong; push @@gotboundaries, $gotboundary; push @@nullboundaries, $nullboundary; $mimeboundary = $newboundary = $bndry; $recursemsg = $pastmsghdr = $boundarytoolong = $gotboundary = 0; } else { $recursemsg = 1; } } d583 13 a595 13 if (!$inmimehdr) { push @@mimeboundaries, $mimeboundary; push @@newboundaries, $newboundary; push @@rawboundaries, $rawboundary; push @@boundariestoolong, $boundarytoolong; push @@gotboundaries, $gotboundary; push @@nullboundaries, $nullboundary; $mimeboundary = $newboundary = ""; $recursemsg = $pastmsghdr = $boundarytoolong = $gotboundary = 0; } else { $recursemsg = 1; } } d613 8 a620 8 while (chomp($poisoned_spec = )) { $poisoned_spec =~ s/^\s+//g; $poisoned_spec =~ s/\s+$//g; next unless $poisoned_spec; $poisoned_spec =~ s/([^\\])\./$1\\./g; $poisoned_spec =~ s/\*/.*/g; $poisoned_spec =~ s/\?/./g; $poisoned_spec .= "(\\?=)?"; d622 1 a622 1 if ($filen =~ /^${poisoned_spec}$/i) { d635 1 a635 1 last; @ 0.10 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.9 2001-02-18 10:38:40-08 jhardin Exp jhardin $ d12 38 a49 29 use Locale::gettext; setlocale(LC_MESSAGES, ""); bindtextdomain("san", "/opt/sanitizer/locale"); textdomain("san"); $INFO = gettext("INFO:"); $CONF = gettext("CONF:"); $WARN = gettext("WARN:"); $HOST = $ENV{"HOST"} || $ENV{"HOSTNAME"}; $dbgv = $ENV{"DEBUG_VERBOSE"}; $dbg = $dbgv || $ENV{"DEBUG"}; # zero out arrays @@boundariestoolong = @@gotboundaries = @@mimeboundaries = @@newboundaries = @@nullboundaries = @@rawboundaries = @@Policy = (); # Do we have a quarantine directory? if ($Qdir = $ENV{"SECURITY_QUARANTINE_DIR"}) { $Qdir =~ s/(^\s+|\s+$)//g; die "$CONF \$SECURITY_QUARANTINE_DIR ", gettext("is not valid if relative"), "\n" if $Qdir !~ /^\//; $Qdir =~ s/\/$// if $Qdir ne "/"; die "$CONF \$SECURITY_QUARANTINE_DIR=\"$Qdir\": ", gettext("not a directory"), "\n" unless -d $Qdir; die "$CONF \$SECURITY_QUARANTINE_DIR=\"$Qdir\": ", gettext("not writable"), "\n" unless -w $Qdir; a51 1 d84 2 a85 2 warn "$CONF ...", gettext("defaulting to"), " SQ\n"; $policy = "SQ"; d107 1 a107 1 warn "$WARN ", gettext("no policy files defined by"), " \$SECURITY_POLICY\n"; d113 1 a113 1 # if not, default to strip and quarantine (SQ) d115 1 a115 1 my($glob, $policy, $dec, $enc, $ent); d117 2 a118 1 if ($file =~ /^=\?.*\?=$/) { d122 1 a122 1 while (($enc, $ent) = $file =~ /^=\?[-\w]+\?([a-z])\?([^?\s]+)\?=\s*/i) { d124 1 a124 1 $dec .= decode_qp($ent); d126 1 a126 1 $dec .= decode_base64($ent); d129 1 a129 1 $dec .= $ent; d131 1 a131 1 $file =~ s/^=\?[-\w]+\?[a-z]\?[^?\s]+\?=\s*//i; d135 1 a135 1 die "$WARN ", gettext("catastrophic failure in decode text"), "\n" unless $file; d143 2 a144 2 warn "$WARN ", gettext("no policy found for"), " $file - ", gettext("defaulting to"), " SQ\n"; return "SQ"; d186 41 d233 2 d255 1 a255 1 print "\tfor details. \$Revision: 0.9 $x\$Date: 2001-02-18 10:38:40-08 $x\n"; @ 0.9 log @*** empty log message *** @ text @d5 16 a20 1 # $Id: sanitizer.pl,v 0.8 2001-02-18 10:11:52-08 jhardin Exp jhardin $ d37 1 a37 1 die "CONF: relative \$SECURITY_QUARANTINE_DIR is not valid\n" if $Qdir !~ /^\//; d39 2 a40 2 die "CONF: \$SECURITY_QUARANTINE_DIR=\"$Qdir\": not a directory\n" unless -d $Qdir; die "CONF: \$SECURITY_QUARANTINE_DIR=\"$Qdir\": not writable\n" unless -w $Qdir; d51 1 a51 1 warn "INFO: reading policies\n" if $dbg; d55 1 a55 1 die "CONF: relative \$SECURITY_POLICY_DIR is not valid\n" if $dir !~ /^\//; d57 2 a58 2 die "CONF: \$SECURITY_POLICY_DIR=\"$dir\": not a directory\n" unless -d $dir; die "CONF: \$SECURITY_POLICY_DIR=\"$dir\": not readable\n" unless -r $dir; d65 1 a65 1 die "CONF: \$SECURITY_POLICY_DIR not given, cannot find $file\n" unless $dir; d68 1 a68 1 warn "INFO: policy $file\n" if $dbg; d74 3 a76 3 warn "CONF: No valid primary policy in \"$policy\"\n"; warn "CONF: ...file $file, glob $glob\n"; warn "CONF: ...defaulting to SQ\n"; d79 1 a79 1 die "CONF: \$SECURITY_QUARANTINE_DIR not given\n" if $policy =~ /^[a-z]*q/i && ! $Qdir; d84 1 a84 1 warn "INFO: $glob $policy\n" if $dbgv; d89 1 a89 1 warn "WARN: could not open $file: $!"; d93 1 a93 1 warn "INFO: *** Policy dump ***\n"; d95 1 a95 1 warn "INFO: $_\n"; d99 1 a99 1 warn "WARN: No policy files defined by \$SECURITY_POLICY\n"; d107 21 a127 1 my($glob, $policy); a131 3 # check i18n encoded filenames, too $glob = "(=\\?[a-z0-9-]+\\?Q\\?)?${glob}(\\?=)?"; return $policy if $file =~ /^${glob}$/i; d133 2 a134 1 warn "WARN: No policy found for $file - defaulting to SQ\n"; d159 1 a159 1 warn "MIME: Truncating long boundary string.\n"; d162 2 a163 2 warn "MIME: Replacing null boundary string.\n"; $newboundary = "==NULL_MIME_BOUNDARY_SANITIZED-${$}=="; d203 1 a203 1 print "\tfor details. \$Revision: 0.8 $x\$Date: 2001-02-18 10:11:52-08 $x\n"; @ 0.8 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.7 2001-02-17 12:02:00-08 jhardin Exp jhardin $ d19 10 d34 1 a34 1 return if @@Policy; d43 1 d60 2 a61 2 warn "CONF: file $file, glob $glob\n"; warn "CONF: defaulting to SQ\n"; d64 1 d170 1 a170 1 print "\tfor details. \$Revision: 0.7 $x\$Date: 2001-02-17 12:02:00-08 $x\n"; @ 0.7 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.5 2001-02-17 11:43:33-08 jhardin Exp jhardin $ d29 3 a31 4 $dir =~ s/^((\s+)|(\.\.+\/))+//; $dir =~ s/\s+$//; $dir =~ s/\/$//; die "CONF: \$SECURITY_POLICY_DIR is not valid.\n" unless $dir; d47 6 a55 2 $glob = "^${glob}(\\?=)?\$"; warn "CONF: No valid policy in $policy\n" unless $policy =~ /^[a-z]*[ d72 1 a72 1 warn "WARN: No policy files defined in \$SECURITY_POLICY\n"; d84 4 a87 1 return $policy if $file =~ /${glob}/i; d158 1 a158 1 print "\tfor details. \$Revision: 0.5 $x\$Date: 2001-02-17 11:43:33-08 $x\n"; @ 0.6 log @*** empty log message *** @ text @d52 1 @ 0.5 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.4 2001-02-16 21:22:31-08 jhardin Exp jhardin $ d72 1 a72 1 sub checkfile { d128 1 a128 1 print "$_ = ", checkfile($_), "\n"; d151 1 a151 1 print "\tfor details. \$Revision: 0.4 $x\$Date: 2001-02-16 21:22:31-08 $x\n"; @ 0.4 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.3 2001-02-16 21:17:13-08 jhardin Exp jhardin $ d7 10 d26 1 a26 1 warn "INFO: reading policies\n" if $ENV{"DEBUG"}; d40 1 a40 1 die "CONF: \$SECURITY_POLICY_FILES_DIR not given, cannot find $file\n" unless $dir; d43 1 a43 1 warn "INFO: policy $file\n" if $ENV{"DEBUG"}; d53 1 a53 1 warn "INFO: $glob $policy\n" if $ENV{"DEBUG_VERBOSE"}; d61 1 a61 1 if ($ENV{"DEBUG_VERBOSE"}) { d86 39 d151 1 a151 1 print "\tfor details. \$Revision: 0.3 $x\$Date: 2001-02-16 21:17:13-08 $x\n"; @ 0.3 log @*** empty log message *** @ text @d5 1 a5 1 # $Id: sanitizer.pl,v 0.2 2001-02-16 20:45:21-08 jhardin Exp jhardin $ d23 1 a23 1 die "CONF: $dir not a directory\n" unless -d $dir; d43 1 a43 1 warn "INFO: $glob $policy\n" if $ENV{"DEBUG"}; d72 1 d102 1 a102 1 print "\tfor details. \$Revision: 0.2 $x\$Date: 2001-02-16 20:45:21-08 $x\n"; @ 0.2 log @*** empty log message *** @ text @d5 1 a5 1 # $Id$ d19 1 a19 1 $dir =~ s/^((\s+)|(\.+\/))+//; d21 2 d101 1 a101 1 print "\tfor details. \$Revision: 0.1 $x\$Date: 2001-02-15 21:26:58-08 $x\n"; @ 0.1 log @l @ text @d1 6 d9 1 a9 1 sub readpolicy() { d14 3 d49 1 a49 1 if ($ENV{"DEBUG"}) { d55 14 d70 1 d73 8 a80 1 readpolicy(); exit; d99 1 a99 1 print "\tfor details. \$Revision: 1.128pre1 $x\$Date: 2001-02-03 10:08:32-08 $x\n"; @