API tools faq
paste
Advertisement
Matterz

Untitled

Matterz
Apr 29th, 2017
684
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 102.76 KB | None | 0 0
raw download clone embed print report
  1. # $Id: ASSP_AFC.pm,v 4.46 2017/02/28 09:30:00 TE Exp $
  2. # Author: Thomas Eckardt Thomas.Eckardt@thockar.com
  3.  
  4. # This is a ASSP-Plugin for full Attachment detection and ClamAV-scan.
  5. # Designed for ASSP v 2.4.5 build 15264 and above
  6. #
  7. # compressed attachment handling is sponsored by:
  8. # the International Bridge, Inc.
  9. # and the Devonshire Networking Group (Peter Hinman)
  10.  
  11. package ASSP_AFC;
  12. use threads 1.69 ('yield');
  13. use threads::shared 1.18;
  14.  
  15. our $VSTR;
  16. BEGIN {
  17. $VSTR = $];
  18. $VSTR =~ s/^(5\.)0(\d\d).+$/$1$2/o;
  19. }
  20.  
  21. use 5.010;
  22. use feature ":$VSTR"; # <- turn on the available version features
  23. use strict qw(vars subs);
  24. use Encode;
  25. use vars qw($VERSION);
  26. no warnings qw(uninitialized);
  27.  
  28. our $CanFileType;
  29. our $CanZIPCheck;
  30. our $CanRARCheck;
  31. our $Can7zCheck;
  32. our $CanLACheck;
  33. our $CanSMIME;
  34. our $CanNetSSLeay;
  35. our $ZIPLevel;
  36. our $formatsRe;
  37. our $z7zRe;
  38. our $LibArchRe;
  39. our $LibArchVer;
  40.  
  41. BEGIN {
  42. $z7zRe = '7z|7zip|AR|ARJ|BZ2|BZIP2|CAB|CHM|CPIO|CramFS|';
  43. $z7zRe .= 'DMG|EAR|EXT|FAT|GPT|GZIP|GZ|HFS|IHEX|ISO|JAR|';
  44. $z7zRe .= 'LBR|LHA|LRZ|LZ|LZ4|LZH|LZMA|LZR|';
  45. $z7zRe .= 'MBR|MSI|NSIS|NTFS|';
  46. $z7zRe .= 'PAR|QCOW2|RAR|RPM|SquashFS|';
  47. $z7zRe .= 'TAR|TBZ|TBZ2|UDF|UEFI|';
  48. $z7zRe .= 'VDI|VHD|VMDK|WAR|WIM|XAR|Z|ZIP';
  49.  
  50. $LibArchRe = '7z|7zip|AR|ARJ|BZ2|BZIP2|CPIO|';
  51. $LibArchRe .= 'EAR|EXT|GZIP|GZ|IHEX|ISO|JAR|';
  52. $LibArchRe .= 'LBR|LHA|LRZ|LZ|LZ4|LZH|LZMA|LZR|';
  53. $LibArchRe .= 'NSIS|';
  54. $LibArchRe .= 'PAR|PAX|QCOW2|RAR|RPM|SquashFS|';
  55. $LibArchRe .= 'TAR|TBZ|TBZ2|UDF|';
  56. $LibArchRe .= 'WAR|XAR|Z|ZIP';
  57.  
  58. if ($CanSMIME = eval('use Crypt::SMIME();Crypt::SMIME->VERSION;')) {
  59. $CanNetSSLeay = eval('use Net::SSLeay();1;');
  60. }
  61. if ($CanFileType = eval('use File::Type(); use MIME::Types(); 1;')) {
  62. $CanZIPCheck = eval('use Archive::Zip(); use Archive::Extract(); $Archive::Extract::WARN = 0; 1;');
  63. $formatsRe = 'TGZ|TAR|GZ|ZIP|BZ2|TBZ|Z|LZMA|XZ|TXZ' if $CanZIPCheck;
  64.  
  65. if (eval('use Archive::Rar::Passthrough(); 1;')) {
  66. $CanRARCheck = eval('my $r = Archive::Rar::Passthrough->new( rar => \'rar\' );
  67. $r->get_binary;
  68. ')
  69. || eval('use Archive::Rar::Passthrough();
  70. my $r = Archive::Rar::Passthrough->new( rar => \'unrar\' );
  71. $r->get_binary;
  72. ');
  73. # print "rar - $CanRARCheck\n";
  74. $formatsRe .= '|RAR' if $CanRARCheck;
  75.  
  76. # Archive::Rar::Passthrough may give back a RAR command incase 7z is not found - ignore this
  77. $Can7zCheck = eval('my $r = Archive::Rar::Passthrough->new( rar => \'7z\' );
  78. $r->get_binary;
  79. ');
  80. # print "7z - $Can7zCheck\n";
  81. $Can7zCheck = undef if $Can7zCheck !~ /p7zip|(?:7z(?:a|ip)?)(?:\.(?:exe|bat|cmd))?$/io;
  82.  
  83. $Can7zCheck ||= eval('my $r = Archive::Rar::Passthrough->new( rar => \'7za\' );
  84. $r->get_binary;
  85. ');
  86. # print "7za - $Can7zCheck\n";
  87. $Can7zCheck = undef if $Can7zCheck !~ /p7zip|(?:7z(?:a|ip)?)(?:\.(?:exe|bat|cmd))?$/io;
  88.  
  89. $Can7zCheck ||= eval('my $r = Archive::Rar::Passthrough->new( rar => \'7zip\' );
  90. $r->get_binary;
  91. ');
  92. # print "7zip - $Can7zCheck\n";
  93. $Can7zCheck = undef if $Can7zCheck !~ /p7zip|(?:7z(?:a|ip)?)(?:\.(?:exe|bat|cmd))?$/io;
  94.  
  95. $Can7zCheck ||= eval('my $r = Archive::Rar::Passthrough->new( rar => \'p7zip\' );
  96. $r->get_binary;
  97. ');
  98. # print "p7zip - $Can7zCheck\n";
  99. $Can7zCheck = undef if $Can7zCheck !~ /p7zip|(?:7z(?:a|ip)?)(?:\.(?:exe|bat|cmd))?$/io;
  100.  
  101. $formatsRe = $z7zRe if $Can7zCheck;
  102. }
  103.  
  104. if (eval('use Archive::Libarchive::XS qw( :all ); $LibArchVer = ARCHIVE_VERSION_NUMBER; 1;')) { # Libarchive
  105. $LibArchVer =~ s/(\d+)(\d{3})(\d{3})$/$1.$2.$3/o;
  106. $LibArchVer =~ s/\.0{1,2}/./go;
  107. $CanLACheck = 1;
  108. $formatsRe = $LibArchRe;
  109. } else { # set dummy constants in case Archive::Libarchive::XS is not available
  110. for (qw (
  111. ARCHIVE_EOF
  112. ARCHIVE_OK
  113. ARCHIVE_WARN
  114. ARCHIVE_FAILED
  115. ARCHIVE_FATAL
  116.  
  117. ARCHIVE_EXTRACT_TIME
  118. ARCHIVE_EXTRACT_PERM
  119. ARCHIVE_EXTRACT_ACL
  120. ARCHIVE_EXTRACT_FFLAGS
  121. ARCHIVE_EXTRACT_NO_OVERWRITE
  122. ARCHIVE_EXTRACT_SECURE_NOABSOLUTEPATHS
  123. ARCHIVE_EXTRACT_SECURE_NODOTDOT
  124. ARCHIVE_EXTRACT_SECURE_SYMLINKS
  125.  
  126. )
  127. )
  128. {
  129. eval("use constant $_ => 0;");
  130. print "$@\n" if $@;
  131. }
  132. }
  133. }
  134. }
  135.  
  136. our $old_CheckAttachments;
  137. our @attre;
  138. our @attZipre;
  139. our $userbased;
  140. our %SMIMEcfg;
  141. our %SMIMEcert;
  142. our %SMIMEkey;
  143. our %SMIMEuser:shared;
  144. our %skipSMIME;
  145.  
  146. $VERSION = $1 if('$Id: ASSP_AFC.pm,v 4.46 2017/02/28 09:30:00 TE Exp $' =~ /,v ([\d.]+) /);
  147. our $MINBUILD = '(15264)';
  148. our $MINASSPVER = '2.4.5'.$MINBUILD;
  149. our $plScan = 0;
  150.  
  151. $main::ModuleList{'Plugins::ASSP_AFC'} = $VERSION.'/'.$VERSION;
  152. $main::ModuleList{'Crypt::SMIME'} = $CanSMIME.'/0.13';
  153. $main::ModuleStat{'Crypt::SMIME'} = $CanSMIME ? 'enabled' : 'is not installed';
  154. $main::PluginFiles{__PACKAGE__ .'SMIME'} = 1;
  155. $main::licmap->{'100'} = 'SMIME signing';
  156. $main::reglic->{'100'} = {};
  157.  
  158. sub new {
  159. ###################################################################
  160. # this lines should not (or only very carful) be changed #
  161. # they are for initializing the varables #
  162. ###################################################################
  163. my $class = shift;
  164. $class = ref $class || $class;
  165. my $ASSPver = "$main::version$main::modversion";
  166. $ASSPver =~ s/RC\s*//o;
  167. if ($MINASSPVER gt $ASSPver or $MINBUILD gt $main::modversion) {
  168. mlog(0,"error: minimum ASSP-version $MINASSPVER is needed for version $VERSION of ASSP_AFC");
  169. return undef;
  170. }
  171. bless my $self = {}, $class;
  172. $self->{myName} = __PACKAGE__;
  173. my $mainVarName = 'main::Do'.$self->{myName};
  174. eval{$self->{DoMe} = $$mainVarName};
  175. $mainVarName = 'main::'.$self->{myName}.'Priority';
  176. eval{$self->{priority} = $$mainVarName};
  177. $self->{input} = 2; # 0 , 1 , 2 # call/run level
  178. $self->{output} = 0; # 0 , 1 # 0 = returns boolean 1 = returns boolean an data
  179. my @runlevel = ('\'SMTP-handshake\'','\'mail header\'','\'complete mail\'');
  180. $self->{runlevel} = @runlevel[$self->{input}];
  181. ###### END #####
  182.  
  183. # from here initialize your own variables
  184. $mainVarName = 'main::'.$self->{myName}.'Select';
  185. eval{$self->{select} = $$mainVarName};
  186. $mainVarName = 'main::'.$self->{myName}.'ReplBadAttach';
  187. eval{$self->{ra} = $$mainVarName};
  188. $mainVarName = 'main::'.$self->{myName}.'ReplBadAttachText';
  189. eval{$self->{ratext} = $$mainVarName};
  190. $mainVarName = 'main::'.$self->{myName}.'ReplViriParts';
  191. eval{$self->{rv} = $$mainVarName};
  192. $mainVarName = 'main::'.$self->{myName}.'ReplViriPartsText';
  193. eval{$self->{rvtext} = $$mainVarName};
  194. $mainVarName = 'main::'.$self->{myName}.'MSGSIZEscore';
  195. eval{$self->{score} = $$mainVarName};
  196. $self->{score} =~ s/\s//go;
  197. $mainVarName = 'main::'.$self->{myName}.'DetectSpamAttachReRE';
  198. eval{$self->{DetectSpamAttach} = $$mainVarName};
  199.  
  200. $mainVarName = 'main::'.$self->{myName}.'blockEncryptedZIP';
  201. eval{$self->{blockEncryptedZIP} = $$mainVarName};
  202. $mainVarName = 'main::'.$self->{myName}.'MaxZIPLevel';
  203. eval{$ZIPLevel = $self->{MaxZIPLevel} = $$mainVarName};
  204.  
  205. $mainVarName = 'main::'.$self->{myName}.'WebScript';
  206. eval{$self->{script} = $$mainVarName};
  207. $mainVarName = 'main::'.$self->{myName}.'outsize';
  208. eval{$self->{outsize} = $$mainVarName};
  209. $mainVarName = 'main::'.$self->{myName}.'insize';
  210. eval{$self->{insize} = $$mainVarName};
  211. $mainVarName = 'main::'.$self->{myName}.'SMIME';
  212. eval{$self->{SMIME} = $$mainVarName};
  213. $self->{outsize} =~ s/^\s+//o;
  214. $self->{outsize} =~ s/\s+$//o;
  215. $self->{outsize} *= 1024;
  216. $self->{insize} =~ s/^\s+//o;
  217. $self->{insize} =~ s/\s+$//o;
  218. $self->{insize} *= 1024;
  219. $self->{script} =~ s/^\s+//o;
  220. $self->{script} =~ s/\s+$//o;
  221.  
  222. $userbased = 0;
  223. return $self; # do not change this line!
  224. }
  225.  
  226. sub get_config {
  227. my $self = shift;
  228. my $f;
  229. $main::licmap->{'100'} = 'SMIME signing';
  230. $main::reglic->{'100'} = {};
  231. $f = $1 if $main::Config{UserAttach} =~ /^\s*file:\s*(.+)\s*$/o;
  232. my $formats = $formatsRe || 'no compression format available';
  233. $formats =~ s/\|/, /go;
  234. my $exe = $CanRARCheck;
  235. $exe .= ' , ' if $CanRARCheck && $Can7zCheck;
  236. $exe .= $Can7zCheck;
  237. $exe .= ' , ' if $exe;
  238. $exe .= "libarchive $LibArchVer" if $CanLACheck;
  239. $exe ||= 'no executable found';
  240. my @Config=(
  241. # except for the heading lines, all config lines have the following:
  242. # $name,$nicename,$size,$func,$default,$valid,$onchange,$description(,CssAdition)
  243. # name is the variable name that holds the data - from here accessable as $main::varable
  244. # nicename is a human readable pretty display name (oh how nice!)
  245. # size is the appropriate input box size
  246. # func is a function called to render the config item - always use main:: in front
  247. # default is the default value
  248. # valid is a regular expression used to clean and validate the input -- no match is an error and $1 is the desired result
  249. # onchange is a function to be called when this value is changed -- usually undef; just updating the value is enough
  250. # group is the heading group belonged to.
  251. # description is text displayed to help the user figure what to put in the entry
  252. # CssAddition (optional) adds the string to the CSS-name for nicename Style
  253.  
  254. # The following ConfigParms are tested by ASSP and it will not load the Plugin
  255. # if any of them is not valid
  256. [0,0,0,'heading',$self->{myName}.'-Plugin'],
  257. ['Do'.$self->{myName},'Do the '.$self->{myName}.' Plugin','0:disabled|1:enabled',\&main::listbox,0,'(\d*)',\&configChangeDoMe,
  258. 'This plugin is an addon to the default attachment- and ClamAV- engine of ASSP. The default engines only scannes the first MaxBytes/ClamAVBytes of an email. If you enable this plugin, the complete mail will be scanned for bad attachments and/or viruses!<br />
  259. The default engine(s) will be disabled by this enhanced version. Before you enable this plugin, please go to the configuration section(s) and configure the values for attachments and/or ClamAV! This plugin requires an installed <a href="http://search.cpan.org/search?query=Email::MIME" rel="external">Email::MIME</a> module in PERL.<br />
  260. This plugin is designed for- and running in call/run level '.$self->{runlevel}.'!',undef,undef,'msg100000','msg100001'],
  261. [$self->{myName}.'Select','Select the '.$self->{myName}.' Plugin Action','1:do attachments|2:do ClamAV and FileScan|3:do both',\&main::listbox,3,'(\d*)',\&configChangeSelect,
  262. 'If you enable one or both options of this plugin, the complete mail will be scanned for bad attachments and/or viruses!',undef,undef,'msg100010','msg100011'],
  263. [$self->{myName}.'Priority','the priority of the Plugin',5,\&main::textinput,'6','(\d+)',undef,
  264. 'Sets the priority of this Plugin within the call/run-level '.$self->{runlevel}.'. The Plugin with the lowest priority value is processed first!',undef,undef,'msg100020','msg100021'],
  265.  
  266. [$self->{myName}.'blockEncryptedZIP','Block Encrypted Compressed Attachments',0,\&main::checkbox,0,'(.*)',undef,
  267. 'If set, encrypted or password protected compressed attachments will be blocked or replaced according to ASSP_AFCSelect and ASSP_AFCReplBadAttach . This setting is a general switch - an override can be done using UserAttach !<br />
  268. <hr />
  269. <br />
  270. <div class="shadow">
  271. <div class="optionTitle">
  272. Analyzing Compressed Attachments
  273. </div></div>
  274. Independend from the setting of '.$self->{myName}.'blockEncryptedZIP this plugin provides several mechanism to analyze compressed attachments.<br />
  275. To enable the compressed attachment processing, UserAttach has to be configured!<br >
  276. To analyze compressed attachments, configure \'UserAttach\'. This plugin enhances the definiton options for UserAttach. In addition to the existing options, the following syntax could be used:<br />
  277. For example:<br />
  278. zip:user@domain.tld => good => ai|asc|bhx|dat|doc|eps|zip<br />
  279. zip:*@domain.tld => good => ai|asc|bhx , good-out => eps|gif , good-in => htm|html , block => pdf|ppt , block-out => rar|rpt , block-in => xls|exe\-bin|:MSOM|crypt\-zip|encrypt<br /><br />
  280. Those definitions (notice the leading zip:) are only used inside compressed files.<br />
  281. The extension \'crypt-zip\' could be used to allow or deni encrypted compressed attachments for users at any compression level.<br />
  282. The extension \'encrypt\' could be used to allow or deni encrypted (eg. aes) for users.<br /><br />
  283. If \'exe-bin\' is defined, the Plugin will detect executable files based on there binary content. Detected will be all executables, libraries and scripts for DOS and Windows (except .com files), MS office macros(VBA), MAC-OS and linux ELF (for all processor architectures).<br />
  284. If you want to skip the detection for a specific executable type, specify exe-bin (which detects all executables) and then add exceptions to exclude specific types:Example: \'exe-bin|:MSOM|:WSH\' - notice the single leading collon for the exceptions! This example will block all detected executable files except for MS Office Macro files (:MSOM) and Windows Shell Scripts (:WSH)<br /><br />
  285. :WIN - windows executables<br />
  286. :MOS - Mach-O executables<br />
  287. :PEF - Classic MacOS executables<br />
  288. :ELF - ELF (linux) executables<br />
  289. :WSH - windows shell scripts<br />
  290. :MMC - windows MMC Console Files<br />
  291. :ARC - static library (linux,unix)<br />
  292. :CSC - common scripts (basic,java,perl,php,powershell....)<br />
  293. :MSOM - microsoft office macros<br /><br />
  294. The following compression formats are supported by the common perl module Archive::Extract: tar.gz,tgz,gz,tar,zip,jar,ear,war,par,tbz,tbz2,tar.bz,tar.bz2,bz2,Z,lzma,txz,tar.xz,xz.<br />
  295. The detection of compressed files is done content based not filename extension based. The perl modules File::Type and MIME::Types are required in every case!<br />
  296. Depending on your Perl distribution, it could be possible that you must install additionally \'IO::Compress::...\' (for example: IO::Compress:Lzma) modules to support the compression methodes with Archive::Extract.<br />
  297. If the perl module Archive::Rar and a rar or unrar binary for your OS are installed (in PATH), the RAR format is also supported.<br />
  298. If the perl module Archive::Rar and a 7z/7za/7zip or p7zip executable is available at the system (in PATH), the following formats are supported: 7z, XZ, BZIP2, BZ2, GZIP, GZ, TAR.GZ, TAR, ZIP, WIM, AR, ARJ, CAB, CHM, CPIO, CramFS, DMG, EXT, FAT, GPT, HFS, IHEX, ISO, LHA, LZH, LZMA, MBR, MSI, NSIS, NTFS, QCOW2, RAR, RPM, SquashFS, UDF, UEFI, VDI, VHD, VMDK, WIM, XAR, Z.<br />
  299. If the perl module Archive::Libarchive::XS is available , the following formats are supported: 7z, XZ, BZIP2, BZ2, GZIP, GZ, TAR.GZ, TAR, ZIP, WIM, AR, ARJ, CPIO, EXT, IHEX, ISO, LHA, LZH, LZMA, NSIS, QCOW2, RAR, RPM, SquashFS, UDF, XAR, Z.<br /><br />
  300. For performance reasons it is strongly recommended to install the module Archive::Libarchive::XS!<br />
  301. Currently supported compression formats are: '.$formats.'<br />
  302. Detected decompression executables are: '.$exe.'<br />
  303. If multiple options are available to decompress a file, ASSP_AFC will use the following order: first Archive::Libarchive::XS, than Archive::Extract, than Archive::Rar + rar/unrar and last Archive::Rar + 7z. <br />
  304. Notice: you need to restart assp after installing any perl module and/or exexutable, to get them activated!<br />'.
  305. ($f ? '<input type="button" value="User-Attach-File" onclick="javascript:popFileEditor(\''.$f.'\',1);" />' : '' ),undef,undef,'msg100120','msg100121'],
  306. [$self->{myName}.'MaxZIPLevel','Maximum Decompression Level',10,\&main::textinput,10,'([1-9]\d*)',undef,
  307. 'The maximum decompression cycles use on a compressed attachment (eg: zip in zip in zip ...). Default value is 10 - zero is not allowed to be used!',undef,undef,'msg100130','msg100131'],
  308.  
  309. [$self->{myName}.'ReplBadAttach','Replace Bad Attachments',0,\&main::checkbox,0,'(.*)',undef,
  310. 'If set and AttachmentBlocking is set to block, the mail will not be blocked but the bad attachment will be replaced with a text!',undef,undef,'msg100030','msg100031'],
  311. [$self->{myName}.'ReplBadAttachText','Replace Bad Attachments Text',100,\&main::textinput,'The attached file (FILENAME) was removed from this email by ASSP for policy reasons! The file was detected as REASON .','(.*)',undef,
  312. 'The text which replaces the bad attachment. The litteral FILENAME will be replaced with the name of the bad attachment! The litteral REASON will be replaced with the reason, because the attachment was rejected!',undef,undef,'msg100040','msg100041'],
  313. [$self->{myName}.'ReplViriParts','Replace Virus Parts',0,\&main::checkbox,0,'(.*)',undef,
  314. 'If set and virus scanning (UseClamAV) is enabled, the mail will not be blocked but the bad attachment or mail part will be replaced with a text!',undef,undef,'msg100050','msg100051'],
  315. [$self->{myName}.'ReplViriPartsText','Replace Virus Parts Text',100,\&main::textinput,'There was a virus (VIRUS) removed from this email (attachment FILENAME) by ASSP!','(.*)',undef,
  316. 'The text which replaces the bad mailparts that contains a virus. The litteral FILENAME will be replaced with the name of a bad attachment! The litteral VIRUS will be replaced with the name of the virus!',undef,undef,'msg100060','msg100061'],
  317. [$self->{myName}.'MSGSIZEscore','Increase MSG-Score on MSG Size',100,\&main::textinput,'','(\s*\d+\s*\=\>\s*\d+\s*(?:,\s*\d+\s*\=\>\s*\d+\s*)*|)',undef,
  318. 'You can increase the message score of a mail because of its size (in byte). Define the size and scores in a comma separated list using the syntax \'size=&gt;score[,othersize=&gt;otherscore]\'. The list will be processed in reversed numerical order of the size value. If the size of a mail is equal or higher as the defined size, the associated message score will be added. An possible definition could be:<br /><br />
  319. 500000=&gt;10,1000000=&gt;5,1500000=&gt;0<br /><br />
  320. which meens:
  321. if the message size is &gt;= 1500000 byte no score will be added<br />
  322. if the message size is &gt;= 1000000 byte and &lt; 1500000 byte a score of 5 will be added<br />
  323. if the message size is &gt;= 500000 byte and &lt; 1000000 byte a score of 10 will be added<br />
  324. if the message size is &lt; 500000 byte no score will be added.<br /><br />
  325. This feature will not process incomming mails, whitelisted mails and mail that are noprocessing - except mails, that are noprocessing only because of there message size (npSize).',undef,undef,'msg100070','msg100071'],
  326. [$self->{myName}.'DetectSpamAttachRe','Detect Spam Attachments*',40,\&main::textinput,'image\/','(.*)','ConfigCompileRe',
  327. 'An regular expression used on the "Content-Type" header tag to detect MIME parts that should be checked to be known spam or not. The rebuildspamdb task will build spamdb entries for these attachements and inlines (in assp build 12022 and higher). The plugin will block an email, if a bad attachment is found and was not removed/replaced by any other rule in this plugin. Leave this blank to disable the feature.<br />
  328. for example:<br /><br />
  329. image\/<br />
  330. application\/pd[ft]<br />
  331. application\/zip
  332. ',undef,undef,'msg100080','msg100081'],
  333.  
  334. [$self->{myName}.'WebScript','Script to move large attachments to a web server',140,\&main::textinput,'','(.*)',undef,
  335. 'If the size of an undecoded attachment exceeds the '.$self->{myName}.'insize or '.$self->{myName}.'outsize parameter, assp will call this script and will replace the attachment with the text returned by this script or executable.<br />
  336. If no text is returned by the script (a warning is written to the maillog.txt) or the returned text begins with the word "error", the attachment will not be replaced.<br />
  337. The script has to write the resulting text or error to STDOUT.<br />
  338. The resulting text could be any of plain text or html code. The MIME-enconding and the Content-Type value of the resulting MIME-part will be set accordingly.<br />
  339. The text should contain the link to download the attachment, possibly some explanation (eg. download life time), web login information or a web-session-identifier - what ever is needed to fit the requirements of your web server.<br />
  340. You have to define the full path to the script and all parameters that should be pass to the script. The literal FILENAME will be replaced with the attachment filename (including the full path) that was stored in the /transfer folder. Any literal starting with an \'$\', will be replaced by the according connection hash value or the global variable with the name.<br /><br />
  341. for example:<br />
  342. $relayok will be replaced by $Con->{relayok} - which identifies if it is an incoming (1) or outgoing/local (0) mail<br /><br />
  343. So a possible definition of this parameter could be: <br />
  344. \'/usr/bin/move_attachment_to_web.sh $relayok FILENAME\' <br />
  345. or <br />
  346. \'c:/assp/move_attachment_to_web.cmd $relayok FILENAME\'<br /><br />
  347. The file has to be removed by the script. If not, assp will warn about this and will remove the file in the /transfer folder.<br />
  348. To keep the filenames unique, the assp message identifier is placed in front of the filename - like: M1-30438-02027_attachmentfilename. Notice: if the filename contains unicode characters, assp will pass this characters in UTF-8 to your script!<br />
  349. Keep in mind, that if this script terminates it\'s own process - ASSP will die!
  350. ',undef,undef,'msg100090','msg100091'],
  351.  
  352. [$self->{myName}.'insize','Attachment size incoming',40,\&main::textinput,'1024','(\d*)',undef,
  353. 'The size in KB of an attachment in incoming mails that must be reached, to call the '.$self->{myName}.'WebScript. This parameter is ignored if left blank or set to zero.',undef,undef,'msg100100','msg100101'],
  354. [$self->{myName}.'outsize','Attachment size outgoing/local',40,\&main::textinput,'1024','(\d*)',undef,
  355. 'The size in KB of an attachment in outgoing or local mails that must be reached, to call the '.$self->{myName}.'WebScript. This parameter is ignored if left blank or set to zero.',undef,undef,'msg100110','msg100111'],
  356.  
  357. [$self->{myName}.'SMIME','SMIME sign outgoing mails*',80,\&main::textinput,'file:files/smime_cfg.txt','(file:.+|)',\&configChangeSMIME,
  358. '<b>An "SMIME feature license" assigned to this host is required to use this feature!</b><br />
  359. Licenses are granted user based (10,50,100,250,500,1000) for a periode of two years.<br />
  360. An licensed user is an email address, that uses this feature at least one time, within the licensed periode.<br />
  361. For pricing information, please contact <a href="mailto:Thomas.Eckardt@thockar.com">Thomas Eckardt via email</a> or visit <a href="http://www.thockar.com" target="_blank">www.thockar.com</a> .<br /><br />
  362. <b>Feature description:</b><br />
  363. This feature requires an installed Perl module <a href="http://search.cpan.org/search?query=Crypt::SMIME" rel="external">Crypt::SMIME</a> .<br />
  364. If configured, outgoing mails will be digitaly signed according to the SMIME specifications provided by the installed OpenSSL and Crypt::SMIME version - this is S/MIME Version 3.1 (specification is in RFC 3851) , newer version may support S/MIME Version 3.2 (specification is in RFC 5751).<br />
  365. It is possible to configure privat and/or corporate signatures. In any case, the "file:" option must be used - specify one configuration per line.<br />
  366. The domain or user is separated by "=&gt;" from the signing configuration/policy. It is possible to use group definitions of domains and users using the [ Groups ] option. Define one line per domain or user or group.<br />
  367. Configuration entries are separated by comma.<br />
  368. Configuration entry pairs (tag and value) are separated by "=".<br />
  369. File definitions for the certificate and privat key have to include the full path to the file! Certificate and privat key have to be provided in PEM format<br />
  370. If you exchange any certificate or key file, click "Edit file" and save the file again to force a reload of the internal certificate store.<br />
  371. The domain / user part accepts full email addresses , domains and groups - wildcards are supported and must be used for domain definitions.<br />
  372. The domain / user part is compaired to the envelope sender - the first matching entry (in reverse generic order) will be used. Entries starting with a minus sign, explicit exclude the domain/user/group from SMIME processing.<br /><br />
  373. certfile - is required and specifys the full path to the certificate to use. The subject of the certificate has to include a valid email address. In normal case, this email address is specified by the cert-subject-tag "emailAddress". The "FROM:" address in the mail header will be replaced by this email address and a "Reply-To:" line with the original sender is added (or replaced) to the mail header.<br />
  374. If the subject of the certificate specifys the email address in another tag, define this tag (NOT the email address) after "emailaddress=".<br /><br />
  375. keyfile - is required and specifys the full path to the file that contains the privat key<br /><br />
  376. keypass - the tag is required, the value is optional - defines the password required (or not) for the privat key<br /><br />
  377. emailaddress - is optional - please read "certfile"<br />
  378. rcpt - is optional - include/[-]exclude mails to specified users and/or domains (recipients) - to exclude addresses, write a minus in front - separate multiple entries by space<br /><br >
  379. examples:<br /><br />
  380. - (1) user@your.domain =&gt; certfile=/certs/user_cert.pem, keyfile=/certs/user_key.pem, keypass=, rcpt=-otheruser@other.domain<br />
  381. - (2) *your.domain =&gt; certfile=/certs/corporate_cert.pem, keyfile=/certs/corporate_key.pem, keypass=mypassword<br />
  382. - (3) *@your.domain =&gt; certfile=/certs/corporate_cert.pem, keyfile=/certs/corporate_key.pem, keypass= , emailaddress=Email<br />
  383. - (4) -user4@your.domain<br />
  384. - (5) -*@*.your.domain<br />
  385. - (6) -[no_smime]<br /><br />
  386. The first example specifys a privat signing policy which exclude the recipient otheruser@other.domain, the second and third example specifys a corporate signing policy (with and without subdomains). The fourth example excludes the user "user4@your.domain" from SMIME processing. The fives example excludes all subdomains of "your.domain" from SMIME processing. The last example excludes all domains, subdomains and users defined in the group "[no_smime]" from SMIME processing.<br /><br />
  387. corporate SMIME signing:<br /><br />
  388. Assume we define the following configuration line:<br >
  389. *@your.domain.com =&gt; certfile=/certs/corporate_cert.pem, keyfile=/certs/corporate_key.pem, keypass=<br />
  390. Now let\'s say, the subject of the specified certificate (corporate_cert.pem) contains .../emailAddress=central.office@your.domain.com/...<br />
  391. Your local user "mark.schmitz@your.domain.com" sends a mail to an external recipient. The related mail header is:<br /><br />
  392. From: "Mark Schmitz" &lt;mark.schmitz@your.domain.com&gt;<br />
  393. Disposition-Notification-To: &lt;mark.schmitz@your.domain.com&gt;<br /><br />
  394. After SMIME signing the mail, the related mail headers are the following:<br /><br />
  395. From: "Mark Schmitz" &lt;central.office@your.domain.com&gt;<br />
  396. Disposition-Notification-To: &lt;mark.schmitz@your.domain.com&gt;<br />
  397. Reply-To: &lt;mark.schmitz@your.domain.com&gt;<br />
  398. References: assp-corp-smime-mark.schmitz@your.domain.com<br /><br />
  399. The mail client of the recipient will validate the signature against the "From" address - which corresponds to the email address specified in the subject of the certificate -> VALID<br />
  400. Pressing the "REPLY/ANSWER" button, the mail client will provide "mark.schmitz@your.domain.com" as recipient address (To:) for the answer, using the entry in the "Reply-To:" header.<br />
  401. Notice, that some bad and/or older mail clients are ignoring the "Reply-To:" header tag - in such case an answered mail will go to "central.office@your.domain.com".<br />
  402. ASSP will help you a bit to prevent this. In addition to the required mail header changes, assp will add or enhance the "References:" mail header tag with a value of "assp-corp-smime-EMAILADDRESS" , where EMAILADDRESS is the original sender address.<br />
  403. If assp receives an answered mail, it will look for such an entry in the mail header and will add the found email address to the "To" header, if it is not already found there.
  404. ',undef,undef,'msg100140','msg100141']
  405.  
  406. #######
  407. );
  408.  
  409. $main::preMakeRE{'ASSP_AFCDetectSpamAttachReRE'} = 1;
  410. return @Config;
  411. }
  412.  
  413. sub configChangeDoMe {
  414. my ($name, $old, $new, $init)=@_;
  415. mlog(0,"AdminUpdate: $name updated from '$old' to '$new'") unless $init || $new eq $old;
  416. $main::attachLogNoPL = 1;
  417. if ($new == 1) {
  418. $main::attachLogNoPL = 0 if ($main::ASSP_AFCSelect != 2);
  419. }
  420. $main::Config{$name} = $new;
  421. ${"main::$name"} = $new;
  422. return '';
  423. }
  424.  
  425. sub configChangeSelect {
  426. my ($name, $old, $new, $init)=@_;
  427. mlog(0,"AdminUpdate: $name updated from '$old' to '$new'") unless $init || $new eq $old;
  428. $main::attachLogNoPL = 1;
  429. if ($new != 2) {
  430. $main::attachLogNoPL = 0 if $main::DoASSP_AFC;
  431. }
  432. $main::Config{$name} = $new;
  433. ${"main::$name"} = $new;
  434. return '';
  435. }
  436.  
  437. sub configChangeSMIME {
  438. my ($name, $old, $new, $init)=@_;
  439. mlog(0,"AdminUpdate: $name updated from '$old' to '$new'") unless $init || $new eq $old;
  440.  
  441. return if ($new =~ /^(?:[a-fA-F0-9]{2}){5,}$/o);
  442.  
  443. $main::Config{$name} = $new;
  444. ${"main::$name"} = $new;
  445. my @new = &main::checkOptionList($new,$name,$init);
  446. %SMIMEcfg = ();
  447. %SMIMEcert = ();
  448. %SMIMEkey = ();
  449. %skipSMIME = ();
  450. my $ret;
  451. if ($new[0] =~ s/^\x00\xff //o) {
  452. ${$name} = $main::Config{$name} = $old;
  453. return &main::ConfigShowError(1,$new[0]);
  454. }
  455. if (! $CanSMIME) {
  456. $ret .= &main::ConfigShowError(1,"$name: missing Perl module Crypt::SMIME - SMIME processing is not available") if $main::WorkerNumber == 0;
  457. return $ret;
  458. }
  459. if (! $CanNetSSLeay) {
  460. $ret .= &main::ConfigShowError(1,"$name: missing Perl module Net::SSLeay - SMIME processing is not available") if $main::WorkerNumber == 0;
  461. return $ret;
  462. }
  463. s/^\s+//o for @new;
  464. @new = reverse sort @new;
  465. while ( @new ) {
  466. my $entry = shift @new;
  467. next if ($entry =~ /^\s*$/o);
  468. if ( $entry =~ s/^(-)?\s*\[\s*([A-Za-z0-9.\-_]+)\s*\]s*/\[$2\]/o) {
  469. my $minus = $1;
  470. $ret .= &main::ConfigRegisterGroupWatch(\$entry,$name,'SMIME');
  471. my @ne = split(/\|/o,$entry);
  472. @ne = map {my $t = $minus . $_ ; $t} @ne if $minus;
  473. push @new , @ne;
  474. @new = reverse sort @new;
  475. next;
  476. }
  477. my ($domain,$values) = split(/\s*=>\s*/io,$entry);
  478. $entry =~ s/keypass\s*=\s*\S*//go;
  479. my $skip = $domain =~ s/^-\s*//o;
  480. if (! $domain || (! $skip && ! $values) || (! $init && $domain !~ /(?:\*|(?:\*|\w\w+)\.$main::TLDSRE)$/o)) {
  481. $ret .= &main::ConfigShowError(1,"$name: invalid entry '$entry' is ignored - check the syntax") if $main::WorkerNumber == 0;
  482. next;
  483. }
  484. my $dd = $domain = lc $domain;
  485. if ($skip) {
  486. $skipSMIME{$domain} = 1;
  487. mlog(0,"info: skip domain/user '$dd' from SMIME processing") if $main::WorkerNumber == 0;
  488. next;
  489. }
  490. my $how = $dd =~ /^($main::EmailAdrRe\@$main::EmailDomainRe)$/o ? 'privat' : 'corporate';
  491. $domain =~ s/\@/\\@/og;
  492. my $i = -1;
  493. my %e = map {my $t = $_; ++$i % 2 ? $t : lc $t;} split(/\s*[,=]\s*/o,$values);
  494. if (! exists $e{'certfile'}) {
  495. $ret .= &main::ConfigShowError(1,"$name: missing 'certfile' in '$entry' - entry is ignored") if $main::WorkerNumber == 0;
  496. next;
  497. }
  498. if (! $main::eF->($e{'certfile'})) {
  499. $ret .= &main::ConfigShowError(1,"$name: can't find 'certfile' ".$e{'certfile'}." in '$entry' - entry is ignored") if $main::WorkerNumber == 0;
  500. next;
  501. }
  502. if (! exists $e{'keyfile'} && exists $e{'keypass'}) {
  503. $ret .= &main::ConfigShowError(1,"$name: missing 'keyfile' in '$entry' - entry is ignored") if $main::WorkerNumber == 0;
  504. next;
  505. }
  506. if (exists $e{'keyfile'} && ! $main::eF->($e{'keyfile'})) {
  507. $ret .= &main::ConfigShowError(1,"$name: can't find 'keyfile' ".$e{'keyfile'}." in '$entry' - entry is ignored") if $main::WorkerNumber == 0;
  508. next;
  509. }
  510. my ($fullout, $out, $nbn, $nbt, $nan, $nat, @keyusage);
  511. # get the subject of the cert and do some additionaly checks
  512. eval {
  513. my $bio = Net::SSLeay::BIO_new_file($e{'certfile'}, 'rb');
  514. my $x509 = Net::SSLeay::PEM_read_bio_X509($bio);
  515. my $subj_name = Net::SSLeay::X509_get_subject_name($x509);
  516. $fullout = $out = Net::SSLeay::X509_NAME_print_ex($subj_name)."\n";
  517. $nbn = $nbt = Net::SSLeay::P_ASN1_TIME_get_isotime(Net::SSLeay::X509_get_notBefore($x509));
  518. $nan = $nat = Net::SSLeay::P_ASN1_TIME_get_isotime(Net::SSLeay::X509_get_notAfter($x509));
  519. $nbn =~ s/(\d{4}\-\d{2}\-\d{2})T(\d{2}\:\d{2}\:\d{2})Z/&main::timeval("$1,$2")/eo;
  520. $nan =~ s/(\d{4}\-\d{2}\-\d{2})T(\d{2}\:\d{2}\:\d{2})Z/&main::timeval("$1,$2")/eo;
  521. @keyusage = Net::SSLeay::P_X509_get_key_usage($x509);
  522. Net::SSLeay::BIO_free($bio);
  523. };
  524. if ($@) {
  525. $ret .= &main::ConfigShowError(1,"$name: error while processing the certificate '$e{certfile}' - $@") if $main::WorkerNumber == 0;
  526. next;
  527. }
  528. if ($nbn > time) {
  529. $ret .= &main::ConfigShowError(1,"$name: the certificate '$e{certfile}' is not yet valid - notBefore: $nbt") if $main::WorkerNumber == 0;
  530. next;
  531. }
  532. if ($nan < time) {
  533. $ret .= &main::ConfigShowError(1,"$name: the certificate '$e{certfile}' is no longer valid - notAfter: $nat") if $main::WorkerNumber == 0;
  534. next;
  535. }
  536. if (! grep(/digitalSignature/io,@keyusage)) {
  537. $ret .= &main::ConfigShowError(1,"$name: the certificate '$e{certfile}' is not valid for SMIME signing - available key usages are: '@keyusage'") if $main::WorkerNumber == 0;
  538. next;
  539. }
  540. my %cert = split(/\/|=/o,lc $out);
  541. $cert{emailaddress} ||= $cert{$e{emailaddress}};
  542. delete $cert{$e{emailaddress}} if $e{emailaddress} ne 'emailaddress' && delete $e{emailaddress};
  543. ($cert{emailaddress}) = $cert{emailaddress} =~ /($main::EmailAdrRe\@$main::EmailDomainRe)/o;
  544. if ( ! $cert{emailaddress} ) {
  545. $ret .= &main::ConfigShowError(1,"$name: the subject of the certificate '$e{certfile}' contains no valid email address 'emailAddress' - $fullout") if $main::WorkerNumber == 0;
  546. next;
  547. }
  548. if (!($SMIMEcert{$e{'certfile'}} = ${readCertFile($e{'certfile'})})) {
  549. $ret .= &main::ConfigShowError(1,"$name: no content read from the certificate file '$e{certfile}'") if $main::WorkerNumber == 0;
  550. delete $SMIMEcert{$e{'certfile'}};
  551. next;
  552. }
  553. if (!($SMIMEkey{$e{'keyfile'}} = ${readCertFile($e{'keyfile'})})) {
  554. $ret .= &main::ConfigShowError(1,"$name: no content read from the key file '$e{keyfile}'") if $main::WorkerNumber == 0;
  555. delete $SMIMEkey{$e{'keyfile'}};
  556. next;
  557. }
  558. my %en = %e;
  559. delete $en{$_} for ('certfile', 'keyfile', 'keypass', 'rcpt');
  560. foreach (keys %en) {
  561. delete $e{$_};
  562. mlog(0,"warning: $name: ignoring invalid/unused parameter '$_' in '$entry'") if $main::WorkerNumber == 0;
  563. }
  564. if ($e{'rcpt'}) {
  565. my @rcpt = split(/\s+/o,$e{'rcpt'});
  566. if (@rcpt) {
  567. delete $e{'rcpt'};
  568. $e{'rcpt'} = {};
  569. while (@rcpt) {
  570. my $r = shift(@rcpt);
  571. next unless $r;
  572. my $minus;
  573. if ($minus = ($r =~ s/^-//o)) {
  574. $r = shift(@rcpt) unless $r;
  575. next unless $r;
  576. }
  577. $r =~ s/\@/\\@/og;
  578. if ($minus) {
  579. $e{'rcpt'}->{'-'}->{$r} = 1;
  580. } else {
  581. $e{'rcpt'}->{'+'}->{$r} = 1;
  582. }
  583. }
  584. $e{'rcpt'}->{'+'}->{'*'} = 1 if exists $e{'rcpt'}->{'-'} && ! exists $e{'rcpt'}->{'+'};
  585. delete $e{'rcpt'} unless $e{'rcpt'}->{'-'} || $e{'rcpt'}->{'+'};
  586. } else {
  587. delete $e{'rcpt'};
  588. }
  589. }
  590. $out = runSMIME(\%e,'');
  591. if ( ! ref($out) ) {
  592. $ret .= &main::ConfigShowError(1,"$name: can't create SMIME signature for '$entry' - entry is ignored - $out") if $main::WorkerNumber == 0;
  593. next;
  594. }
  595. $SMIMEcfg{$domain} = \%e;
  596. $SMIMEcfg{$domain}->{emailaddress} = $cert{emailaddress};
  597. mlog(0,"info: registered domain/user '$dd' for SMIME $how signing with '$cert{emailaddress}'") if $main::WorkerNumber == 0;
  598. }
  599. $ret .= &main::ConfigShowError(1,"$name: There is no valid SMIME signing license installed for this installation - SMIME signing will not work!") if $main::WorkerNumber == 0 && $main::WorkerName ne 'startup' && eval{$main::L->($main::T[100])->{call}->{'100'}->('','');} == '0';
  600. return $ret;
  601. }
  602.  
  603. sub runSMIME {
  604. my ($parm,$email,$this) = @_;
  605. my $smime = Crypt::SMIME->new() or return "internal error - unable to create a new Crypt::SMIME object";
  606. my $msg;
  607. eval{
  608. $smime->setPrivateKey(${&readCertFile($parm->{keyfile})}, ${&readCertFile($parm->{certfile})}, $parm->{keypass});
  609. $msg = $smime->sign($email ? $main::L->($main::T[100])->{xcall}->{'100'}->($email,$this) : "\r\n");
  610. };
  611. return ($msg =~ /protocol\s*=\s*"?application\/(?:x-)?pkcs7-signature/oi ? \$msg : "the body was not signed - $@");
  612. }
  613.  
  614. sub readCertFile {
  615. my $file = shift;
  616. my $o = $SMIMEcert{$file} || $SMIMEkey{$file};
  617. return \$o if $o;
  618. open(my $f, '<', $file) || (mlog(0,"error: can't open file $file for reading - $!") && return);
  619. binmode $f;
  620. $o = join('',<$f>);
  621. close $f;
  622. return \$o;
  623. }
  624.  
  625. sub get_input {
  626. my $self = shift;
  627. return $self->{input};
  628. }
  629.  
  630. sub get_output {
  631. my $self = shift;
  632. return $self->{output};
  633. }
  634.  
  635. sub get_MIME_parts {
  636. my ($self, $callback) = @_;
  637. my $walk_weak;
  638. my $walk = sub {
  639. my ($part) = @_;
  640. $callback->($part);
  641. for my $part ($part->subparts) {
  642. $walk_weak->($part);
  643. }
  644. return;
  645. };
  646. $walk_weak = $walk;
  647. Scalar::Util::weaken $walk_weak;
  648. $walk->($self);
  649. undef $walk;
  650. return;
  651. }
  652.  
  653. sub process {
  654. ###################################################################
  655. # this lines should not (or only very carful) be changed #
  656. # they are for initializing the varables and to return the right #
  657. # values while ASSP is testing the Plugin #
  658. ###################################################################
  659. my $self = shift; # this we are self
  660. my $fh = shift; # this is the referenz to the filehandle from ASSP
  661. my $data = shift; # this is the referenz to the data to process
  662. $fh = $$fh if($fh); # dereferenz the handle
  663. my $this = $main::Con{$fh} if ($fh); # this sets $this to the client-connection hash
  664. $self->{result} = ''; # reset the return values
  665. $self->{tocheck} = '';
  666. $self->{errstr} = '';
  667.  
  668. if ($$data =~ /ASSP_Plugin_TEST/) { # Plugin has to answer this, if ASSP makes tests on it
  669. configChangeDoMe('Do'.$self->{myName},$self->{DoMe},$self->{DoMe},'INIT');
  670. configChangeSelect($self->{myName}.'Select',$self->{select},$self->{select},'INIT');
  671. configChangeSMIME($self->{myName}.'SMIME',$self->{SMIME},$self->{SMIME},'INIT');
  672. $self->{result} = $$data;
  673. $self->{errstr} = "data processed";
  674. $self->{tocheck} = $$data;
  675. $self->{DoMe} = 9; # always set to 9 if the Plugin is tested
  676. mlog($fh,"$self->{myName}: Plugin successful called!") if $main::MaintenanceLog;
  677. if (! $CanFileType) {
  678. mlog($fh,"warning: all compressed attachment checks are disabled because any of the following Perl modules is missing: File::Type , MIME::Types");
  679. } else {
  680. if (! ($Can7zCheck || $CanZIPCheck || $CanLACheck)) {
  681. mlog($fh,"warning: common compressed attachment checks are disabled because a 7z executable and the module Archive::Rar::Passthrough is missing - and alternative - the following Perl modules are missing: Archive::Zip , Archive::Extract - and alternative - the following Perl modules is missing: Archive::Libarchive::XS");
  682. }
  683. if (! ($Can7zCheck || $CanRARCheck || $CanLACheck)) {
  684. mlog($fh,"warning: RAR compressed attachment checks are disabled because a 7z executable and the module Archive::Rar::Passthrough is missing - and alternative - a rar/unrar executable and the module Archive::Rar::Passthrough is missing - and alternative - the following Perl modules is missing: Archive::Libarchive::XS");
  685. }
  686. if (! ($Can7zCheck || $CanLACheck)) {
  687. mlog($fh,"warning: 7z compressed attachment checks are disabled because a 7z executable and the module Archive::Rar::Passthrough is missing - and alternative - the following Perl modules is missing: Archive::Libarchive::XS");
  688. }
  689.  
  690. mlog(0,"info: Archive::Zip and Archive::Extract are available") if $CanZIPCheck;
  691. mlog(0,"info: Archive::Rar::Passthrough and rar executable are available") if $CanRARCheck;
  692. mlog(0,"info: Archive::Rar::Passthrough and 7z executable are available") if $Can7zCheck;
  693. mlog(0,"info: Archive::Libarchive::XS is available") if $CanLACheck;
  694.  
  695. }
  696. mlog($fh,"warning: SMIME processing is disabled because the following Perl module is missing: Crypt::SMIME") unless $CanSMIME;
  697. mlog($fh,"warning: SMIME configuration will extensively call the openssl binary because the following Perl module is missing: Net::SSLeay") if $CanSMIME && ! $CanNetSSLeay;
  698. $old_CheckAttachments = \&main::CheckAttachments;
  699. *{"main::haveToScan"} = \&haveToScan;
  700. *{"main::haveToFileScan"} = \&haveToFileScan;
  701. *{"main::CheckAttachments"} = \&CheckAttachments;
  702. return 1;
  703. }
  704. ###### END #####
  705.  
  706. # here should follow your code - this is ony an example
  707. return 1 unless $self->{DoMe};
  708. return 1 unless $this;
  709.  
  710. $this->{prepend} = '';
  711. mlog($fh,"[Plugin] calling plugin $self->{myName}") if $main::AttachmentLog;
  712.  
  713. if ($self->{score} && ! $this->{relayok} && ! $this->{whitelisted} && ! ($this->{noprocessing} & 1)) {
  714. my %size = map{split(/\=\>/o)} split(/,/o,$self->{score});
  715. foreach my $size (sort {$b <=> $a} keys %size) {
  716. if ($this->{maillength} >= $size) {
  717. $this->{prepend} = '[messageSize][score]';
  718. &main::pbAdd($fh,$this->{ip},$size{$size},'SIZE:'.$this->{maillength}."(>$size)",1) if $size{$size};
  719. last;
  720. }
  721. }
  722. }
  723.  
  724. $this->{prepend} = '';
  725. $this->{attachcomment}="no bad attachments";
  726.  
  727. $main::o_EMM_pm = 1;
  728. $this->{clamscandone}=0;
  729. $this->{filescandone}=0;
  730. $plScan = 1;
  731. if( ! &haveToScan($fh)
  732. && ! &haveToFileScan($fh)
  733. && ! $main::DoBlockExes
  734. && ! ($self->{script} && (($this->{relayok} && $self->{outsize}) || (! $this->{relayok} && $self->{insize})))
  735. && ! scalar keys(%SMIMEcfg)
  736. ){
  737. $this->{clamscandone}=1;
  738. $this->{filescandone}=1;
  739. $plScan = 0;
  740. return 1;
  741. }
  742. $this->{clamscandone}=1 if( ! &haveToScan($fh) );
  743. $this->{filescandone}=1 if( ! &haveToFileScan($fh) );
  744. $plScan = 0;
  745.  
  746. my @name;
  747. my $ext;
  748. my $modified = 0;
  749. my $email;
  750. my @parts;
  751. my $child = {};
  752. my $parent = {};
  753. my $ret;
  754. my $attlog;
  755. my $virilog = $main::SpamVirusLog;
  756. my $attTestMode = $main::allTestMode ? $main::allTestMode : $main::attachTestMode;
  757. my $viriTestMode = $main::allTestMode;
  758.  
  759. if (! $main::CanUseEMM) {
  760. mlog(0,"Warning: module Email::MIME is not installed, please disable the plugin ASSP_AFC or install the module!");
  761. return 1;
  762. }
  763.  
  764. my $block;
  765. if ($this->{noprocessing} & 1) {
  766. $block = $main::BlockNPExes;
  767. $attlog = $main::npAttachLog;
  768. mlog($fh,"info: block set to BlockNPExes ($block) - attachlog set to npAttachLog ($attlog) - noprocessing") if $main::SessionLog > 2;
  769. } elsif ($this->{whitelisted}) {
  770. $block = $main::BlockWLExes;
  771. $attlog = $main::wlAttachLog;
  772. mlog($fh,"info: block set to BlockWLExes ($block) - attachlog set to wlAttachLog ($attlog) - whitelisted") if $main::SessionLog > 2;
  773. } elsif ($this->{relayok}) {
  774. $block = $main::BlockWLExes;
  775. $attlog = $main::wlAttachLog;
  776. mlog($fh,"info: block set to BlockWLExes ($block) - attachlog set to wlAttachLog ($attlog) - relayok") if $main::SessionLog > 2;
  777. } else {
  778. $block = $main::BlockExes;
  779. $attlog = $main::extAttachLog;
  780. mlog($fh,"info: block set to BlockExes ($block) - attachlog set to extAttachLog ($attlog) - default") if $main::SessionLog > 2;
  781. }
  782.  
  783. my $privat;
  784. ($privat) = $this->{rcpt} =~ /(\S*)/o if ! $this->{relayok};
  785. my $domain = ($main::DoPrivatSpamdb > 1) ? lc $privat : '';
  786. $privat = ($main::DoPrivatSpamdb & 1) ? lc $privat : '';
  787. $domain =~ s/^[^\@]*\@/\@/o;
  788.  
  789. my $badimage = 0;
  790. $ret = eval {
  791. $Email::MIME::ContentType::STRICT_PARAMS=0; # no output about invalid CT
  792. $this->{header} =~ s/\.[\r\n]+$//o;
  793. $email = Email::MIME->new($this->{header});
  794. if ($email->{ct}{composite} =~ /signed/i) {
  795. mlog($fh,"info: digital signed email found") if $main::AttachmentLog == 2;
  796. $this->{signed} = 1;
  797. }
  798. foreach my $part ($email->parts) {
  799. $parent->{$part} = $email; # remember the parent MIME part
  800. push @{$child->{$email}} , $part; # remember the subparts of a MIME part
  801. if ($part->parts > 1 || $part->subparts) {
  802. eval{get_MIME_parts($part, sub {my $p = shift;
  803. push @parts, $p;
  804. my @sp = $p->subparts;
  805. return unless @sp;
  806. for my $sp (@sp) {
  807. $parent->{$sp} = $p;
  808. push @{$child->{$p}} , $sp;
  809. }
  810. })};
  811. push @parts,$part if $@;
  812. } else {
  813. push @parts,$part;
  814. }
  815. }
  816. foreach my $part ( @parts ) {
  817. $this->{clamscandone}=0;
  818. $this->{filescandone}=0;
  819. $this->{attachdone}=0;
  820. $self->{exetype} = undef;
  821. $self->{skipBinEXE} = undef;
  822. $self->{skipZipBinEXE} = undef;
  823. @attre = ();
  824. @attZipre = ();
  825. $plScan = 1;
  826. $ZIPLevel = $self->{MaxZIPLevel};
  827. my $foundBadImage;
  828. my $filename = &main::attrHeader($part,'Content-Type','filename')
  829. || &main::attrHeader($part,'Content-Disposition','filename')
  830. || &main::attrHeader($part,'Content-Type','name')
  831. || &main::attrHeader($part,'Content-Disposition','name');
  832. if (! $this->{signed} && $part->header("Content-Type") =~ /application\/(?:(?:pgp|(?:x-)?pkcs7)-signature|pkcs7-mime)/io) {
  833. mlog($fh,"info: digital signature file $filename found, without related Content-Type definition 'multipart/signed'") if $main::AttachmentLog >= 2;
  834. $this->{signed} = 1;
  835. }
  836. my $orgname = $filename;
  837.  
  838. my ($imghash,$imgprob);
  839. if ( $main::ASSP_AFCDetectSpamAttachRe
  840. && $main::baysProbability > 0
  841. && ! ($this->{noprocessing} & 1)
  842. && ! $this->{whitelisted}
  843. && ! $this->{relayok}
  844. && $part->header("Content-Type") =~ /($self->{DetectSpamAttach})/is
  845. && eval { mlog($fh,"info: spam attachment check ($1 - $orgname)") if $main::AttachmentLog > 1; 1; }
  846. && ($imghash = &main::AttachMD5Part($part))
  847. && ($imgprob = $main::Spamdb{ "$privat $imghash" } || $main::Spamdb{ "$domain $imghash" } || $main::Spamdb{ $imghash }) > $main::baysProbability)
  848. {
  849. $badimage++;
  850. $foundBadImage = 1;
  851. mlog($fh,"info: spam attachment ($1 - $orgname) found in MIME part - spam probability is $imgprob") if $main::AttachmentLog;
  852. }
  853.  
  854. if ($main::DoBlockExes &&
  855. $filename &&
  856. isAttachment($part) &&
  857. ($self->{select} == 1 or $self->{select} == 3)) {
  858.  
  859. my $attname = $filename;
  860. mlog($fh,"info: attachment $attname found for Level-$block") if ($main::AttachmentLog >= 2);
  861. Encode::_utf8_on($attname);
  862. push(@name,$attname);
  863.  
  864. $userbased = 0;
  865.  
  866. $self->{attRun} = sub { return
  867. ($block >= 1 && $block <= 3 && $_[0] =~ $main::badattachRE[$block] ) ||
  868. ( $main::GoodAttach && $block == 4 && $_[0] !~ $main::goodattachRE );
  869. };
  870. $self->{attZipRun} = sub { return 0; };
  871. if ($self->{detectBinEXE} = $self->{attRun}->('.exe-bin')) {
  872. setSkipExe($self,'attRun','skipBinEXE');
  873. }
  874.  
  875. if (scalar keys %main::AttachRules) {
  876. my $rcpt = [split(/ /o,$this->{rcpt})]->[0];
  877. my $dir = ($this->{relayok}) ? 'out' : 'in';
  878. my $addr;
  879. $addr = &main::matchHashKey('main::AttachRules', &main::batv_remove_tag('',$this->{mailfrom},''), 1);
  880. $attre[0] = $main::AttachRules{$addr}->{'good'} . '|' . $main::AttachRules{$addr}->{'good-'.$dir} . '|' if $addr;
  881. $attre[1] = $main::AttachRules{$addr}->{'block'} . '|' . $main::AttachRules{$addr}->{'block-'.$dir} . '|' if $addr;
  882. $addr = &main::matchHashKey('main::AttachRules', &main::batv_remove_tag('',$rcpt,''), 1);
  883. $attre[0] .= $main::AttachRules{$addr}->{'good'} . '|' . $main::AttachRules{$addr}->{'good-'.$dir} . '|' if $addr;
  884. $attre[1] .= $main::AttachRules{$addr}->{'block'} . '|' . $main::AttachRules{$addr}->{'block-'.$dir} . '|' if $addr;
  885.  
  886. $attre[0] =~ s/\|\|+/\|/go;
  887. $attre[1] =~ s/\|\|+/\|/go;
  888.  
  889. $attre[0] =~ s/^\|//o;
  890. $attre[1] =~ s/^\|//o;
  891.  
  892. $attre[0] =~ s/\|$//o;
  893. $attre[1] =~ s/\|$//o;
  894.  
  895. if ($attre[0] || $attre[1]) {
  896. $attre[0] = qq[\\.(?:$attre[0])\$] if $attre[0];
  897. $attre[1] = qq[\\.(?:$attre[1])\$] if $attre[1];
  898. $self->{attRun} = sub { return
  899. ($attre[1] && $_[0] =~ /$attre[1]/i ) ||
  900. ($attre[0] && $_[0] !~ /$attre[0]/i );
  901. };
  902. mlog($fh,"info: using user based attachment check") if $main::AttachmentLog;
  903. $userbased = 1;
  904. $self->{skipBinEXE} = undef;
  905. if ($self->{detectBinEXE} = $self->{attRun}->('.exe-bin')) {
  906. setSkipExe($self,'attRun','skipBinEXE');
  907. }
  908. }
  909. }
  910.  
  911. $self->{exetype} = '';
  912. delete $self->{typemismatch};
  913. delete $self->{fileList};
  914. delete $self->{isEncrypt};
  915. my $blockEncryptedZIP = $self->{blockEncryptedZIP}; # remember the config setting
  916. $self->{skipBin} = $self->{skipBinEXE};
  917.  
  918. if ( ( $self->{exetype} = isAnEXE($self, \$part->body)) || $self->{attRun}->($attname)
  919. || ! isZipOK($self, $this, \$part->body, $attname)
  920. )
  921. {
  922. $orgname =~ /(\.[^\.]*)$/o;
  923. $ext = $1;
  924. $self->{blockEncryptedZIP} = $blockEncryptedZIP; # reset to config value
  925. $self->{exetype} = $self->{typemismatch}->{text} if $self->{typemismatch};
  926. my $exetype;
  927. if ($self->{exetype}) {
  928. $exetype = $self->{exetype};
  929. $self->{exetype} = " cause: '$self->{exetype}'";
  930. }
  931. $this->{prepend} = "[Attachment]";
  932.  
  933. my $tlit="SPAM FOUND";
  934. $tlit = "[monitoring]" if ($main::DoBlockExes == 2);
  935. $tlit = "[scoring]" if ($main::DoBlockExes == 3);
  936.  
  937. $main::Stats{viri}++ if ($main::DoBlockExes == 1);
  938. &main::delayWhiteExpire($fh) if ($main::DoBlockExes == 1 && ! $userbased);
  939.  
  940. $this->{messagereason} = "bad attachment '$attname'$self->{exetype}";
  941. $this->{attachcomment} = $this->{messagereason};
  942. mlog( $fh, "$tlit $this->{messagereason}" ) if ($main::AttachmentLog);
  943. next if ($main::DoBlockExes == 2);
  944.  
  945. &main::pbAdd( $fh, $this->{ip}, (defined($main::baValencePB[0]) ? 'baValencePB' : $main::baValencePB), 'BadAttachment' ) if ($main::DoBlockExes != 2 && ! $userbased);
  946. next if ($main::DoBlockExes == 3);
  947.  
  948. if ($self->{ra}) {
  949. $modified = 1 unless $modified == 2;
  950. my $text = $self->{ratext};
  951. $text =~ s/FILENAME/$orgname/go;
  952. $text =~ s/REASON/$exetype/go;
  953. eval{
  954. $text = Encode::encode('UTF-8',$text);
  955. $text = $main::UTF8BOM . $text;
  956. };
  957. $orgname =~ s/$ext$/\.txt/;
  958. $attname =~ s/$ext$/\.txt/;
  959. $orgname = &main::encodeMimeWord(Encode::encode('UTF-8', $orgname),'Q','UTF-8');
  960. eval {
  961.  
  962. $part->body_set('');
  963. $part->content_type_set('text/plain');
  964. $part->disposition_set('attachment');
  965. $part->filename_set($orgname);
  966. $part->name_set($orgname);
  967. $part->encoding_set('quoted-printable');
  968. $part->charset_set('UTF-8');
  969. $part->body_set($text);
  970.  
  971. };
  972. if ($@) {
  973. mlog(0,"error: unable to change MIME attachment to - $text - $@");
  974. $part->body_set('The original attached file was removed from this email by ASSP for policy reasons!');
  975. eval{
  976. $part->filename_set( undef );
  977. $part->name_set( undef );
  978. };
  979. }
  980. mlog( $fh, "$tlit replaced $this->{messagereason} with '$attname'" ) if ($main::AttachmentLog);
  981. $badimage-- if $foundBadImage;
  982. next;
  983. } else {
  984. my $reply = $main::AttachmentError;
  985. $attname = &main::encodeMimeWord($attname,'Q','UTF-8') unless &main::is_7bit_clean($attname);
  986. # $attname =~ s/$main::NONPRINT//go;
  987. $reply =~ s/FILENAME/$attname/g;
  988. my $reason = $self->{exetype};
  989. $reason = &main::encodeMimeWord($reason,'Q','UTF-8') unless &main::is_7bit_clean($reason);
  990. $reply =~ s/REASON/$reason/g;
  991. $self->{errstr} = $reply;
  992. $self->{result} = "BadAttachment";
  993. $plScan = 0;
  994. $self->{logto} = $main::plLogTo = $attlog;
  995. $main::pltest = $attTestMode;
  996. correctHeader($this);
  997. return 0;
  998. }
  999. }
  1000. $self->{blockEncryptedZIP} = $blockEncryptedZIP; # reset to config value
  1001. next if ($self->{select} == 1);
  1002. next if (&main::ClamScanOK($fh,\$part->body) && &main::FileScanOK($fh,\$part->body));
  1003. if ($self->{rv}) {
  1004. $modified = 2;
  1005. my $text = $self->{rvtext};
  1006. $text =~ s/FILENAME/$orgname/g;
  1007. $text =~ s/VIRUS/$this->{averror}/g;
  1008. eval{
  1009. $text = Encode::encode('UTF-8',$text);
  1010. $text = $main::UTF8BOM . $text;
  1011. };
  1012. my $oldname = $attname;
  1013. $orgname =~ s/$ext$/\.txt/;
  1014. $attname =~ s/$ext$/\.txt/;
  1015. $orgname = &main::encodeMimeWord(Encode::encode('UTF-8', $orgname),'Q','UTF-8');
  1016. eval {
  1017.  
  1018. $part->body_set('');
  1019. $part->content_type_set('text/plain');
  1020. $part->disposition_set('attachment');
  1021. $part->filename_set($orgname);
  1022. $part->name_set($orgname);
  1023. $part->encoding_set('quoted-printable');
  1024. $part->charset_set('UTF-8');
  1025. $part->body_set($text);
  1026.  
  1027. };
  1028. if ($@) {
  1029. mlog(0,"error: unable to change MIME attachment to - $text - $@");
  1030. $part->body_set('There was an attached virus removed from this email by ASSP!');
  1031. eval{
  1032. $part->filename_set( undef );
  1033. $part->name_set( undef );
  1034. };
  1035. }
  1036. mlog( $fh, "$this->{averror} - replaced attachment '$oldname' with '$attname'" ) if ($main::AttachmentLog);
  1037. $badimage-- if $foundBadImage;
  1038. next;
  1039. }
  1040. $this->{clamscandone}=1;
  1041. $this->{filescandone}=1;
  1042. $self->{errstr} = $this->{averror};
  1043. $self->{result} = "VIRUS-found";
  1044. $plScan = 0;
  1045. $self->{logto} = $main::plLogTo = $virilog;
  1046. $main::pltest = $viriTestMode;
  1047. correctHeader($this);
  1048. return 0;
  1049. }
  1050. next if ($self->{select} == 1);
  1051. next if (&main::ClamScanOK($fh,\$part->body) && &main::FileScanOK($fh,\$part->body));
  1052. if ($self->{rv}) {
  1053. $modified = 2;
  1054. my $text = $self->{rvtext};
  1055. $text =~ s/FILENAME/MIME-TEXT.eml/g;
  1056. eval{$part->body_set( $text );1;} or eval{$part->body_set( $self->{rvtext} );1;} or eval{$part->body_set( 'virus removed' );1;} or eval{$part->body_set( undef );1;};
  1057. mlog( $fh,"$this->{averror} - replaced virus-mail-part with simple text");
  1058. $badimage-- if $foundBadImage;
  1059. next;
  1060. }
  1061. $this->{clamscandone}=1;
  1062. $this->{filescandone}=1;
  1063. $self->{errstr} = $this->{averror};
  1064. $self->{result} = "VIRUS-found";
  1065. $plScan = 0;
  1066. $self->{logto} = $main::plLogTo = $virilog;
  1067. $main::pltest = $viriTestMode;
  1068. correctHeader($this);
  1069. return 0;
  1070. }
  1071. correctHeader($this);
  1072. return 1;
  1073. };
  1074. if ($@) {
  1075. $this->{clamscandone}=1;
  1076. $this->{filescandone}=1;
  1077. $this->{attachdone}=1;
  1078. mlog($fh,"error: unable to parse message for attachments - $@") unless $main::IgnoreMIMEErrors;
  1079. correctHeader($this);
  1080. return 1;
  1081. }
  1082. unless ($ret) {
  1083. $self->{logto} = $main::plLogTo = $self->{result} eq "VIRUS-found" ? $virilog : $attlog;
  1084. correctHeader($this);
  1085. return 0;
  1086. }
  1087. if ($badimage > 0) {
  1088. $this->{logalldone} = &main::MaillogRemove($this) if ($this->{maillogfilename});
  1089. my $fn = $this->{maillogfilename};
  1090. $fn = &main::Maillog($fh,'',$attlog) unless ($fn); # tell maillog what this is.
  1091. delete $this->{logalldone};
  1092. $fn=' -> '.$fn if $fn ne '';
  1093. $fn='' if ! $main::fileLogging;
  1094.  
  1095. my $logsub =
  1096. ( $main::subjectLogging ? " $main::subjectStart$this->{originalsubject}$main::subjectEnd" : '' );
  1097. mlog( $fh, "file path changed to $fn", 0, 2 ) if $fn;
  1098. my $reason = 'spam attachment found';
  1099. $this->{sayMessageOK} = 'already';
  1100. $self->{errstr} = $reason;
  1101. $self->{result} = 'SPAM-attachment';
  1102. correctHeader($this);
  1103. return 0;
  1104. }
  1105. $this->{clamscandone}=1;
  1106. $this->{filescandone}=1;
  1107. $this->{attachdone}=1;
  1108. my $numatt = @name;
  1109. my $s = 's' if ($numatt >1);
  1110. mlog($fh,"info: $numatt attachment$s found for Level-$block") if ($main::DoBlockExes && $main::AttachmentLog == 1 && $numatt);
  1111. $plScan = 0;
  1112. if ($this->{noprocessing} & 1) {
  1113. mlog( $fh, "message proxied without processing ($this->{attachcomment})", 0, 2 );
  1114. } elsif ($this->{whitelisted}) {
  1115. mlog( $fh, "whitelisted ($this->{attachcomment})", 0, 2 ) if !$this->{relayok};
  1116. } else {
  1117. mlog( $fh, "local ($this->{attachcomment})", 0, 2 ) if $this->{relayok};
  1118. }
  1119. if ($modified) {
  1120. my %parentdone;
  1121. for my $part (reverse @parts) { # process subparts first up to email
  1122. next unless exists $parent->{$part}; # is not a subpart, it has no parent - only to be safe
  1123. next if $parentdone{$parent->{$part}};
  1124. $parent->{$part}->parts_set($child->{$parent->{$part}}); # set all parts of the parent
  1125. $parentdone{$parent->{$part}} = 1; # don't do a parent twice
  1126. }
  1127.  
  1128. $this->{logalldone} = &main::MaillogRemove($this) if ($this->{maillogfilename});
  1129. my $fn = &main::Maillog($fh,'', ($modified == 2) ? $virilog : $attlog); # tell maillog what this is.
  1130. delete $this->{logalldone};
  1131. $fn=' -> '.$fn if $fn ne '';
  1132. $fn='' if ! $main::fileLogging;
  1133.  
  1134. my $logsub =
  1135. ( $main::subjectLogging ? " $main::subjectStart$this->{originalsubject}$main::subjectEnd" : '' );
  1136. mlog( $fh, "file path changed to $fn", 0, 2 ) if $fn;
  1137. my $reason = ($modified == 2) ? $this->{averror} : $this->{attachcomment};
  1138. mlog( $fh, "[spam found] $reason $logsub$fn", 0, 2 );
  1139. $this->{sayMessageOK} = 'already';
  1140.  
  1141. $this->{header} = $email->as_string;
  1142. correctHeader($this);
  1143. mlog($fh,"info: sending modified message") if ($main::AttachmentLog == 2);
  1144. }
  1145. if ($self->{script} && (($this->{relayok} && $self->{outsize}) || (! $this->{relayok} && $self->{insize}))) {
  1146. my $changed;
  1147. foreach my $part (@parts) {
  1148. if ( $part->header("Content-Disposition")=~ /attachment/io
  1149. && (my $len = length($part->body)) > ($this->{relayok} ? $self->{outsize} : $self->{insize})
  1150. && (my $filename = $part->filename || $part->name) )
  1151. {
  1152. my $file; my $text;
  1153. if (($file = store_f($filename,$this,$part)) && ($text = call_s($self,$file,$this))) {
  1154. if ($text =~ /^\s*error/io) {
  1155. mlog(0,"error: WebScript returned: $text");
  1156. next;
  1157. }
  1158. $part->body_set( $text );
  1159. my $ct_subtype = ($text =~ /\<HTML\>/io) ? 'html' : 'plain';
  1160. $part->content_type_set( "text/$ct_subtype" );
  1161. $part->name_set( undef );
  1162. $part->filename_set( undef );
  1163. $part->disposition_set( undef );
  1164. $part->charset_set('UTF-8');
  1165. $part->encoding_set( (&main::is_7bit_clean(\$text)) ? '7bit' : 'quoted-printable');
  1166. $changed = 1;
  1167. mlog($fh,"attachment $filename with size of ".&main::formatNumDataSize($len).' was stored outside for download and replaced by script result.') if ($main::AttachmentLog);
  1168. }
  1169. }
  1170. }
  1171. if ($changed) {
  1172. $email->parts_set( \@parts );
  1173. $this->{header} = $email->as_string;
  1174. correctHeader($this);
  1175. }
  1176. }
  1177. my $smime;
  1178. my $References;
  1179. my $rcpt = (split(/ /o,$this->{rcpt}))->[0];
  1180. if ( ! $this->{signed}
  1181. && $CanSMIME
  1182. && $this->{relayok}
  1183. && scalar(keys(%SMIMEcfg))
  1184. && &main::is_7bit_clean(\$this->{header})
  1185. && ($smime = &main::matchHashKey(\%SMIMEcfg,$this->{mailfrom},'0 1 1'))
  1186. && ! &main::matchHashKey(\%skipSMIME,$this->{mailfrom},'0 1 1')
  1187. && checkrcpt($smime, $this)
  1188. ) {
  1189. my $out = eval{$main::L->($main::T[100])->{call}->{'100'}->($smime,$email,$this);};
  1190. if (ref($out)) {
  1191. $email = Email::MIME->new($$out);
  1192. # replace the from: address
  1193. my $from = my $newfrom = $email->header('from');
  1194. $newfrom =~ s/$main::EmailAdrRe\@$main::EmailDomainRe/$smime->{emailaddress}/;
  1195. $email->header_str_set( 'From' => $newfrom );
  1196. # set the Reply-To MIME header tag
  1197. $email->header_str_set( 'Reply-To' => $from ) unless $email->header('Reply-To');
  1198. if (lc $from ne lc $newfrom) {
  1199. $References = $email->header('references');
  1200. if ($References !~ /<assp-corp-smime-\Q$from\E>/i) {
  1201. $from =~ s/^.*?($main::EmailAdrRe\@$main::EmailDomainRe).*$/$1/o;
  1202. $References .= " <assp-corp-smime-$from>";
  1203. $email->header_str_set('References' => $References);
  1204. }
  1205. }
  1206. $this->{header} = $email->as_string;
  1207. mlog(0,"info: added SMIME signature for '$newfrom'") if $main::SessionLog;
  1208. $this->{signed} = 1;
  1209. } elsif ($out eq '0') {
  1210. mlog(0,"info: possible missing SMIME license") if $main::SessionLog > 2;
  1211. } else {
  1212. mlog(0,"warning: unable to add SMIME signature - $out") if $main::SessionLog;
  1213. }
  1214. } elsif ( $CanSMIME
  1215. && ! $this->{relayok}
  1216. && scalar(keys(%SMIMEcfg))
  1217. && ($References = $email->header('references'))
  1218. && $References =~ /assp-corp-smime-($main::EmailAdrRe\@$main::EmailDomainRe)/oi
  1219. && &main::localmailaddress($fh,$1)
  1220. && $email->header('to') !~ /<\Q$rcpt\E>/i
  1221. && ! &main::matchHashKey(\%skipSMIME,$this->{mailfrom},'0 1 1') )
  1222. {
  1223. $email->header_str_set('to' => $email->header('to') . " <$rcpt>" );
  1224. $this->{header} = $email->as_string;
  1225. mlog(0,"info: mail from $this->{mailfrom} in reply to SMIME signed mail found - added recipient $rcpt") if $main::SessionLog > 1;
  1226. }
  1227. correctHeader($this);
  1228. return 1;
  1229. }
  1230.  
  1231. sub checkrcpt {
  1232. my ($smime, $this) = @_;
  1233. return 1 if ! exists $smime->{'rcpt'};
  1234. my $rcpt = (split(/ /o,$this->{rcpt}))->[0];
  1235. if (exists $smime->{'rcpt'}->{'+'} && ! &main::matchHashKey($smime->{'rcpt'}->{'+'},$rcpt,'0 1 1')) {
  1236. return 0;
  1237. }
  1238. if (exists $smime->{'rcpt'}->{'-'} && &main::matchHashKey($smime->{'rcpt'}->{'-'},$rcpt,'0 1 1')) {
  1239. return 0;
  1240. }
  1241. return 1;
  1242. }
  1243.  
  1244. sub correctHeader {
  1245. my $this = shift;
  1246. $this->{header} =~ s/\r?\n\.(?:\r?\n)+$//o;
  1247. $this->{header} .= "\r\n.\r\n";
  1248. $this->{maillength} = length($this->{header});
  1249. }
  1250.  
  1251. sub store_f {
  1252. my ($file,$this,$part) = @_;
  1253. -d $main::base.'/transfer' or (mkdir $main::base.'/transfer', 0775) or return;
  1254. $file = $main::base."/transfer/$this->{msgtime}_$file";
  1255. my $dis = $part->header("Content-Type") || '';
  1256. my $attrs = $dis =~ s/^[^;]*;//o ? Email::MIME::ContentType::_parse_attributes($dis) : {};
  1257. my $charset = $attrs->{charset} || $part->{ct}{attributes}{charset};
  1258. $charset = Encode::resolve_alias(uc($charset)) if $charset;
  1259. $main::open->(my $F, '>', $file) or return;
  1260. binmode $F;
  1261. my $body = $part->body;
  1262. $body = Encode::decode($charset,$body) if $charset;
  1263. print $F $body;
  1264. close $F;
  1265. return $file;
  1266. }
  1267.  
  1268. sub call_s {
  1269. my ($self,$ofile,$this) = @_;
  1270. my $file = ($^O eq 'MSWin32') ? "\"$ofile\"" : "'$ofile'";
  1271. my $cmd = $self->{script};
  1272. while ($self->{script} =~ /(\$(\S+))/og) {
  1273. my ($f1, $f2) = ($1, $2);
  1274. if (! exists $this->{$f2} && ! defined $$f2 && ! defined ${'main::'.$f2}) {
  1275. mlog(0,"error: AFC-WebScript - don't know what to do with $f1 - no such internal variable!");
  1276. return;
  1277. }
  1278. $f2 = $this->{$f2} || $$f2 || ${'main::'.$f2} || 0;
  1279. $cmd =~ s/\Q$f1\E/$f2/o;
  1280. }
  1281. $cmd =~ s/FILENAME/$file/go;
  1282. $cmd =~ s/\//\\/go if $^O eq "MSWin32";
  1283. $cmd = runCMD($cmd);
  1284. mlog(0,"warning: WebScript returned no result for file '$ofile'") if $cmd !~ /\S/o;
  1285. mlog(0,"warning: file '$ofile' was not removed by WebScript - it is now removed by assp") if $main::unlink->($ofile);
  1286. return $cmd;
  1287. }
  1288.  
  1289. sub runCMD {
  1290. my $cmd = shift;
  1291. my ($o,$e);
  1292. if ($main::SAVEOUT && $main::SAVEERR) {
  1293. open(STDOUT, '>', \$o);
  1294. open(STDERR, '>', \$e);
  1295. }
  1296. my $out = qx($cmd);
  1297. if ($main::SAVEOUT && $main::SAVEERR) {
  1298. close STDOUT;
  1299. close STDERR;
  1300. }
  1301. return $out;
  1302. }
  1303.  
  1304. sub mlog { # sub to main::mlog
  1305. my ( $fh, $comment, $noprepend, $noipinfo ) = @_;
  1306. &main::mlog( $fh, "$comment", $noprepend, $noipinfo );
  1307. }
  1308.  
  1309. sub d { # sub to main::d
  1310. my $debugprint = shift;
  1311. &main::d("$debugprint");
  1312. }
  1313.  
  1314. sub tocheck {
  1315. my $self = shift;
  1316. return $self->{tocheck};
  1317. }
  1318.  
  1319. sub result {
  1320. my $self = shift;
  1321. return $self->{result};
  1322. }
  1323.  
  1324. sub errstr {
  1325. my $self = shift;
  1326. return $self->{errstr};
  1327. }
  1328.  
  1329. sub howToDo {
  1330. my $self = shift;
  1331. return $self->{DoMe};
  1332. }
  1333.  
  1334. sub close {
  1335. my $self = shift;
  1336.  
  1337. # close your file/net handles here
  1338. $main::o_EMM_pm = 0;
  1339. return 1;
  1340. }
  1341.  
  1342. sub haveToScan {
  1343. my $fh = shift;
  1344. my $this=$main::Con{$fh};
  1345.  
  1346. my $skipASSPscan = $main::DoASSP_AFC == 1 && ($main::ASSP_AFCSelect == 2 or $main::ASSP_AFCSelect == 3);
  1347.  
  1348. my $UseAvClamd = $main::UseAvClamd; # copy the global to local - using local from this point
  1349. $UseAvClamd = $this->{overwritedo} if ($this->{overwritedo}); # overwrite requ by Plugin
  1350.  
  1351. return 0 if ($skipASSPscan && ! $this->{overwritedo} && ! $plScan); # was not called from a Plugin
  1352.  
  1353. return 0 if ($this->{noscan} || $main::noScan && main::matchSL($this->{mailfrom},'noScan') );
  1354. return 0 if $this->{clamscandone}==1;
  1355. return 0 if !$UseAvClamd;
  1356. return 0 if !$main::CanUseAvClamd;
  1357. return 0 if $this->{whitelisted} && $main::ScanWL!=1;
  1358. return 0 if ($this->{noprocessing} & 1) && $main::ScanNP!=1;
  1359. return 0 if $this->{relayok} && $main::ScanLocal!=1;
  1360.  
  1361. return 0 if $main::noScanIP && &main::matchIP($this->{ip},'noScanIP',$fh);
  1362. return 0 if $main::NoScanRe && $this->{ip}=~('('.$main::NoScanReRE.')');
  1363. return 0 if $main::NoScanRe && $this->{helo}=~('('.$main::NoScanReRE.')');
  1364. return 0 if $main::NoScanRe && $this->{mailfrom}=~('('.$main::NoScanReRE.')');
  1365.  
  1366. $this->{prepend}="";
  1367.  
  1368. return 1;
  1369. }
  1370.  
  1371. sub haveToFileScan {
  1372. my $fh = shift;
  1373. my $this=$main::Con{$fh};
  1374.  
  1375. my $skipASSPscan = $main::DoASSP_AFC == 1 && ($main::ASSP_AFCSelect == 2 or $main::ASSP_AFCSelect == 3);
  1376.  
  1377. my $DoFileScan = $main::DoFileScan; # copy the global to local - using local from this point
  1378. $DoFileScan = $this->{overwritedo} if ($this->{overwritedo}); # overwrite requ by Plugin
  1379.  
  1380. return 0 if ($skipASSPscan && ! $this->{overwritedo} && ! $plScan); # was not called from a Plugin
  1381.  
  1382. return 0 if ($this->{noscan} || $main::noScan && main::matchSL($this->{mailfrom},'noScan') );
  1383. return 0 if $this->{filescandone}==1;
  1384. return 0 if $this->{whitelisted} && $main::ScanWL!=1;
  1385. return 0 if ($this->{noprocessing} & 1) && $main::ScanNP!=1;
  1386. return 0 if $this->{relayok} && $main::ScanLocal!=1;
  1387. return 0 if ! $DoFileScan;
  1388.  
  1389. return 0 if $main::noScanIP && &main::matchIP($this->{ip},'noScanIP',$fh);
  1390. return 0 if $main::NoScanRe && $this->{ip}=~('('.$main::NoScanReRE.')');
  1391. return 0 if $main::NoScanRe && $this->{helo}=~('('.$main::NoScanReRE.')');
  1392. return 0 if $main::NoScanRe && $this->{mailfrom}=~('('.$main::NoScanReRE.')');
  1393.  
  1394. $this->{prepend}="";
  1395.  
  1396. return 1;
  1397. }
  1398.  
  1399. sub CheckAttachments {
  1400. my ( $fh, $block, $b, $attachlog, $done ) = @_;
  1401. return 1 if ($main::DoASSP_AFC == 1 && ($main::ASSP_AFCSelect == 1 or $main::ASSP_AFCSelect == 3));
  1402. return $old_CheckAttachments->( $fh, $block, $b, $attachlog, $done );
  1403. }
  1404.  
  1405. sub setSkipExe {
  1406. my ($self,$what,$where) = @_;
  1407.  
  1408. for my $re (qw(WIN MOS PEF ELF WSH MMC ARC CSC MSOM)) {
  1409. $self->{$where} .= ":$re" if $self->{$what}->('.:'.$re);
  1410. }
  1411. }
  1412.  
  1413. sub Get16u {
  1414. $_[1] and return unpack("x$_[1] v", ${$_[0]});
  1415. return unpack("v", ${$_[0]});
  1416. }
  1417.  
  1418. # Extract information from an EXE file
  1419. # Inputs: scalar reference to the string or a filename
  1420. # Returns: EXE type on success, undef if this wasn't a valid EXE file
  1421. sub isAnEXE {
  1422. my ($self, $raf) = @_;
  1423. my ($size, $buff, $type, $count, $sk);
  1424.  
  1425. $self->{detectBinEXE} or return;
  1426. if (! ref($raf)) {
  1427. my $ZH;
  1428. if (! (-e $raf || $main::eF->($raf) || $main::eF->(&main::d8($raf))) || ! (open($ZH , '<' , $raf) || $main::open->($ZH , '<' , $raf) || $main::open->($ZH , '<' , &main::d8($raf)))) {
  1429. mlog(0,"warning: possibly a virus infected file (can't read) '$raf' - $!");
  1430. return 'possibly a virus infected file (can\'t read)';
  1431. }
  1432. binmode $ZH;
  1433. $raf = \join('',<$ZH>);
  1434. eval{$ZH->close;};
  1435. }
  1436. $buff = substr($$raf,0,0x40);
  1437. $buff =~ s/^$main::UTFBOMRE//o;
  1438. ($size = length($buff)) or return;
  1439. $sk = $self->{skipBin};
  1440.  
  1441. #
  1442. # custom executable detection in sub AFC_EXE_DETECT of lib/CorrectASSPcfg.pm
  1443. #
  1444. if (defined(&{'CorrectASSPcfg::AFC_Executable_Detection'})) {
  1445. $type = eval{&CorrectASSPcfg::AFC_Executable_Detection($self,$sk,\$buff,$raf);};
  1446. mlog(0,"error: exception in sub 'CorrectASSPcfg::AFC_EXE_DETECT' - $@");
  1447. return $type if $type;
  1448. }
  1449.  
  1450. #
  1451. # DOS and Windows EXE
  1452. #
  1453. if ($sk !~ /:WIN/oi && $buff =~ /^MZ/o && $size == 0x40) {
  1454. my ($cblp, $cp, $lfarlc, $lfanew) = unpack('x2v2x18vx34V', $buff);
  1455. my $fileSize = ($cp - ($cblp ? 1 : 0)) * 512 + $cblp;
  1456. return if $fileSize < 0x40;
  1457. # read the Windows NE, PE or LE (virtual device driver) header
  1458. if (($buff = substr($$raf, $lfanew, 0x40)) and $buff =~ /^(NE|PE|LE)/o) {
  1459. $size = length($buff);
  1460. if ($1 eq 'NE') {
  1461. if ($size >= 0x40) { # NE header is 64 bytes
  1462. # check for DLL
  1463. my $appFlags = Get16u(\$buff, 0x0c);
  1464. $type = 'Win16 ' . ($appFlags & 0x80 ? 'DLL' : 'EXE');
  1465. }
  1466. } elsif ($1 eq 'PE') {
  1467. if ($size >= 24) { # PE header is 24 bytes (plus optional header)
  1468. my $machine = Get16u(\$buff, 4) || '';
  1469. my $winType = ($machine eq 0x0200 || $machine eq 0x8664) ? 'Win64' : 'Win32';
  1470. my $flags = Get16u(\$buff, 22);
  1471. $type = $winType . ' ' . ($flags & 0x2000 ? 'DLL' : 'EXE');
  1472. }
  1473. } else {
  1474. $type = 'Virtual Device Driver';
  1475. }
  1476. } else {
  1477. $type = 'DOS EXE';
  1478. }
  1479. #
  1480. # Mach-O (Mac OS X)
  1481. #
  1482. } elsif ($sk !~ /:MOS/oi && $buff =~ /^(\xca\xfe\xba\xbe|\xfe\xed\xfa(\xce|\xcf)|(\xce|\xcf)\xfa\xed\xfe)/o && $size > 12) {
  1483. if ($1 eq "\xca\xfe\xba\xbe") {
  1484. $type = 'Mach-O fat binary executable';
  1485. } elsif ($size >= 16) {
  1486. $type = 'Mach-O executable';
  1487. my $info = {
  1488. "\xfe\xed\xfa\xce" => ' 32 bit Big endian',
  1489. "\xce\xfa\xed\xfe" => ' 32 bit Little endian',
  1490. "\xfe\xed\xfa\xcf" => ' 64 bit Big endian',
  1491. "\xcf\xfa\xed\xfe" => ' 64 bit Little endian'
  1492. };
  1493. $type .= $info->{$1};
  1494. }
  1495. #
  1496. # PEF (classic MacOS)
  1497. #
  1498. } elsif ($sk !~ /:PEF/oi && $buff =~ /^Joy!peff/o && $size > 12) {
  1499. $type = 'Classic MacOS executable';
  1500. #
  1501. # ELF (Unix)
  1502. #
  1503. } elsif ($sk !~ /:ELF/oi && $buff =~ /^\x7fELF/o && $size >= 16) {
  1504. $type = 'ELF executable';
  1505. #
  1506. # MS office macro
  1507. #
  1508. } elsif ($sk !~ /:MSOM/oi && index($$raf, "\xd0\xcf\x11\xe0") > -1 && index($$raf, "\x00\x41\x74\x74\x72\x69\x62\x75\x74\x00") > -1) {
  1509. $type = 'MS office macro';
  1510. #
  1511. # various scripts (perl, sh, java, etc...)
  1512. #
  1513. } elsif ($sk !~ /:CSC/oi && $buff =~ /^#!\s*\/\S*bin\/(\w+)/io) {
  1514. $type = "$1 script";
  1515. } elsif ($sk !~ /:CSC/oi && $buff =~ /^#!\s*[A-Z]\:[\\\/]\S+[\\\/](\w+)/io) {
  1516. $type = "$1 script";
  1517. } elsif ($sk !~ /:CSC/oi && $buff =~ /^\s*\/[*\/].*?Mode:\s*(Java);/io) {
  1518. $type = "$1 script";
  1519. } elsif ($$raf =~ /\bstring\.prototype\.|\bcharAt\b/io) { # detect possibly lucky virus script
  1520. $type = "Java script - possibly locky (ransomware) virus";
  1521. } elsif ($sk !~ /:WSH/oi && $$raf =~ /W(?:shShell|script)\.|IWsh(?:Shell|Environment|Network)_Class/ios) {
  1522. $type = "Windows-Scripting-Host script";
  1523. } elsif ( $sk !~ /:CSC/oi && ($count = () = $$raf =~
  1524. /^\s*(
  1525. (?:(?:var|our|my)\s+)?[$%@]?[a-zA-Z0-9.\-_]+\s*=.+ |
  1526. (?:public|privat)\s+(?:class|static)\s+ |
  1527. import\s+java\.[a-zA-Z0-9.\-_]+ |
  1528. (?:function|dim|const|option|sub
  1529. |end\s+sub|select\s+case|end\s+select)
  1530. \s+[()a-zA-Z0-9.\-_]+
  1531. )
  1532. /xiog
  1533. ) && $count > 9)
  1534. {
  1535. $type = "not defined script language";
  1536. #
  1537. # .a libraries
  1538. #
  1539. } elsif ($sk !~ /:ARC/oi && $buff =~ /^!<arch>\x0a/) {
  1540. $type = 'Static library',
  1541. #
  1542. # Windows MMC
  1543. #
  1544. } elsif ($sk !~ /:MMC/oi && $buff =~ /^\s*<\?xml version.+?<MMC_ConsoleFile/io) {
  1545. $type = 'Windows MMC Console File',
  1546. }
  1547. return $type;
  1548. }
  1549.  
  1550. # compressed file processing and encryption detection
  1551. sub isZipOK {
  1552. my ($self, $this, $content, $file) = @_;
  1553.  
  1554. return 1 unless $CanZIPCheck;
  1555. $self->{attname} = $file;
  1556. $self->{tmpdir} = "$main::base/tmp/zip_".$main::WorkerNumber.'_'.time;
  1557. $self->{fileList} = {};
  1558. @{$self->{isEncrypt}} = ();
  1559. $self->{skipZipBinEXE} = undef;
  1560.  
  1561. if (scalar keys %main::AttachZipRules) {
  1562. my $rcpt = [split(/ /o,$this->{rcpt})]->[0];
  1563. my $dir = ($this->{relayok}) ? 'out' : 'in';
  1564. my $addr;
  1565. $addr = &main::matchHashKey('main::AttachZipRules', &main::batv_remove_tag('',$this->{mailfrom},''), 1);
  1566. $attZipre[0] = $main::AttachZipRules{$addr}->{'good'} . '|' . $main::AttachZipRules{$addr}->{'good-'.$dir} . '|' if $addr;
  1567. $attZipre[1] = $main::AttachZipRules{$addr}->{'block'} . '|' . $main::AttachZipRules{$addr}->{'block-'.$dir} . '|' if $addr;
  1568. $addr = &main::matchHashKey('main::AttachZipRules', &main::batv_remove_tag('',$rcpt,''), 1);
  1569. $attZipre[0] .= $main::AttachZipRules{$addr}->{'good'} . '|' . $main::AttachZipRules{$addr}->{'good-'.$dir} . '|' if $addr;
  1570. $attZipre[1] .= $main::AttachZipRules{$addr}->{'block'} . '|' . $main::AttachZipRules{$addr}->{'block-'.$dir} . '|' if $addr;
  1571.  
  1572. $attZipre[0] =~ s/\|\|+/\|/go;
  1573. $attZipre[1] =~ s/\|\|+/\|/go;
  1574.  
  1575. $attZipre[0] =~ s/^\|//o;
  1576. $attZipre[1] =~ s/^\|//o;
  1577.  
  1578. $attZipre[0] =~ s/\|$//o;
  1579. $attZipre[1] =~ s/\|$//o;
  1580.  
  1581. if ($attZipre[0] || $attZipre[1]) {
  1582. $attZipre[0] = qq[\\.(?:$attZipre[0])\$] if $attZipre[0];
  1583. $attZipre[1] = qq[\\.(?:$attZipre[1])\$] if $attZipre[1];
  1584. $self->{attZipRun} = sub { return
  1585. ($attZipre[1] && $_[0] =~ /$attZipre[1]/i ) ||
  1586. ($attZipre[0] && $_[0] !~ /$attZipre[0]/i );
  1587. };
  1588. mlog($this->{self},"info: using user based compressed attachment check for $self->{attname}") if $main::AttachmentLog;
  1589. $userbased = 1;
  1590. $self->{blockEncryptedZIP} = 1 if (! $self->{blockEncryptedZIP} && $attZipre[1] && '.crypt-zip' =~ /$attZipre[1]/i);
  1591. $self->{blockEncryptedZIP} = 0 if ( $self->{blockEncryptedZIP} && $attZipre[0] && '.crypt-zip' =~ /$attZipre[0]/i);
  1592. setSkipExe($self,'attZipRun','skipZipBinEXE');
  1593. } elsif (! $self->{blockEncryptedZIP}) {
  1594. return 1;
  1595. }
  1596. } elsif (! $self->{blockEncryptedZIP}) {
  1597. return 1;
  1598. }
  1599.  
  1600. mkdir $self->{tmpdir}, 0777;
  1601. ! $main::dF->( $self->{tmpdir} ) && mlog(0,"unable to create temporary folder $self->{tmpdir}") && return 1;
  1602.  
  1603. mlog(0,"info: will detect encrypted compressed files") if $self->{blockEncryptedZIP} && $main::AttachmentLog > 1;
  1604. my $detectBinEXE = $self->{detectBinEXE};
  1605. $self->{detectBinEXE} = $self->{attZipRun}->('.exe-bin');
  1606. $self->{skipBin} = $self->{skipZipBinEXE};
  1607. mlog(0,"info: will detect executables in compressed files") if $self->{detectBinEXE} && $main::AttachmentLog > 1;
  1608. my @files = analyzeZIP($self,$content,$file);
  1609. $main::rmtree->($self->{tmpdir});
  1610. $self->{detectBinEXE} = $detectBinEXE;
  1611. $self->{skipBin} = $self->{skipBinEXE};
  1612. return 0 if ($self->{exetype});
  1613. if ($self->{blockEncryptedZIP} && @{$self->{isEncrypt}} ) {
  1614. $self->{exetype} = "encrypted compressed file '$file'";
  1615. $self->{exetype} .= " - content: @files" if @files && $main::AttachmentLog > 1;
  1616. return 0;
  1617. }
  1618. if (@attZipre) {
  1619. for my $f (@files) {
  1620. if ($self->{attZipRun}->($f)) {
  1621. $self->{exetype} = "compressed file '$file' - contains forbidden file $f";
  1622. return 0;
  1623. }
  1624. }
  1625. }
  1626. if ($self->{typemismatch}) {
  1627. for my $f (@{$self->{fileList}->{$self->{typemismatch}->{file}}}) {
  1628. return 0 if ($self->{attZipRun}->($f));
  1629. }
  1630. delete $self->{typemismatch};
  1631. }
  1632. return 1;
  1633. }
  1634.  
  1635. sub analyzeZIP {
  1636. my ($self,$content,$file) = @_;
  1637. $file =~ s/^.*?([^\/\\]+)$/$1/o;
  1638. $file =~ s/[^a-zA-Z0-9.]+/_/go;
  1639. $file =~ s/_+/_/go;
  1640. my ($ext) = $file =~ /(\.[^.]+)$/io;
  1641. my $tfile = $self->{tmpdir}."/$file";
  1642. $main::open->(my $F, '>', $tfile);
  1643. binmode $F;
  1644. print $F $$content;
  1645. eval{$F->close;};
  1646. if (! $main::eF->($tfile)) {
  1647. mlog(0,"error: unable to create temporary file '$tfile' - $!");
  1648. $self->{exetype} = 'possibly a virus infected file (can\'t write)';
  1649. return;
  1650. }
  1651. my @ftype = detectFileType($self, $tfile);
  1652. @ftype = () if "@ftype" =~ /^$/o;
  1653. mlog(0,"warning: unable to detect the content base file type of '$tfile'") if $main::Attachmentlog > 1 && ! scalar(@ftype);
  1654. if (scalar(@ftype) && $ext && ! grep(/\.(?:$formatsRe)$/io,@ftype) && ! grep(/\Q$ext\E$/i,@ftype) ) {
  1655. $self->{typemismatch} = {};
  1656. $self->{typemismatch}->{text} = " - the file extension: <$ext> does not match the content based detected file type <@ftype>";
  1657. $self->{typemismatch}->{file} = $tfile;
  1658. }
  1659. return get_zip_filelist($self,$tfile);
  1660. }
  1661.  
  1662. sub isAttachment {
  1663. my $part = shift;
  1664. return 0 unless ref($part);
  1665. return &main::isAttachment($part) if defined *{'main::isAttachment'};
  1666. return 1 if $part->header("Content-Disposition") =~ /attachment|inline/io;
  1667. return 1 if $part->header('Content-Type') =~ /(?:application|video|audio|image|chemical|x-conference|model|message)\//io;
  1668. return 1 if $part->header('Content-Type') =~ /text\/(?!html|plain|xml|sgml|css|csv)/io;
  1669. return 0;
  1670. }
  1671.  
  1672. sub Glob {
  1673. &main::Glob(@_);
  1674. }
  1675.  
  1676. sub getDirContent {
  1677. my $flr = shift;
  1678. $flr =~ s/\/$//o;
  1679. no warnings qw(recursion);
  1680. my @files;
  1681. for my $f (Glob($flr.'/*')) {
  1682. if (-d $f || $main::dF->($f)) {
  1683. push @files, getDirContent($f);
  1684. } else {
  1685. push @files, $f;
  1686. }
  1687. }
  1688. return @files;
  1689. }
  1690.  
  1691. sub get_zip_filelist {
  1692. my ($self,$file) = @_;
  1693. no warnings qw(recursion);
  1694.  
  1695. return if skipunzip($self,$file);
  1696.  
  1697. mlog(0,"info: analyzing compressed file $file at zip-level ".($self->{MaxZIPLevel} - $ZIPLevel)) if $main::AttachmentLog > 1;
  1698.  
  1699. if ($ZIPLevel < 1) {
  1700. mlog(0,"info: attachment '$self->{attname}' reached max zip recusion level ASSP_AFCMaxZIPLevel ($self->{MaxZIPLevel})") if $main::AttachmentLog;
  1701. return;
  1702. }
  1703. return if $self->{exetype} || (@{$self->{isEncrypt}} && $self->{blockEncryptedZIP}); # a failed content was already detected
  1704.  
  1705. my $tmpdir;
  1706. $tmpdir = $1 if $file =~ /^(.+[\/\\])[^\/\\]+$/o;
  1707. return unless $tmpdir;
  1708. $tmpdir .= ".$ZIPLevel";
  1709. my @extension = @{$self->{fileList}->{$file}} ? @{$self->{fileList}->{$file}} : ($file);
  1710. mlog(0,"info: looking for filetype in: @extension") if $main::AttachmentLog > 1;
  1711.  
  1712. my $ok = X_decompress($self,\@extension,$tmpdir,$file);
  1713. return if $ok < 0; # an error was detected
  1714.  
  1715. return if $self->{exetype} || (@{$self->{isEncrypt}} && $self->{blockEncryptedZIP}); # a failed content was already detected
  1716.  
  1717. if (! $ok) {
  1718. $self->{exetype} ||= 'possibly virus infected file (can\'t extract archive)';
  1719. return;
  1720. }
  1721. my @files = getDirContent($tmpdir); # we don't trust $ae->files because of unicode mistakes - we read the extracted folder content
  1722. return unless scalar(@files);
  1723. my $ftre = qr/\.(?:$formatsRe)$/i;
  1724. d("ZIPLevel: $ZIPLevel $file");
  1725. --$ZIPLevel;
  1726. for my $f (@files) {
  1727. next unless $f;
  1728. if ($self->{exetype} = isAnEXE($self, $f)) {
  1729. my ($fn) = $f =~ /^.+[\/\\]([^\/\\]+)$/o;
  1730. $self->{exetype} = "compressed file '$self->{attname}' - contains forbidden executable file $fn - type: $self->{exetype}";
  1731. last;
  1732. }
  1733. next if (! grep(/$ftre/,detectFileType($self, $f)));
  1734. my @f = get_zip_filelist($self,$f);
  1735. push(@files,@f) if @f;
  1736. last if @{$self->{isEncrypt}} && $self->{blockEncryptedZIP};
  1737. }
  1738. ++$ZIPLevel;
  1739. return @files;
  1740. }
  1741.  
  1742. sub skipunzip {
  1743. my ($self,$file) = @_;
  1744. return unless $main::eF->( $file );
  1745. return 1 if $file =~ /\.emz$/oi;
  1746. my $nofile = $main::base.'/Plugins/nodecompress.txt';
  1747. my $F;
  1748. local $/= "\n";
  1749. return unless ($main::open->($F,'<',$nofile));
  1750. my $nore;
  1751. while (<$F>) {
  1752. next if /^\s*#/;
  1753. s/\s//go;
  1754. $nore .= '|'.$_;
  1755. }
  1756. $nore =~ s/\|+/\|/go;
  1757. $nore =~ s/^\|//o;
  1758. $nore =~ s/\|$//o;
  1759. return unless $nore;
  1760. $nore = quotemeta($nore);
  1761. eval {$nore = qr/$nore/;};
  1762. if ($@) {
  1763. mlog(0,"error: regular expression error in file $main::base/Plugins/nodecompress.txt - $@");
  1764. return;
  1765. }
  1766. return $file =~ /\.(?:$nore)$/i;
  1767. }
  1768.  
  1769. sub detectFileType {
  1770. my ($self,$file) = @_;
  1771. my $mimetype = eval{my $ft = File::Type->new(); $ft->mime_type($file);};
  1772. $mimetype ||= eval{my $ft = File::Type->new(); $ft->mime_type(&main::d8($file));};
  1773. $mimetype = check_type($file) if !$mimetype || $mimetype eq 'application/octet-stream';
  1774. return () if !$mimetype || $mimetype eq 'application/octet-stream';
  1775. my $t = eval{MIME::Types->new()->type($mimetype);};
  1776. return () unless $t;
  1777. my @ext = map {my $t = '.'.$_;$t;} eval{$t->extensions;};
  1778. if (! @ext && $mimetype eq 'application/x-gzip') {
  1779. push(@ext,'.gz','.gzip','.emz');
  1780. } elsif ($mimetype eq 'application/x-gzip') {
  1781. push(@ext,'.emz');
  1782. }
  1783. if (! @ext && $mimetype eq 'application/encrypted') {
  1784. push(@ext,'.encrypt');
  1785. push(@{$self->{isEncrypt}},$file);
  1786. }
  1787. $self->{fileList}->{$file} = \@ext;
  1788. return @ext;
  1789. }
  1790.  
  1791. # find the things File::Type does not
  1792. sub check_type {
  1793. my $filename = shift;
  1794. my $fh;
  1795. $main::open->($fh , '<', $filename) || $main::open->($fh , '<', &main::d8($filename)) || return undef;
  1796. my $data;
  1797. binmode $fh;
  1798. $fh->read($data, 512);
  1799. $fh->close;
  1800. return undef unless $data;
  1801. return check_type_contents(\$data);
  1802. }
  1803.  
  1804. sub check_type_contents {
  1805. my $data = shift;
  1806.  
  1807. if ($$data =~ m[^Salted__]) {
  1808. return q{application/encrypted};
  1809. }
  1810. if ($$data =~ m[^7z\xBC\xAF\x27\x1C]) {
  1811. return q{application/x-7z-compressed};
  1812. }
  1813. if ($$data =~ m[^\xFFLZMA\x00]) {
  1814. return q{application/x-lzma};
  1815. }
  1816. if ($main::open->(my $F , '<' , "$main::base/Plugins/file_types.txt")) {
  1817. while (<$F>) {
  1818. s/\r|\n//go;
  1819. s/^\s*#.*$//o;
  1820. s/^\s+//o;
  1821. s/\s+$//o;
  1822. next unless $_;
  1823. my ($re, $type) = split(/\s*=>\s*/o,$_,2);
  1824. next unless ($re && $type);
  1825. return $type if eval {$$data =~ /$re/;};
  1826. }
  1827. $F->close;
  1828. }
  1829. return q{application/octet-stream};
  1830. }
  1831.  
  1832. ########################################
  1833. # decompression engine
  1834. ########################################
  1835.  
  1836. sub run_ext_cmd {
  1837. my $obj = shift;
  1838. return unless ref($obj);
  1839. my ($o,$e);
  1840. lock($main::lockOUT) if is_shared($main::lockOUT);
  1841. &main::sigoffTry(__LINE__);
  1842. if ($main::SAVEOUT && $main::SAVEERR) {
  1843. open (STDOUT, '>', \$o);
  1844. open (STDERR, '>', \$e);
  1845. }
  1846. my $ret = eval { $obj->run(@_); };
  1847. if ($main::SAVEOUT && $main::SAVEERR) {
  1848. STDOUT->close;
  1849. STDERR->close;
  1850. }
  1851. &main::sigonTry(__LINE__);
  1852. return $ret;
  1853. }
  1854.  
  1855. sub getExtMatch {
  1856. my ($re,$extension) = @_;
  1857. my $res;
  1858. for (@$extension) {
  1859. $res = $1 if /\.($re)$/i;
  1860. last if $res;
  1861. }
  1862. return $res;
  1863. }
  1864.  
  1865. sub X_decompress {
  1866. my ($self,$extension,$tmpdir,$file) = @_;
  1867. my $type;
  1868. my $ok;
  1869. my $rar = 0;
  1870. my $z7z = 0;
  1871. my $la = 0;
  1872. if ($CanLACheck && ($type = getExtMatch($LibArchRe,$extension))) {
  1873. $la = 1;
  1874. $type = "$type for libarchive";
  1875. }
  1876. if (! $type && $CanZIPCheck) {
  1877. $type =
  1878. grep(/\.(?:tar\.gz|tgz)$/io,@$extension) ? Archive::Extract::TGZ :
  1879. grep(/\.gz(?:ip)?$/io,@$extension) ? Archive::Extract::GZ :
  1880. grep(/\.tar$/io,@$extension) ? Archive::Extract::TAR :
  1881. grep(/\.(zip|jar|ear|war|par)$/io,@$extension) ? Archive::Extract::ZIP :
  1882. grep(/\.(?:tbz2?|tar\.bz2?)$/io,@$extension) ? Archive::Extract::TBZ :
  1883. grep(/\.bz2$/io,@$extension) ? Archive::Extract::BZ2 :
  1884. grep(/\.Z$/io,@$extension) ? Archive::Extract::Z :
  1885. grep(/\.lzma$/io,@$extension) ? Archive::Extract::LZMA :
  1886. grep(/\.(?:txz|tar\.xz)$/io,@$extension) ? Archive::Extract::TXZ :
  1887. grep(/\.xz$/oi,@$extension) ? Archive::Extract::XZ :
  1888. '';
  1889. }
  1890. if (! $type && $CanRARCheck && ($type = getExtMatch('rar',$extension))) {
  1891. $type = 'RAR';
  1892. $rar = 1;
  1893. }
  1894. if (! $type && $Can7zCheck && ($type = getExtMatch($z7zRe,$extension))) {
  1895. $type = "$type for 7z";
  1896. $z7z = 1;
  1897. }
  1898. mlog(0,"info: found compressed file with type: '$type'") if $main::AttachmentLog > 1 && $type;
  1899. if (! $type) {
  1900. mlog(0,"info: $file seems not to be a compressed file") if $main::AttachmentLog > 1;
  1901. return -1;
  1902. }
  1903.  
  1904. if ($CanZIPCheck && grep(/\.zip$/io,@$extension)) {
  1905. if (my $z = eval{Archive::Zip->new($file)}) {
  1906. for my $m( eval{$z->members} ) {
  1907. if (eval{$m->isEncrypted}) {
  1908. my $f = $file;
  1909. $f =~ s/^.*?([^\/\\]+)$/$1/o;
  1910. push(@{$self->{isEncrypt}},$f);
  1911. last;
  1912. }
  1913. }
  1914. }
  1915. }
  1916. return 0 if (@{$self->{isEncrypt}} && $self->{blockEncryptedZIP}); # a failed content was already detected
  1917.  
  1918. d("file: $file");
  1919. my $loop = 1;
  1920. while ($loop) {
  1921. my $ae;
  1922. $loop = undef; # normaly we will only need one loop
  1923. if ($la) {
  1924. $ae = eval{archive_read_new();};
  1925. if (! $ae) {
  1926. mlog(0,"warning: possibly virus infected file (can't open archive) '$file' - $! - $@");
  1927. $self->{exetype} = 'possibly virus infected file (can\'t open archive)';
  1928. return -1;
  1929. }
  1930. mlog(0,"info: using libarchive $LibArchVer to extract '$file'") if $main::AttachmentLog > 1;
  1931. } elsif ($rar) {
  1932. $ae = eval{Archive::Rar::Passthrough->new( rar => $CanRARCheck);};
  1933. mlog(0,"info: using rar to extract '$file'") if $main::AttachmentLog > 1 && ref($ae);
  1934. } elsif ($z7z) {
  1935. $ae = eval{Archive::Rar::Passthrough->new( rar => $Can7zCheck);};
  1936. mlog(0,"info: using 7z to extract '$file'") if $main::AttachmentLog > 1 && ref($ae);
  1937. } else {
  1938. $ae = eval{Archive::Extract->new( archive => $file , type => $type);};
  1939. mlog(0,"info: using Archive::Extract to extract '$file'") if $main::AttachmentLog > 1 && ref($ae);
  1940. }
  1941. if (! $la && ! ref($ae)) {
  1942. mlog(0,"warning: possibly virus infected file (can't open archive) '$file' - $! - $@");
  1943. $self->{exetype} = 'possibly virus infected file (can\'t open archive)';
  1944. return -1;
  1945. }
  1946. if ($la) {
  1947. $ok = eval{getarc($self,$ae,$tmpdir,$file);};
  1948. my $error = delete $self->{$ae};
  1949. if (defined $ok) {
  1950. if ($ok == ARCHIVE_OK) {
  1951. $ok = 1;
  1952. } elsif ($ok < ARCHIVE_WARN) {
  1953. mlog(0,"warning: fatal - libarchive extract '$file' - <$ok> - $error");
  1954. if ($ok == -30 && $Can7zCheck && $error =~ /Unrecognized archive format/oi) {
  1955. $ok = undef; # force a retry with 7z for this compression format
  1956. $ae = undef;
  1957. $la = undef;
  1958. $z7z = 1;
  1959. $loop = 1;
  1960. } else {
  1961. my $f = $file;
  1962. $f =~ s/^.*?([^\/\\]+)$/$1/o;
  1963. push(@{$self->{isEncrypt}},$f);
  1964. $ok = $self->{blockEncryptedZIP} ? 0 : -1;
  1965. }
  1966. } else {
  1967. mlog(0,"warning: warn - libarchive extract '$file' - <$ok> - $error");
  1968. $ok = $self->{blockEncryptedZIP} ? 0 : -1;
  1969. }
  1970. } else {
  1971. mlog(0,"warning: can't extract '$file' using libarchive - $@");
  1972. return -1;
  1973. }
  1974. } elsif ($rar) {
  1975. $ok = run_ext_cmd($ae,
  1976. 'command' => 'x',
  1977. 'archive' => $file,
  1978. 'switches' => ['-y', '-o+', '-ol' , '-p-', '--'],
  1979. 'path' => $tmpdir
  1980. );
  1981. if (defined $ok) {
  1982. $ok =~ /(\d+)$/o && ($ok = $1);
  1983. my $err = $ok;
  1984. $ok = $ok ? 0 : 1; # ->run returns zero on success or an error number
  1985. if ($err != 3 && $err != 10) { # 3 = CRC error or encryption in member - 10 in file
  1986. mlog(0,"warning: possibly virus infected file (can't extract archive in rar) '$file' - $! - ".$ae->explain_error($err)) unless $ok;
  1987. } else {
  1988. my $stderr = $ae->{stderr};
  1989. if ($stderr =~ /encrypted file [^\r\n]+?\. Corrupt file or wrong password\./oi) {
  1990. my $f = $file;
  1991. $f =~ s/^.*?([^\/\\]+)$/$1/o;
  1992. push(@{$self->{isEncrypt}},$f);
  1993. } elsif ($stderr =~ /Cannot open/io) {
  1994. mlog(0,"warning: can't open '$file' using rar - $stderr");
  1995. return -1;
  1996. }
  1997. }
  1998. } else {
  1999. mlog(0,"warning: can't extract '$file' using rar - $@");
  2000. return -1;
  2001. }
  2002. } elsif ($z7z) {
  2003. $ok = run_ext_cmd($ae,
  2004. 'command' => 'x',
  2005. 'archive' => $file,
  2006. 'switches' => ['-y', "-o$tmpdir", '-bd', '-snh', '-snl', '-p', '-aoa' , '--']
  2007. );
  2008. if (defined $ok) {
  2009. $ok =~ /(\d+)$/o && ($ok = $1);
  2010. my $err = $ok;
  2011. $ok = $ok ? 0 : 1; # ->run returns zero on success or an error number
  2012. if (! $ok) {
  2013. if ($err != 2) { # 2 = CRC error or encryption in member or file
  2014. mlog(0,"warning: possibly virus infected file (can't extract archive in 7z) '$file' - $! - ".$ae->{stderr}) unless $ok;
  2015. } else {
  2016. my $stderr = $ae->{stderr};
  2017. my @ret = $stderr =~ /ERROR: Data Error in encrypted file. Wrong password\? :\s*([^\r\n]+)/goi;
  2018. if ($stderr =~ /ERROR: Data Error in encrypted file. Wrong password\? :\s*[^\r\n]+/oi) {
  2019. my $f = $file;
  2020. $f =~ s/^.*?([^\/\\]+)$/$1/o;
  2021. push(@{$self->{isEncrypt}},$f);
  2022. $ok = $self->{blockEncryptedZIP} ? 0 : -1;
  2023. } elsif ($stderr =~ /Cannot open/io) {
  2024. mlog(0,"warning: can't open '$file' in 7z - $stderr");
  2025. return -1;
  2026. }
  2027. }
  2028. }
  2029. } else {
  2030. mlog(0,"warning: can't extract '$file' using 7z - $@");
  2031. return -1;
  2032. }
  2033. } else {
  2034. my ($o,$e);
  2035. lock($main::lockOUT) if is_shared($main::lockOUT);
  2036. &main::sigoffTry(__LINE__);
  2037. if ($main::SAVEOUT && $main::SAVEERR) { # Archive::Extract->extract may use IPC::RUN
  2038. open (STDOUT, '>', \$o);
  2039. open (STDERR, '>', \$e);
  2040. }
  2041. $ok = eval{$ae->extract( to => $tmpdir );};
  2042. $ok ||= $self->{blockEncryptedZIP} ? 0 : -1;
  2043. if ($main::SAVEOUT && $main::SAVEERR) {
  2044. STDOUT->close;
  2045. STDERR->close;
  2046. }
  2047. &main::sigonTry(__LINE__);
  2048. mlog(0,"warning: possibly virus infected file (can't extract archive) '$file' - $! - ".$ae->error) unless $ok;
  2049. mlog(0,"warning: Archive::Extract detected an error for '$file' - ".$ae->error) if $ae->error && $ok && $ae->error !~ /not chdir back to start/oi;
  2050. }
  2051. }
  2052. return $ok;
  2053. }
  2054.  
  2055. sub getarc {
  2056. my ($self,$ae,$tmpdir,$filename) = @_;
  2057. my $ok;
  2058. return $ok unless $CanLACheck;
  2059.  
  2060. my $r;
  2061.  
  2062. my $path = $tmpdir.'/';
  2063.  
  2064. my $flags = ARCHIVE_EXTRACT_TIME
  2065. # | ARCHIVE_EXTRACT_PERM
  2066. # | ARCHIVE_EXTRACT_ACL
  2067. # | ARCHIVE_EXTRACT_FFLAGS
  2068. # | ARCHIVE_EXTRACT_NO_OVERWRITE
  2069. # | ARCHIVE_EXTRACT_SECURE_NOABSOLUTEPATHS
  2070. | ARCHIVE_EXTRACT_SECURE_NODOTDOT
  2071. | ARCHIVE_EXTRACT_SECURE_SYMLINKS
  2072. ;
  2073.  
  2074. archive_read_support_filter_all($ae);
  2075. archive_read_support_format_all($ae);
  2076. my $ext = archive_write_disk_new();
  2077. archive_write_disk_set_options($ext, $flags);
  2078. archive_write_disk_set_standard_lookup($ext);
  2079.  
  2080. $r = archive_read_open_filename($ae, $filename, 10240);
  2081. if($r != ARCHIVE_OK)
  2082. {
  2083. mlog(0,"warning: possibly virus infected file (can't open archive) '$filename' - ". archive_error_string($ae));
  2084. $self->{$ae} = archive_error_string($ae);
  2085. archive_read_close($ae);
  2086. archive_read_free($ae);
  2087. archive_write_close($ext);
  2088. archive_write_free($ext);
  2089. return $r;
  2090. }
  2091.  
  2092. while(1)
  2093. {
  2094. $r = archive_read_next_header($ae, my $entry);
  2095. if($r == ARCHIVE_EOF)
  2096. {
  2097. $ok = ARCHIVE_OK;
  2098. last;
  2099. }
  2100. if($r < ARCHIVE_WARN)
  2101. {
  2102. mlog(0,"warning: possibly virus infected file (fatal error in archive header) '$filename' - <$r> - ". archive_error_string($ae));
  2103. $ok = $r;
  2104. last;
  2105. }
  2106. if($r != ARCHIVE_OK)
  2107. {
  2108. mlog(0,"warning: possibly virus infected file (can't read entry in archive header) '$filename' - <$r> - ". archive_error_string($ae));
  2109. $ok = $r;
  2110. last;
  2111. }
  2112. my $entryname = archive_entry_pathname($entry);
  2113. $entryname =~ s/[^\x20-\x7F]/0x30 + int(rand(10))/goe;
  2114. archive_entry_set_pathname($entry, $path.$entryname);
  2115. $r = archive_write_header($ext, $entry);
  2116. if($r != ARCHIVE_OK)
  2117. {
  2118. mlog(0,"warning: possibly virus infected file (can't set extraction path for entry '$entryname' to '$path$entryname' in archive) '$filename' - <$r> - ". archive_error_string($ae));
  2119. $ok = $r;
  2120. last;
  2121. }
  2122. elsif(archive_entry_size($entry) > 0)
  2123. {
  2124. $r = copy_data($ae, $ext);
  2125. if (defined($r)) {
  2126. mlog(0,"warning: possibly virus infected file (can't extract archive data in '$entryname') '$filename' - <$r> - ". archive_error_string($ae));
  2127. $ok = $r;
  2128. last;
  2129. }
  2130. }
  2131. }
  2132.  
  2133. $self->{$ae} = archive_error_string($ae);
  2134. archive_read_close($ae);
  2135. archive_read_free($ae);
  2136. archive_write_close($ext);
  2137. archive_write_free($ext);
  2138.  
  2139. return $ok;
  2140. }
  2141.  
  2142. sub copy_data {
  2143. my($ar, $aw) = @_;
  2144. my $r;
  2145. while(1)
  2146. {
  2147. $r = archive_read_data_block($ar, my $buff, my $offset);
  2148. if($r == ARCHIVE_EOF)
  2149. {
  2150. last;
  2151. }
  2152. if($r != ARCHIVE_OK)
  2153. {
  2154. return $r;
  2155. }
  2156. $r = archive_write_data_block($aw, $buff, $offset);
  2157. if($r != ARCHIVE_OK)
  2158. {
  2159. return $r;
  2160. }
  2161. }
  2162. return;
  2163. }
  2164.  
  2165. 1;
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!