razor-agents-2.85/0000755000000000000000000000000011041216000010733 5ustar razor-agents-2.85/BUGS0000644000000000000000000000410010400675050011425 0ustar =head1 NAME Bugs =head1 Description Fixed (version) - No longer an issue after this release. Identified - Bug/Issue identified, fix coming soon. New - Bug/Issue reported, not yet identified. =head1 Bug 1: Fixed 2.10 Summary: razor-check load time. Optimizatio. Net::DNS (et al) are loaded if required at runtime. takes 1.8 secs to razor-check. Need to move Net::DNS (et al) out of check/report/revoke % time razor-check -v Razor 2 Client Tools 2.08, protocol version 3 0.800u 0.150s 0:01.79 53.0% 0+0k 0+0io 473pf+0w % time bin/razor-check -v Razor Agents 2.10, protocol version 3 0.380u 0.070s 0:00.45 100.0% 0+0k 0+0io 384pf+0w =head1 Bug 2: Fixed 2.72 Summary: make: /usr/bin/razor-client: Command not found $(INSTALLBIN)/razor-client creates correct symlinks. However, INSTALLBIN gets reset in Makefile.PL so razor-client fails =head1 Bug 3: Fixed 2.09 Summary: identity perms Change default to allow identity file have any perms. =head1 Bug 4: Fixed 2.10 vr4_signature: Bad ep4: =head1 Bug 5: Fixed 2.09 got bad response from server - sent obj, resp obj: =head1 Bug 6: Fixed 2.09 problem with .razor dir for users without home dirs. =head1 Bug 7: Fixed in 2.121 perl packages should return, not exit. =head1 Bug 8: Fixed 2.12 man.5 pages not installed correctly =head1 Bug 9: Fixed SDK 2.04 Digest::SHA1 object version 2.01 does not match bootstrap parameter 2.00 at /usr/local/lib/perl5/5.7.1/sun4-solaris/DynaLoader.pm line 225. Steve Murphy , 21 Jun 2002 22:20:22 -0600 This has been identified as an issue with the SDK and certain systems already having SHA1 installed. If it reoccurs after SDK 2.04 / agents 2.70, reopen the bug. =head1 Bug 10: New have better mailing list identifier (ignorelist) =head1 Bug 11: Fixed 2.12 Whitelist bug. If your rule said 'from chad@cloudmark.com' it would match if 'chad@cloudmark.com' was anywhere in the headers, when it should only check 'from' header. =head1 Bug 12: Identified Man pages don't install correctly on some systems. man.5 pages not installed correctly razor-agents-2.85/CREDITS0000644000000000000000000000071610400675050011773 0ustar Michael Schwern Major rewrite of Makefile.PL Chad Norwood Wrote most of the new code in razor-agents 2.0 Michael McLagan Patched Makefile.PL to install man pages in Section 5 of the manual. Theo Van Dinter Wrote various bug-fix patches to razor-agents 2.x Richard Soderberg Latest maintainer fixing bugs and adding features to razor-agents 2.7x razor-agents-2.85/Changes0000644000000000000000000004401611041215755012253 0ustar # Use 'perldoc Changes' to read this file. =head1 NAME Changes - razor-agents =head2 2.85 (July 21, 2008) =over 4 =item * Relicense under Artistic License 2.0. See LICENSE for details. =back =head2 2.84 (May 10, 2007) =over 4 =item * Update discovery hostname. =back =head2 2.83 (May 8, 2007) =over 4 =item * Remove all uses of C<$'> from code. This removes a global regex engine slowdown. [issues.apache.org #5312] =back =over 4 =item * Comment out or replace shell commands with Perl equivalents. This removes the prerequisites of uname(1) and GNU mkdir(1). =back =head2 2.82 (May 26, 2006) =over 4 =item * Always disconnect from discovery server after performing discovery. This fixes a long standing bug wherein razor-report and razor-check would attempt to report to or check against the discovery servers. =back =head2 2.81 (Mar 16, 2006) =over 4 =item * Update service policy. =back =head2 2.80 (Feb 27, 2006) =over 4 =item * Untaint filenames loaded from the config file. [Bug #1395719] =back =head2 2.79 (Feb 16, 2006) =over 4 =item * Change C++ comments to C comments. [Patch #1431589] =back =head2 2.78 (Oct 01, 2005) =over 4 =item * When registering with a username and password, accept existing credentials if they authenticate successfully. =item * When autoregistering, attempt to write a test identity before attempting to register credentials. =item * Always remove the existing identity symlink before overwriting, as -e $fn can return false for a symlink that still exists. =item * Added several error checks to the register process. =item * Disconnect from the register server before returning when errors occur. =item * Ensure that checks and reports are sent to the appropriate servers. [Bug #1267559] =back =head2 2.77 (Aug 17, 2005) =over 4 =item * Fixed corrupted distribution. =back =head2 2.76 (Aug 15, 2005) =over 4 =item * When no reporter identity is found, attempt to register automatically. =item * When -home is specified on the command line, default C to the provided value. [Gentoo #101070] =back =head2 2.75 (July 6, 2005) =over 4 =item * Removed two debugging statements accidentally checked into 2.74. =item * Applied syslog patch from Debian bug #295727 to reintroduce support for 'sys-syslog' and 'syslog' log targets. [Feature #1229433] =item * Modified Makefile.PL to honor DESTDIR when installing section 5 man pages. [Bug #1227167] =item * Fixed failure for razor-agents to exit with error when unknown parameters were specified. [Bug #1229450] =item * Fixed bug for when razor-agents was invoked without ``-f'' but reading from STDIN, causing the shell to be unusable until the forked background process was killed off. [Bug #1229887] =back =head2 2.74 (June 28, 2005) =over 4 =item * Fixed handling of configuration options; under certain circumstances, neither the defaults nor the configuration file would set necessary variables such as C. =item * Fixed handling of -home option; when provided, it will be accepted without further checks. =item * Fixed installation of man(5) pages by non-root users to local man directories. [Patch #1227162] =item * Reverted a patch that was intended to add support for overriding razorhome under certain circumstances. The patch introduced new issues with external program integration (eg. Amavis). [Bug #1074391] =item * Corrected a spelling error in a debug message. =item * Added several defined checks to avoid unnecessary warnings when manipulating server lists. =item * Corrected the preprocessing fix shipped with 2.70 and updated the test suite to match. [Bug #1001417] =item * Updated preproc implementation (deHTMLxs) to match other clients. =back =head2 2.72 (June 16, 2005) =over 4 =item * C no longer creates symlinks to itself upon installation; four new scripts have been added to the distribution to replace this functionality (C, C, C, C). =back =head2 2.71 (June 15, 2005) =over 4 =item * A fix to Makefile.PL script to correctly invoke C after installation. Thanks to Liam Quinn for the patch. =back =head2 2.70 (June 10, 2005) =over 4 =item * Fixed preprocessing of unusual HTML messages. This resolves the segfault issue in razor-agents. [Bug #1001417] =item * Fixed handling of certain malformed headers. =item * Explicitly specify the record separator as C<\n> when reading files, to ensure that someone else hasn't set it to undef. [Patch #537813] =item * C is no longer supported and has been removed from the documentation. =item * Allow the config file to set razorhome. [Bug #1074391] =item * Razor Agents no longer go into an infinite loop when discovery fails. [Bug #1016039] =item * Properly creates C symlinks after installation. [Bug #874468] =item * Default to PERLPREFIX instead of PREFIX when installing man5 pages. [Bug #1001320] =item * Removed a call to $sha1->reset() which was breaking SHA1 calculation. [Bug #1004858] =item * C is no longer supported and has been removed from the documentation. [Bug #1120311] =item * Shuffle the discovery, catalogue, and nomination server lists after loading them from disk; this prevents razor-agents from always starting with the same catalogue server. =item * Replace the complex DNS lookup logic for discovery servers with a single DNS round robin. [Bug #604679] =item * Remove the ICMP ping logic for finding the "fastest" catalogue server; the configuration option for this logic is now ignored. [Support #739464] =item * Removed stale engine code for various signature types that are no longer used. =back =head2 2.67 (December 03, 2004) =over 4 =item * This is a patch release that fixes a bug in the Whiplash signature scheme. The bug was in the new code added to support canonicalization of domains. It caused the signature algorithm to generate no signatures on valid content. =back =head2 2.66 (December 02, 2004) =over 4 =item * Introduced support for country domain canonicalization in the Whiplash signature scheme. This means domains like foo.co.uk would be extracted correctly by Whiplash. This change affords a considerable improvement in accuracy. =item * Modified the revocation logic to do signature-only communications with the server. All versions of razor-agents prior to this sent the entire message on razor-revoke, and even though the backend would drop the messages after computing signatures, this entailed a privacy risk. From this version on razor-agents will _never_ send the contents of a revoked message to the backend servers. =item * Fixed a bug in C (supported engines) computation, which was broken when the C mask was larger than 8 bits. This would sometimes disable the use of engine 4 (ehash). This fix would also afford an increase in accuracy due to ehash being used everytime. =item * Fixed a bug in report by message. Version 2.61 would drop MIME headers on certain spam messages which would cause the backend to ignore these messages as malformed. =back =head1 2.61 (July 06, 2004) =over 4 =item * Introduced the Whiplash signature scheme. Whiplash signatures are based on canonical domain names present in URLs embedded in spam messages. A Whiplash signature is also a function of the length of the spam message. It's important to note that not all whiplashes are used as classifiers. The Whiplash engine is augmented by sophesticated logic on the Razor2 backend to select the Whiplashes that are used to filter spam. =item * Fixed a bug in MIME parser whereby some broken MIME mails were invisible to the system. [Bug #788723] =item * We override the C parameter in the config file because this version supports different engines but leaves the config file untouched. [Bug #984374] =item * Engine 1 support completely removed. Engine 1 was a signature scheme compatible with the old razor v1 signatures, which is no longer supported on the backend. [Bug #975490] =back =head1 2.40 (Dec 07, 2003) =over 4 =item * Applied patch from Michael (lemkemch) to make Razor Agents work on VMS. (SF patch #797003). =item * Applied another Makefile.PL patch from Michael Schwern to correctly install manpages in part 5 of the manual set in various versions of perl. =item * Applied patch from Mark Martinec and Vivek Khera of Amavid to untaint various file targets obtained from user input. This is the same patch pointed to by the SpamAssassin FAQ [http://www.spamassassin.org/released/Razor2.patch] =item * Support for HTTP 1.1 tunneling [SF patch #821324] by Jon Schewe. =item * Applied Anne Bennett's patch to Logger.pm to introduce a new log target, "syslog-sys", that talks to Syslog over a Unix socket rather than a TCP socket. =item * Applied Anne Bennett's patch to deHTML.xs to get rid of the type mismatch warning. =item * Removed computation of signatures that are no longer supported by the backend -- engines 1, 2 and 3. Digest::Nilsimsa no longer required by Razor Agents. =back =head1 2.36 (Aug 05, 2003) =over 4 =item * Removed some experimental code. =back =head1 2.35 (Aug 05, 2003) =over 4 =item * Applied a patch to Makefile.PL by Michael Schwern. This patch makes Makefile.PL compatible with new MakeMaker and behave better in general. =item * C++ style comments in deHTML code replaced with C comments so the code compiles with C compilers other than GCC. =item * Applied patch [SF patch #766292] by Suren A. Chilingaryan to detect and skip body parts that only contain MIME headers. =back =head1 2.34 (May 16, 2003) =over 4 =item * Fixed a bug where razor-check would terminate prematurely on messages for which it could not compute a signature. Thanks to Bela Lubkin for tracking this and several other bugs down! [vipul] =item * We don't do server sorting by distance anymore. Most servers are closeby, so we use the order the discovery server gives us. [vipul] =item * Introduced SOCKS support. Net::SOCKS is required in order to use SOCKS. Specify socks_server in the config file. [vipul] =item * Fixed a bug in String::split_mime(); the MIME boundry was being spuriously set in certain cases. [SF bug #707850 by Jams H Thompson]. [vipul] =item * Razor agents use getpwuid() instead of getlogin() to determine the user's home directory. [SF bug #650410 by Jochen Erwied]. [vipul] =item * A bug in the selection of zone prefixes in bootstrap discovery was fixed. [SF bug #604679 by Bill Sobel] [vipul] =item * Razorhome is gleaned from the config file passed to razor-agents, if all else fails. "razor-report -conf=/etc/razor/razor.conf spam" will use /etc/razor as its home if no other home is found (eg in $HOME/.razor). To force a particular Razorhome value, use the -home=path option. [vipul] =item * Rewrote many error messages to be descriptive and helpful. [vipul] =item * auth=ai provides client name and version. [vipul] =item * discover() will force bootstrap discovery when all discovery servers are unavailable. This fixes a bug where by razor-agents would try to connect to the old Razor2 discovery server found in servers.discovery.lst. [vipul] =item * reportit() in background mode will return faster. [vipul] =item * checkit(), reportit(), parse_mbox(), etc take an ARRAY hash as an argument when provided against the `aref' key. [vipul] =back =head1 2.22 (Nov 21 2002) =over 4 =item * Turned off verbose logging in ehash that was left on by mistake. [vipul] =item * Some user contributed additions to the FAQ. =back =head1 2.21 (Nov 19 2002) =over 4 =item * Ephemeral Hash reverts to the entire content when both sections are composed of whitespace. This makes a certain type of false positives go away. [vipul] =item * Razor2::Client::Core skips whitespace only message parts. [vipul] =item * DebugLevel 15 prints out the content after preprocessing, just before the signatures are computed. [vipul] =back =head1 2.20 (Oct 15, 2002) (First Stable Version) =over 4 =item * If log file isn't writable for whatever reason, we write logs to /dev/null. [vipul] =item * We look for stray C<\r>'s in the split_mime function. Thanks to Jim for pointing this out. [vipul] =item * Added a significantly faster XS version of deHTML code. [vipul] =item * Made ::Agent taint friendly. [vipul] =item * Added support for passing an already open filehandle to C<::Agent::checkit()> and C<::Agent::parse_mbox()> [vipul] =item * Made logic_method 4 the default. [vipul] =item * Added Razor2::Syslog to the package. [vipul] =back =head1 2.14 (July 24, 2002) =over 4 =item * General release of 2.126 [chad] =back =head1 2.126 (July 24, 2002) =over 4 =item * Improved logic again for detecting spam. [chad, vipul] =item * Run-time warnings are disabled unless in debug mode. [chad] =back =head1 2.125 (July 18, 2002) =over 4 =item * Improved logic for detecting spam, now we only look at visible and/or significant mime parts. [chad, vipul] =item * Mime parts cleaned to only whitespace are now ignored on the client side, that is, they are not checked against server [chad] =item * Fixed bug in report (err 202) [chad] =item * Quieted more warnings [chad] =back =head1 2.123 (July 17, 2002) =over 4 =item * Fixed bug in revoke/report [chad] =item * Whitelist now looks at all 'Received:' headers for matching [chad] =item * Added debuglevel, whitelist cmd-line options [chad] =item * Quieted more warnings [chad] =back =head1 2.122 (July 15, 2002) =over 4 =item * Renamed razor-register razor-admin. To register, you must 'razor-admin -register' [chad] =item * Cleanded up how we store mail parts. Each mail object now has a part object that stores info relevant to that part. [chad] =item * Fixed parse_mbox (reading mbox and rfc822 mails) [chad] =item * Backup any existing identity files before writing over them (with new identity) [chad] =item * Added lock file support, so only one process writes to servers.*.lst at a time [chad] =item * Added rediscover_wait_dns [chad] =item * Fixed a bug when we rediscover, we save info to list correctly but when using it we skip the first server [chad] =item * Fixed whitelist so rule 'from xx' only matches 'From: .*xx' not 'From .*xx' (Note the ':') [chad] =item * Made exit codes cleaner [chad] 0 or 1 => no error 2 or greater => error =item * Fixed error msg/exit code after disconnect [chad] =item * Added -w to razor binaries [chad] =item * If authen fails 'cuz unknown user (213), attempt re-register [chad] =item * Quieted a bunch of warnings [chad] =back =head1 2.12 (June 28, 2002) =over 4 =item * Man pages install correctly. [chad] =item * Updated 'razor-register -create' so it creates home, conf, and forces discovery creating all .lst files. [chad] =item * added -discover switch to force discovery [chad] =item * Everytime server bumps srl, force discovery. [chad] =item * Fixed bug in preprocessor for engine 1, might have caused false postivies. [chad] =item * Whitelist fixed. [chad] =item * Default logging is much more quiet, debuglevel changed from 5 to 3. [chad] =item * Debug mode (-d) default debuglevel changed from 5 to 9 [chad] =item * Fixed lots of logging foo. [chad] =back =head1 2.10 (June 22, 2002) =over 4 =item * Significantly improved runtime by not loading all packages until they are needed. These include: Time::HiRes Net::Ping Net::DNS. [chad] =item * Non-mbox support added, thanx to Aaron Hopkins . Now you can do: razor-check mail1 mbox mail2 ... =item * -M mbox option has been removed, Razor Agents will figure out if file is mbox or not. [chad] =item * Fixed a couple bugs relating to incorrect logs. [chad] =item * Fixed a bug relating to first-time caching of a new server. [chad] =item * Added ep4 to default server cache. [chad] =back =head1 2.09 (June 20, 2002) =over 4 =item * Added a BUGS file to distribution [chad] =item * Added an overview manpage, razor-agents(1), updated the rest. [chad] =item * Overhauled how razorhome, config files, identity files, and -create work. Support the case where there is not and never will be a razor home dir. New options: -home=razorhome (all Razor Agents) -ident=identity (report, revoke, and register) =item * Should not check/report if length of cleaned body part is 0. [chad] =item * razor-register -sys switch removed [chad] =item * Fixed various bugs relating to engine 1 and razor 1 compatibility [chad] =item * Fixed bugs relating to sending/receiving queries to/from server. [chad] =back =head1 2.08 (June 16, 2002) =over 4 =item * Removed the debug statements from Razor2::Signature::Ephemeral. [vipul] =back =head1 2.07 (June 15, 2002) =over 4 =item * Added deNewline.pm to the tarball. It was missing from 2.06. [vipul] =back =head1 2.06 (June 15, 2002) =over 4 =item * Added a deNewline preprocessor that removes trailing C<\n>s. Reflected the change in the server code as well. The reason for this is that MUAs (like mutt) strip trailing C<\n>'s so there's no way to get to the original message. This change necessitates upgrade from old 2.x agents. [vipul] =item * Fixed a bug in Config.pm to use EUID instead of UID to discover user's Razor config directory. Thanks to Theo Van Dinter for the patch. [vipul] =item * Fixed a bug in sort in Razor2::String. [vipul] =back =head1 2.05 (June 15, 2002) =over 4 =item * Fixed port bug with bootstrap_discovery (initial register fails) -chad =back =head1 2.04 (June 13, 2002) =over 4 =item * Added 'use_engines' to razor-agent.conf(5) [chad] =item * Fixed a bug in reading port from server:port. Thanks to Theo Van Dinter . [chad] =item * Client behaves properly by sending a=q when done with server. [chad] =item * Client now turns off VR2 by default. [chad] =item * Logs to stdout if -d (debuggin) cmd-line option is used. [chad] =item * Register string now Razor-Agents v2.xx. [chad] =back =head1 2.03 (June 13, 2002) =over 4 =item * Fixed a bug in deHTML that was causing razor-check to hang on certain type of content. =item * Fixed a bug in regexes in the MIME decoding function. =back razor-agents-2.85/FAQ0000644000000000000000000000730010400675050011301 0ustar Frequently Asked Questions Updated June 28, 2005 Q: Razor has blacklisted my email address. I am not a Spammer, please help! Razor DOES NOT whitelist email addresses or host names. It works by computing signatures on the body of the content and checking these signatures against a database of known spam. If you believe mail is being incorrectly blocked, most likely you have misconfigured your mail system. Q: I have an Header Analysis/Keyword Based/AI/Categorization application that detects spam. Can I automatically report spam detected by my application? In general, you should NOT do this. Only spam detected by humans should be reported to Razor. Automata, however good it is at detecting spam, isn't human, and should not be allowed to make a report or revoke decision. The only exception to this rule is troll addresses that have been seeded for the purpose of gathering spam. Q: Can I forward mail to an address instead of reporting it? No. Most mail applications modify the body content to add quotes and/or other characters. These will lead to generation of different signatures from that of the original mail. Some mail applications (like mutt) provide a "bounce" option, that can be safely used for bouncing mail to a troll address that automatically reports to Razor. Q: I have a colleague/relative/friend who uses Windows and gets a lot of Spam. How can they report/check spam using Razor? Ask them to download Cloudmark's SpamNet available from http://cloudmark.com. SpamNet is an Outlook plugin, whose functionality is equivalent to Razor2 and talks to the same network. Q: How does razor decide which submissions to trust when declaring email to be spam? Razor uses a Truth Evaluation System (TeS) to assign a trust level, or rating, to those who make reports. In general reporting spam and issuing revokes for nonspam help your rating. Conversely reporting things such as mailing lists that a large number of users will have to revoke will hurt your rating. Q: Can I find out what my TeS rating is? TeS ratings are not published yet. We might decide to publish them in future. Q: I have a firewall. What ports do I need to open in order for Razor2 to work? Outgoing TCP port 2703 (Razor2), only. Previous versions used TCP port 7 (echo), but this is no longer used. Q: I think I found a bug, or there appears to be an error in the code. What should i do? First, please log a bug on SourceForge, at: http://sourceforge.net/projects/razor Include the debug output and mail causing it (if you can) as well as a brief description (ex: its not spam, but razor thinks it is). Capture the debug output like so: razor-check -d mail > mail.debug razor-revoke -d legit > legit.debug Additionally, you can send mail to mail@vipul.net and razor-testers@lists.sourceforge.net with the same information. Also, feel free to look at the source and send in a patch with a description of what the patch solves. Patches submitted through the SourceForge patch manager are preferred. Q: I'm not root, can I install Razor Agents? Yes. You need to specify PREFIX dir during install. perl Makefile.pl PREFIX=/home/me/perl5 then, edit your .cshrc or .tcshrc setenv PATH /home/me/perl5/bin:${PATH} setenv PERL5LIB /home/me/perl5/lib setenv MANPATH /home/me/perl5/man:${MANPATH} Q: I installed Razor2, it blocks a lot of spam, but spam still gets through. What gives? Razor2 blocks anywhere between 75-90% of spam for people. It's still work in progress and will improve as new signature algorithms are introduced and more people join the network. razor-agents-2.85/INSTALL0000644000000000000000000000551010400675050012001 0ustar Vipul's Razor v2 Installation Instructions 1. Download the latest v2 razor-agents tarball from http://sourceforge.net/project/showfiles.php?group_id=3978 2. Download the latest v2 razor-agents-sdk tarball from http://sourceforge.net/project/showfiles.php?group_id=3978 Untar and run: perl Makefile.PL make make test make install If you are not root, run perl Makefile.PL with a "PREFIX=~" option, like so: perl Makefile.PL PREFIX=~ OR 2. Instead of installing the razor-agents-sdk package, you can install the following Perl modules from CPAN: Time::HiRes Digest::SHA1 MIME::Base64 Test::Simple Test::Harness Getopt::Long File::Copy URI::Escape If you do not install perl libs to standard places, set PERL5LIB. csh ex: setenv PERL5LIB /home/user/myperl/lib 3. Untar the razor-agents tarball and run: perl Makefile.PL make make test make install 4. Razor Agents are now installed. 5. Run `razor-admin -create' to create a default config file in your home directory under /home/user/.razor. (Remember to change user to your username from root before running razor-admin) 6. Razor v2 requires reporters to be registered so their reputations can be computed over time and they can participate in the revocation mechanism. Registration is done with razor-admin -register. It has to be manually invoked in either of the following ways: To register user foo with `s1kret' as password: razor-admin -register -user=foo -pass=s1kr3t To register with an email address and have the password assigned: razor-admin -register -user=foo@bar.com To have both (random) username and password assigned: razor-admin -register razor-admin -register negotiates a registration with the Nomination Server and writes the identity information in /home/user/.razor/identity-username, or /etc/razor/identity-username when invoked as root. 7. You can edit razor-agent.conf to change the defaults. Config options and their values are defined in the razor-agent.conf(5) manpage. 8. The next step is to integrate razor-check, razor-report and razor-revoke in your mail system. If you are running Razor v1, the change will be transparent, new versions of razor agents will overwrite the old ones. You would still need to plugin razor-revoke in your MUA, since it's a new addition in Razor v2. If you are not running Razor v1, refer to manpages of razor-check(1), razor-report(1), and razor-revoke(1) for integration instructions. $Id: INSTALL,v 1.16 2006/02/16 19:21:35 rsoderberg Exp $ razor-agents-2.85/LICENSE0000644000000000000000000002070411041215003011745 0ustar Artistic License 2.0 Copyright (c) 2000-2006, The Perl Foundation. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble This license establishes the terms under which a given free software Package may be copied, modified, distributed, and/or redistributed. The intent is that the Copyright Holder maintains some artistic control over the development of that Package while still keeping the Package available as open source and free software. You are always permitted to make arrangements wholly outside of this license directly with the Copyright Holder of a given Package. If the terms of this license do not permit the full use that you propose to make of the Package, you should contact the Copyright Holder and seek a different licensing arrangement. Definitions "Copyright Holder" means the individual(s) or organization(s) named in the copyright notice for the entire Package. "Contributor" means any party that has contributed code or other material to the Package, in accordance with the Copyright Holder's procedures. "You" and "your" means any person who would like to copy, distribute, or modify the Package. "Package" means the collection of files distributed by the Copyright Holder, and derivatives of that collection and/or of those files. A given Package may consist of either the Standard Version, or a Modified Version. "Distribute" means providing a copy of the Package or making it accessible to anyone else, or in the case of a company or organization, to others outside of your company or organization. "Distributor Fee" means any fee that you charge for Distributing this Package or providing support for this Package to another party. It does not mean licensing fees. "Standard Version" refers to the Package if it has not been modified, or has been modified only in ways explicitly requested by the Copyright Holder. "Modified Version" means the Package, if it has been changed, and such changes were not explicitly requested by the Copyright Holder. "Original License" means this Artistic License as Distributed with the Standard Version of the Package, in its current version or as it may be modified by The Perl Foundation in the future. "Source" form means the source code, documentation source, and configuration files for the Package. "Compiled" form means the compiled bytecode, object code, binary, or any other form resulting from mechanical transformation or translation of the Source form. Permission for Use and Modification Without Distribution (1) You are permitted to use the Standard Version and create and use Modified Versions for any purpose without restriction, provided that you do not Distribute the Modified Version. Permissions for Redistribution of the Standard Version (2) You may Distribute verbatim copies of the Source form of the Standard Version of this Package in any medium without restriction, either gratis or for a Distributor Fee, provided that you duplicate all of the original copyright notices and associated disclaimers. At your discretion, such verbatim copies may or may not include a Compiled form of the Package. (3) You may apply any bug fixes, portability changes, and other modifications made available from the Copyright Holder. The resulting Package will still be considered the Standard Version, and as such will be subject to the Original License. Distribution of Modified Versions of the Package as Source (4) You may Distribute your Modified Version as Source (either gratis or for a Distributor Fee, and with or without a Compiled form of the Modified Version) provided that you clearly document how it differs from the Standard Version, including, but not limited to, documenting any non-standard features, executables, or modules, and provided that you do at least ONE of the following: (a) make the Modified Version available to the Copyright Holder of the Standard Version, under the Original License, so that the Copyright Holder may include your modifications in the Standard Version. (b) ensure that installation of your Modified Version does not prevent the user installing or running the Standard Version. In addition, the Modified Version must bear a name that is different from the name of the Standard Version. (c) allow anyone who receives a copy of the Modified Version to make the Source form of the Modified Version available to others under (i) the Original License or (ii) a license that permits the licensee to freely copy, modify and redistribute the Modified Version using the same licensing terms that apply to the copy that the licensee received, and requires that the Source form of the Modified Version, and of any works derived from it, be made freely available in that license fees are prohibited but Distributor Fees are allowed. Distribution of Compiled Forms of the Standard Version or Modified Versions without the Source (5) You may Distribute Compiled forms of the Standard Version without the Source, provided that you include complete instructions on how to get the Source of the Standard Version. Such instructions must be valid at the time of your distribution. If these instructions, at any time while you are carrying out such distribution, become invalid, you must provide new instructions on demand or cease further distribution. If you provide valid instructions or cease distribution within thirty days after you become aware that the instructions are invalid, then you do not forfeit any of your rights under this license. (6) You may Distribute a Modified Version in Compiled form without the Source, provided that you comply with Section 4 with respect to the Source of the Modified Version. Aggregating or Linking the Package (7) You may aggregate the Package (either the Standard Version or Modified Version) with other packages and Distribute the resulting aggregation provided that you do not charge a licensing fee for the Package. Distributor Fees are permitted, and licensing fees for other components in the aggregation are permitted. The terms of this license apply to the use and Distribution of the Standard or Modified Versions as included in the aggregation. (8) You are permitted to link Modified and Standard Versions with other works, to embed the Package in a larger work of your own, or to build stand-alone binary or bytecode versions of applications that include the Package, and Distribute the result without restriction, provided the result does not expose a direct interface to the Package. Items That are Not Considered Part of a Modified Version (9) Works (including, but not limited to, modules and scripts) that merely extend or make use of the Package, do not, by themselves, cause the Package to be a Modified Version. In addition, such works are not considered parts of the Package itself, and are not subject to the terms of this license. General Provisions (10) Any use, modification, and distribution of the Standard or Modified Versions is governed by this Artistic License. By using, modifying or distributing the Package, you accept this license. Do not use, modify, or distribute the Package, if you do not accept this license. (11) If your Modified Version has been derived from a Modified Version made by someone other than you, you are nevertheless required to ensure that your Modified Version complies with the requirements of this license. (12) This license does not grant you the right to use any trademark, service mark, tradename, or logo of the Copyright Holder. (13) This license includes the non-exclusive, worldwide, free-of-charge patent license to make, have made, use, offer to sell, sell, import and otherwise transfer the Package with respect to any patent claims licensable by the Copyright Holder that are necessarily infringed by the Package. If you institute patent litigation (including a cross-claim or counterclaim) against any party alleging that the Package constitutes direct or contributory patent infringement, then this Artistic License to you shall terminate on the date that such litigation is filed. (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. razor-agents-2.85/MANIFEST0000644000000000000000000000356011041214714012102 0ustar Makefile.PL README CREDITS MANIFEST INSTALL BUGS FAQ Changes SERVICE_POLICY LICENSE bin/razor-admin bin/razor-check bin/razor-report bin/razor-revoke bin/razor-client docs/razor-check.pod docs/razor-admin.pod docs/razor-report.pod docs/razor-revoke.pod docs/razor-whitelist.pod docs/razor-agent.conf.pod docs/razor-agents.pod lib/Razor2/Client/Agent.pm lib/Razor2/Client/Config.pm lib/Razor2/Client/Core.pm lib/Razor2/Client/Version.pm lib/Razor2/Client/Engine.pm lib/Razor2/Errorhandler.pm lib/Razor2/Logger.pm lib/Razor2/String.pm lib/Razor2/Preproc/deBase64.pm lib/Razor2/Preproc/deHTML.pm lib/Razor2/Preproc/deQP.pm lib/Razor2/Preproc/enBase64.pm lib/Razor2/Preproc/Manager.pm lib/Razor2/Preproc/deNewline.pm lib/Razor2/Preproc/deHTML_comment.pm lib/Razor2/Signature/Ephemeral.pm lib/Razor2/Signature/Whiplash.pm lib/Razor2/Syslog.pm lib/Razor2/Engine/VR8.pm Razor2-Preproc-deHTMLxs/_deHTMLxs.c Razor2-Preproc-deHTMLxs/deHTMLxs.h Razor2-Preproc-deHTMLxs/deHTMLxs.pm Razor2-Preproc-deHTMLxs/deHTMLxs.xs Razor2-Preproc-deHTMLxs/Makefile.PL Razor2-Preproc-deHTMLxs/MANIFEST Razor2-Preproc-deHTMLxs/test.pl Razor2-Preproc-deHTMLxs/typemap Razor2-Preproc-deHTMLxs/testit/html.1 Razor2-Preproc-deHTMLxs/testit/html.1.deHTMLxs Razor2-Preproc-deHTMLxs/testit/html.2 Razor2-Preproc-deHTMLxs/testit/html.2.deHTMLxs Razor2-Preproc-deHTMLxs/testit/html.3 Razor2-Preproc-deHTMLxs/testit/html.3.deHTMLxs Razor2-Preproc-deHTMLxs/testit/html.4 Razor2-Preproc-deHTMLxs/testit/html.4.deHTMLxs Razor2-Preproc-deHTMLxs/testit/html.5 Razor2-Preproc-deHTMLxs/testit/html.5.deHTMLxs Razor2-Preproc-deHTMLxs/testit/html.6 Razor2-Preproc-deHTMLxs/testit/html.6.deHTMLxs Razor2-Preproc-deHTMLxs/testit/html.7 Razor2-Preproc-deHTMLxs/testit/html.7.deHTMLxs Razor2-Preproc-deHTMLxs/testit/html.8 Razor2-Preproc-deHTMLxs/testit/html.8.deHTMLxs META.yml Module meta-data (added by MakeMaker) razor-agents-2.85/META.yml0000644000000000000000000000114510625104016012217 0ustar # http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: razor-agents version: 2.84 version_from: lib/Razor2/Client/Version.pm installdirs: site requires: Digest::SHA1: 0 File::Copy: 0 File::Spec: 0 Getopt::Long: 0 MIME::Base64: 0 Test::More: 0 Time::HiRes: 0 URI::Escape: 0 distribution_type: module generated_by: ExtUtils::MakeMaker version 6.17 razor-agents-2.85/Makefile.PL0000644000000000000000000001001610620177031012717 0ustar #!/usr/bin/perl -s ## ## Makefile for Vipul's Razor v2. ## ## Copyright (c) 1998-2002 ## This code is free software; you can redistribute it and/or modify ## it under the same terms as Perl itself. ## ## $Id: Makefile.PL,v 1.30 2007/05/08 22:47:53 rsoderberg Exp $ use ExtUtils::MakeMaker; WriteMakefile ( DISTNAME => 'razor-agents', NAME => 'razor-agents', AUTHOR => 'Vipul Ved Prakash ', ABSTRACT => 'Collaborative, content-based spam filtering network agent.', VERSION_FROM => 'lib/Razor2/Client/Version.pm', EXE_FILES => [ qw( bin/razor-client bin/razor-admin bin/razor-check bin/razor-report bin/razor-revoke ) ], PREREQ_PM => { 'Digest::SHA1' => 0, 'File::Copy' => 0, 'File::Spec' => 0, 'Getopt::Long' => 0, 'MIME::Base64' => 0, 'Test::More' => 0, 'Time::HiRes' => 0, 'URI::Escape' => 0, }, MAN1PODS => { 'docs/razor-check.pod' => '$(INST_MAN1DIR)/razor-check.1', 'docs/razor-report.pod' => '$(INST_MAN1DIR)/razor-report.1', 'docs/razor-admin.pod' => '$(INST_MAN1DIR)/razor-admin.1', 'docs/razor-revoke.pod' => '$(INST_MAN1DIR)/razor-revoke.1', }, dist => { 'COMPRESS' => 'bzip2', 'SUFFIX' => '.bz2', 'TARFLAGS' => '--owner root --group root -cvf', }, ); { package MY; sub constants { my $self = shift; my $inherited = $self->SUPER::constants(@_); my $prefix = $ExtUtils::MakeMaker::VERSION >= 6.18 ? 'SITEPREFIX' : 'PERLPREFIX'; my $man5 = sprintf <<'MAKE', $prefix; # begin razor-agents MAN5PODS = docs/razor-agent.conf.pod \ docs/razor-whitelist.pod \ docs/razor-agents.pod INST_MAN5DIR = blib/man5 INSTALLMAN5DIR = $(DESTDIR)$(PREFIX)/share/man/man5 INSTALLSITEMAN5DIR = $(DESTDIR)$(SITEPREFIX)/share/man/man5 INSTALLVENDORMAN5DIR = $(DESTDIR)$(VENDORPREFIX)/share/man/man5 MAN5EXT = 5 # end razor-agents MAKE return $inherited . $man5; } sub MY::top_targets { use Config; my $self = shift; my $inherited = $self->SUPER::top_targets(@_); my ($perlh) = $self->catfile($Config{archlibexp}, 'CORE', "perl.h"); my $noecho = q{NOECHO = @} unless $inherited =~ /NOECHO/; my $man5 = sprintf <<'MAKE_FRAG', $perlh, $perlh; # begin razor-agents config :: $(INST_MAN5DIR)/.exists @$(NOOP) $(INST_MAN5DIR)/.exists :: %s @$(MKPATH) $(INST_MAN5DIR) @$(EQUALIZE_TIMESTAMP) %s $(INST_MAN5DIR)/.exists -@$(CHMOD) $(PERM_RWX) $(INST_MAN5DIR) # end razor-agents MAKE_FRAG return $inherited . $man5; } sub MY::manifypods { my $self = shift; my $inherited = $self->SUPER::manifypods(@_); $inherited =~ s{^(manifypods : .*)\\}{$1 manifypods-razor \\}m; # MakeMaker 6.06_x through 6.13 eliminated the POD2MAN macro. my $pod2man = $inherited =~ /^POD2MAN\b/m ? '' : 'POD2MAN = $(POD2MAN_EXE)'; my $manifypods_razor = sprintf <<'MAKE_FRAG', $pod2man; # begin razor-agents %s manifypods-razor : docs/razor-agent.conf.pod \ docs/razor-agents.pod \ docs/razor-whitelist.pod $(POD2MAN) \ docs/razor-agent.conf.pod \ $(INST_MAN5DIR)/razor-agent.conf.$(MAN5EXT) \ docs/razor-agents.pod \ $(INST_MAN5DIR)/razor-agents.$(MAN5EXT) \ docs/razor-whitelist.pod \ $(INST_MAN5DIR)/razor-whitelist.$(MAN5EXT) #end razor-agents MAKE_FRAG return $inherited . "\n" . $manifypods_razor; } sub MY::install { my $self = shift; my $inherited = $self->SUPER::install(@_); my $man5 = q{ \\ $(INST_MAN5DIR) $(INSTALLMAN5DIR)}; $inherited =~ s/(\$\((?:DEST)?INSTALL\w*MAN1DIR\))/$1$man5/gm; return $inherited; } } razor-agents-2.85/README0000644000000000000000000001302210400675050011625 0ustar Vipul's Razor v2 README Vipul's Razor is a distributed, collaborative, spam detection and filtering network. Through user contribution, Razor establishes a distributed and constantly updating catalogue of spam in propagation that is consulted by email clients to filter out known spam. Detection is done with statistical and randomized signatures that efficiently spot mutating spam content. User input is validated through reputation assignments based on consensus on report and revoke assertions which in turn is used for computing confidence values associated with individual signatures. Vipul's Razor v2 agent software is available from project's homepage at http://razor.sf.net. Razor Agents are written in Perl and will work on most Unix operating systems and others OSes for which perl is available. Installation and usage instructions can be found in the INSTALL document in the distribution. Vipul's Razor v2 is almost a complete rewrite of Razor v1. The following is a list of the most significant new features: 1 New Protocol The Razor v2 protocol has been completely redesigned. The new protocol is based on exchange of _Structured Information Strings_, that are similar to URIs and can be parsed with URI decoding libraries. v2 protocol supports _Pipelining_, which means Razor Agents can keep a connection open with server to eliminate the latency introduced by TCP 3-way handshake and 4-way breakdown for every connection. The new protocol semantics allow seamless introduction of new signature schemes. 2 Ephemeral Signatures Ephemeral Signatures are short-lived signatures based on collaboratively computed random numbers. Ephemeral Signatures select a section of text from the spam message based on a random number that changes every so often. This makes the hashing scheme a moving target, and spammers can't exploit it because they don't know which part of the message will be hashed after the random number rollover. 3 Preprocessors Razor v2 supports several preprocessors. Preprocessors alter the the text of a spam before a hash is computed. This version includes preprocessors to decode Base64 encoded messages, decode QP encoded messages and convert HTML to plaintext. Spammers employ several techniques that hide mutations in various encoding. Preprocessors defeat such techniques by hashing the content that a recipient actually sees in his/her mail user agent. 4 Multiple Filteration Engines Razor v2 supports multiple engines. An engine is logical unit that encapsulates a particular type of filteration service. Razor v2 currently supports four engines - VR1 which is equivalent to Razor v1, VR2 that is based on SHA1 signatures of bodytext, VR3 that is based on Nilsimsa signatures, and VR4 based on Ephemeral hashes. New engines can be seamlessly plugged into the service as and when required. 5 Complete Backward Compatibility with Razor v1 The VR1 engine is functionally equivalent to the Razor v1 service and uses the same database. This means users who transition from v1 to v2 will still get the benefit of several million signatures known to the v1 service. 6 Base64 signature encoding Signatures are now encoded as base 64 numbers instead of base 16 (hex), reducing traffic that goes over the wire by 33%. 7 Truth Evaluation System (TeS) Razor v2 has a transparent, back-end component known as TeS. TeS is a combination of a reputation system and pattern recognition heuristics that assigns trust to reporters and confidence values (between 0-100) to every signature. Users can set an acceptable confidence level in their Razor configuration. The server also publishes a recommended confidence level. TeS has been designed to eliminate false positives of legit bulk email that were occasionally generated by bad reports in Razor v1. 8 Submission of entire spam messages Razor v2 accepts the entire body text of spam messages not previously known to the system. This lets Razor v2 compute new Ephemeral Signatures every n hours as well as seed the database whenever a new signature scheme and/or preprocessor is introduced. It should be noted that Razor v2 _does not_ accept contents of legit email during a check dialogue. Only signatures are sent when checking email. 9 Revocation Razor v2 allows users to revoke messages that they don't consider to be spam. Revocation input is fed into TeS, that adjusts the confidence value of a signature or remove it from the database as necessary. Revocation is done through a tool called razor-revoke, which is a part of the new Razor distribution. 10 Reporter Registration Razor v2 requires reporters to be registered. This lets reporters build a reputation over time, so their reports and revocations are weighed according to their reputation value. Report requires users to authenticate which is done using a CRAM-SHA1 authentication scheme. 11 Content classes Razor v2 introduces the concept of content classes. A content class is a set of messages that represents variations on the same content. As new reports come in, Nomination servers associate them to an existing content class, if a (close) match is found. Additionally, Razor v2 treats each MIME attachment is a separate content class, so spammers MIME attachment can be individually tracked (which is very useful in case of viruses). $Id: README,v 1.4 2005/06/28 22:19:07 jpr5 Exp $ razor-agents-2.85/Razor2-Preproc-deHTMLxs/0000755000000000000000000000000010625104016015162 5ustar razor-agents-2.85/Razor2-Preproc-deHTMLxs/MANIFEST0000644000000000000000000000057410260362475016333 0ustar deHTMLxs.pm deHTMLxs.xs Makefile.PL MANIFEST typemap _deHTMLxs.c deHTMLxs.h test.pl testit/html.1 testit/html.1.deHTMLxs testit/html.2 testit/html.2.deHTMLxs testit/html.3 testit/html.3.deHTMLxs testit/html.4 testit/html.4.deHTMLxs testit/html.5 testit/html.5.deHTMLxs testit/html.6 testit/html.6.deHTMLxs testit/html.7 testit/html.7.deHTMLxs testit/html.8 testit/html.8.deHTMLxs razor-agents-2.85/Razor2-Preproc-deHTMLxs/Makefile.PL0000644000000000000000000000125710252347665017160 0ustar use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( dist => { COMPRESS => 'gzip -9v', SUFFIX => '.gz', }, 'NAME' => 'Razor2::Preproc::deHTMLxs', 'OBJECT' => q[_deHTMLxs$(OBJ_EXT) deHTMLxs$(OBJ_EXT)], 'VERSION_FROM' => 'deHTMLxs.pm', # finds $VERSION 'LIBS' => [''], # e.g., '-lm' 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' 'INC' => '', # e.g., '-I/usr/include/other' ); #PREOP => 'pod2text deHTMLxs.pm | tee README >$(DISTVNAME)/README; chmod -R u=rwX,go=rX . ;', razor-agents-2.85/Razor2-Preproc-deHTMLxs/_deHTMLxs.c0000644000000000000000000001621710375147560017141 0ustar /* * $Id: _deHTMLxs.c,v 1.5 2006/02/16 19:16:00 rsoderberg Exp $ */ #include #include #include #include "deHTMLxs.h" /* Read-only structure, so it's thread-safe */ typedef struct { char *name; char chr; } CM_PREPROC_html_tags_t; CM_PREPROC_html_tags_t CM_PREPROC_html_tags[] = { { "lt" , '<' }, { "gt" , '>' }, { "amp" , '&' }, { "quot" , '"' }, { "nbsp" , ' ' }, { "iexcl" , (char)161 }, { "cent" , (char)162 }, { "pound" , (char)163 }, { "curren", (char)164 }, { "yen" , (char)165 }, { "brvbar", (char)166 }, { "sect" , (char)167 }, { "uml" , (char)168 }, { "copy" , (char)169 }, { "ordf" , (char)170 }, { "laquo" , (char)171 }, { "not" , (char)172 }, { "shy" , (char)173 }, { "reg" , (char)174 }, { "macr" , (char)175 }, { "deg" , (char)176 }, { "plusmn", (char)177 }, { "sup2" , (char)178 }, { "sup3" , (char)179 }, { "acute" , (char)180 }, { "micro" , (char)181 }, { "para" , (char)182 }, { "middot", (char)183 }, { "cedil" , (char)184 }, { "sup1" , (char)185 }, { "ordm" , (char)186 }, { "raquo" , (char)187 }, { "frac14", (char)188 }, { "frac12", (char)189 }, { "frac34", (char)190 }, { "iquest", (char)191 }, { "Agrave", (char)192 }, { "Aacute", (char)193 }, { "Acirc" , (char)194 }, { "Atilde", (char)195 }, { "Auml" , (char)196 }, { "Aring" , (char)197 }, { "AElig" , (char)198 }, { "Ccedil", (char)199 }, { "Egrave", (char)200 }, { "Eacute", (char)201 }, { "Ecirc" , (char)202 }, { "Euml" , (char)203 }, { "Igrave", (char)204 }, { "Iacute", (char)205 }, { "Icirc" , (char)206 }, { "Iuml" , (char)207 }, { "ETH" , (char)208 }, { "Ntilde", (char)209 }, { "Ograve", (char)210 }, { "Oacute", (char)211 }, { "Ocirc" , (char)212 }, { "Otilde", (char)213 }, { "Ouml" , (char)214 }, { "times" , (char)215 }, { "Oslash", (char)216 }, { "Ugrave", (char)217 }, { "Uacute", (char)218 }, { "Ucirc" , (char)219 }, { "Uuml" , (char)220 }, { "Yacute", (char)221 }, { "THORN" , (char)222 }, { "szlig" , (char)223 }, { "agrave", (char)224 }, { "aacute", (char)225 }, { "acirc" , (char)226 }, { "atilde", (char)227 }, { "auml" , (char)228 }, { "aring" , (char)229 }, { "aelig" , (char)230 }, { "ccedil", (char)231 }, { "egrave", (char)232 }, { "eacute", (char)233 }, { "ecirc" , (char)234 }, { "euml" , (char)235 }, { "igrave", (char)236 }, { "iacute", (char)237 }, { "icirc" , (char)238 }, { "iuml" , (char)239 }, { "eth" , (char)240 }, { "ntilde", (char)241 }, { "ograve", (char)242 }, { "oacute", (char)243 }, { "ocirc" , (char)244 }, { "otilde", (char)245 }, { "ouml" , (char)246 }, { "divide", (char)247 }, { "oslash", (char)248 }, { "ugrave", (char)249 }, { "uacute", (char)250 }, { "ucirc" , (char)251 }, { "uuml" , (char)252 }, { "yacute", (char)253 }, { "thorn" , (char)254 }, { "yuml" , (char)255 }, { 0, (char)0 } }; const char *CM_PREPROC_parse_html_tag_tolower(const char *body, char *tagname, unsigned int tagnamelen) { unsigned int cch = 0; if (*body != '<') return NULL; body++; if ((*body == '!') || (*body == '/')) body++; while (isspace((unsigned char) *body)) body++; while (isalpha((unsigned char) *body)) { if(--tagnamelen == 0) break; *tagname++ = tolower(*body++); cch++; } *tagname = '\0'; if (cch == 0) return NULL; while ((*body != '\0') && (*body != '>')) body++; if (*body != '>') return NULL; /* Return pointer to the ending '>' */ return body; } int CM_PREPROC_is_html(const char *body) { char tagname[100] = {0}; const char *ppHtmlSubsetLowerCase[] = { "html", "body", "a", "font", "table", "head", "base", "meta", "td", "tr", "style", "img", "object", "br", "b", "i", "span", "div", "form", "input", "button", "frame", "iframe", "tbody", "col", "th", "hr", "xml", "script", "pre", "param", "applet", "center", "area", "map", "em", "embed", "xmp", "sub", "sup", NULL }; if ((body == NULL) || (*body == '\0')) return 0; /* Loop through all '<' chars and try to parse a recognizable HTML tag */ for (body = strchr(body, '<'); body != NULL; body = strchr(body + 1, '<')) { /* Attempt tp parse the tag */ const char *pTagEnd = CM_PREPROC_parse_html_tag_tolower(body, tagname, sizeof(tagname)); const char **ppCurTag; if (pTagEnd == NULL) continue; /* Check our tag array for its existence (everything is lower case) */ for(ppCurTag = ppHtmlSubsetLowerCase; *ppCurTag != NULL; ppCurTag++) { const char *pCurTag = *ppCurTag; if((*pCurTag == *tagname) && (strcmp(tagname, pCurTag) == 0)) return 1; } body = pTagEnd; } return 0; } static char CM_PREPROC_html_tagxlat(char **ref) { char c = 0, *s = *ref; unsigned int len = (unsigned int) strlen(s); unsigned int offset = ( len > 10 ? 10 : len ); CM_PREPROC_html_tags_t *tags; unsigned int tlen; if (!isalpha(*s)) return '&'; for (tags = (CM_PREPROC_html_tags_t*)&CM_PREPROC_html_tags; tags->name && !c; tags++) { tlen = (unsigned int) strlen(tags->name); if (tlen > offset) continue; if (!strncmp(s, tags->name, tlen)) { c = tags->chr; s += tlen; } } if (!c) c = '&'; else if (*s == ';') s++; *ref = s; return c; } char *CM_PREPROC_html_strip(char *s, char *text) { int sgml = 0, tag = 0; char c, last = '\0', quote = '\0', *t; if ((t = text) == NULL) return NULL; if (!s || !*s) return NULL; memset(text, 0, strlen(s)+1); while ((c = *s++)) { if (c == quote) { if (c == '-' && last != '-') goto next; else last = '\0'; quote = '\0'; } else if (!quote) { switch (c) { case '<': tag = 1; if (*s == '!') { sgml = 1; s++; } else if (*s) s++; break; case '>': if (tag) sgml = tag = 0; break; case '-': if (sgml && last == '-') quote = '-'; else goto valid; break; case '"': case '\'': if (tag) quote = c; else goto valid; break; case '&': *t++ = CM_PREPROC_html_tagxlat(&s); break; default: valid: if (!tag) *t++ = c; break; } } next: last = c; } return text; } razor-agents-2.85/Razor2-Preproc-deHTMLxs/deHTMLxs.h0000644000000000000000000000036110260362475016775 0ustar #ifndef RAZOR2_PREPROC_DEHTML_HH #define RAZOR2_PREPROC_DEHTML_HH int CM_PREPROC_is_html(const char *); /* caller must give us empty buffer *text that */ /* is at least as big as *s. */ char *CM_PREPROC_html_strip(char *, char *); #endif razor-agents-2.85/Razor2-Preproc-deHTMLxs/deHTMLxs.pm0000644000000000000000000000214310252347665017167 0ustar package Razor2::Preproc::deHTMLxs; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); require Exporter; require DynaLoader; require AutoLoader; @ISA = qw(Exporter DynaLoader); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. @EXPORT = qw( ); $VERSION = '2.18'; bootstrap Razor2::Preproc::deHTMLxs $VERSION; # Preloaded methods go here. # Autoload methods go after =cut, and are processed by the autosplit program. 1; __END__ # Below is the stub of documentation for your module. You better edit it! =head1 NAME Razor2::Preproc::deHTMLxs - Perl extension for libpreproc deHTMLxs code =head1 SYNOPSIS use Razor2::Preproc::deHTMLxs; blah blah blah =head1 DESCRIPTION Stub documentation for Razor2::Preproc::deHTMLxs was created by h2xs. It looks like the author of the extension was negligent enough to leave the stub unedited. Blah blah blah. =head1 AUTHOR A. U. Thor, a.u.thor@a.galaxy.far.far.away =head1 SEE ALSO perl(1). =cut razor-agents-2.85/Razor2-Preproc-deHTMLxs/deHTMLxs.xs0000644000000000000000000000636110375147560017211 0ustar /* $Id: deHTMLxs.xs,v 1.6 2006/02/16 19:16:00 rsoderberg Exp $ */ #include "EXTERN.h" #include "perl.h" #include "XSUB.h" /* try to be compatible with older perls */ /* SvPV_nolen() macro first defined in 5.005_55 */ /* this is slow, not threadsafe, but works */ #include "patchlevel.h" #if (PATCHLEVEL == 4) || ((PATCHLEVEL == 5) && (SUBVERSION < 55)) static STRLEN nolen_na; # define SvPV_nolen(sv) SvPV ((sv), nolen_na) #endif #include "deHTMLxs.h" typedef struct mystate { int is_xs; } *Razor2__Preproc__deHTMLxs; MODULE = Razor2::Preproc::deHTMLxs PACKAGE = Razor2::Preproc::deHTMLxs PROTOTYPES: ENABLE Razor2::Preproc::deHTMLxs new(class) SV * class CODE: { Newz(0, RETVAL, 1, struct mystate); RETVAL->is_xs = 1; /* placeholder, not used now */ } OUTPUT: RETVAL int is_xs(self) Razor2::Preproc::deHTMLxs self; CODE: RETVAL = 1; OUTPUT: RETVAL char * testxs(self, str) Razor2::Preproc::deHTMLxs self; char * str; CODE: RETVAL = str + 1; OUTPUT: RETVAL SV * isit(self, scalarref) Razor2::Preproc::deHTMLxs self; SV * scalarref; CODE: { /* 2002/11/21 Anne Bennett: use the right type def: */ STRLEN size; char * raw; SV * text; const char mynull = 0; if (SvROK(scalarref)) { text = SvRV(scalarref); /* normally perl has '\0' on end, but not guaranteed */ sv_catpv(text,&mynull); raw = SvPV(text,size); /* bool CM_PREPROC_is_html(const char *); */ if (CM_PREPROC_is_html(raw)) { RETVAL = newSVpv ("1", 0); } else { RETVAL = newSVpv ("", 0); } } else { RETVAL = newSVpv ("", 0); } } OUTPUT: RETVAL SV * doit(self, scalarref) Razor2::Preproc::deHTMLxs self; SV * scalarref CODE: { char * cleaned, * raw, * res; /* 2002/11/21 Anne Bennett: use the right type def: */ STRLEN size; SV * text; SV * newtext; SV * newref; if (SvROK(scalarref)) { text = SvRV(scalarref); raw = SvPV(text,size); *(raw + size - 1) = '\0'; if ( (cleaned = malloc(size+1)) && (res = CM_PREPROC_html_strip(raw, cleaned)) /* html_strip will memset cleaned to 0 */ ) { /* * hook it up so scalarref will dereference to new scalar */ newtext = newSVpv (res, 0); /* newtext is new scalar containing cleaned html. * we want scalarref to point to that instead of its old dude, text. */ /* sv_setsv (SV* dest, SV* src) */ sv_setsv(text, newtext); SvREFCNT_inc(scalarref); RETVAL = scalarref; free(cleaned); } else { if (cleaned) { free(cleaned); } RETVAL = newSVpv ("", 0); } } else { RETVAL = newSVpv ("", 0); } } OUTPUT: RETVAL razor-agents-2.85/Razor2-Preproc-deHTMLxs/test.pl0000755000000000000000000000410710253376157016521 0ustar # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..10\n"; } END {print "not ok 1\n" unless $loaded;} use Razor2::Preproc::deHTMLxs; $loaded = 1; print "ok 1\n"; ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code): my $dh = new Razor2::Preproc::deHTMLxs; print "NOT " unless $dh->is_xs; print "ok 2\n"; my $debug=0; my $hdr = "X-Razor2-Dummy: foo\n\n"; my $testnum = 3; foreach my $html_fn (qw( html.1 html.2 html.3 html.4 html.5 html.6 html.7 html.8 )) { my $fn = "testit/$html_fn"; open(IN, "$fn") or die "cant read $fn"; my $html = $hdr . join '', ; close IN; if ($dh->isit(\$html)) { #my $cleaned_ref = $dh->doit(\$cleaned); #my $cleaned = $$cleaned_ref; my $cleaned = $html; $dh->doit(\$cleaned); $cleaned =~ s/^$hdr//s; print "html: $fn (len=". length($html) .") cleaned len=". length($cleaned) ."\n" if $debug; #print "NOT " unless $cleaned eq $dehtml; if ( $^O eq 'VMS' ) {open(IN, "${fn}_deHTMLxs") or die "cant read ${fn}_deHTMLxs";} if ( $^O ne 'VMS' ) {open(IN, "$fn.deHTMLxs") or die "cant read $fn.deHTMLxs";} my $dehtml = join '', ; close IN; if ($cleaned eq $dehtml) { print " -- YEAH -- cleaned html is same as .deHTMLxs: $fn\n" if $debug; } else { print "NOT "; print "cleaned html (len=". length($cleaned) .") differs from .deHTMLxs (len=". length($dehtml) .")\n" if $debug; } } else { print "not html: $fn (len=". length($html) .")\n" if $debug; print "NOT "; } print "ok ". $testnum++ ."\n"; } razor-agents-2.85/Razor2-Preproc-deHTMLxs/testit/0000755000000000000000000000000010625104016016476 5ustar razor-agents-2.85/Razor2-Preproc-deHTMLxs/testit/html.10000644000000000000000000002214210252347671017541 0ustar Bravenet.com Freebies Ezine

In This Issue:   Reminders | Free Album | Sunglasses | Teddies
My Reminder Service

Join Now and you will never forget another important occasion again! MyReminderService is the easiest and most complete reminder and calendar service on the Web.

Let us remind you about anything, at any time, and to any device that you specify. Sign up for our Free 7 day Trial Membership today!
FREE FlipAlbum Offer

FlipAlbum is an excellent way for budding amateurs to file, catalog, view, and share their photos with family, friends, co-workers, or anyone else. It's a software package recommended for anyone serious about organizing images.


FREE Sunglasses!

Free Sunglasses!Get a pair of $130.00 value sunglasses for FREE. Get a pair for yourself and tell your friend(s) about this great offer. Offer valid until April 15th 2002 or until stocks last!

*** LIMIT 1 PAIR PER PERSON ONLY ***
Teddy Bears Looking For A Home!

FREE Pocket Teddy Bear for 2002!


FREE TEDDY!For a limited time, the vendor is giving away this for FREE! Get one of these cute little pocket size teddy bears while stock lasts! You can place Teddy on your desk, in your car or make Teddy your keychain!
Special Offer

Traffic for Less
Than a Penny!!!
Click Here!

Webmaster Extras


Webmaster Extras

• Web Design

• Web Software

• Domain Names

• Web Hosting

• E-Commerce

• Work at Home!

• Tech Jobs

• Education
To unsubscribe, please Click Here.
razor-agents-2.85/Razor2-Preproc-deHTMLxs/testit/html.1.deHTMLxs0000644000000000000000000000370210252347671021171 0ustar Bravenet.com Freebies Ezine In This Issue: Reminders | Free Album | Sunglasses | Teddies My Reminder Service Join Now and you will never forget another important occasion again! MyReminderService is the easiest and most complete reminder and calendar service on the Web. Let us remind you about anything, at any time, and to any device that you specify. Sign up for our Free 7 day Trial Membership today! Click Here to Join Now! FREE FlipAlbum Offer FlipAlbum is an excellent way for budding amateurs to file, catalog, view, and share their photos with family, friends, co-workers, or anyone else. It's a software package recommended for anyone serious about organizing images. FREE 30 Day Trial Download! FREE Sunglasses! Get a pair of $130.00 value sunglasses for FREE. Get a pair for yourself and tell your friend(s) about this great offer. Offer valid until April 15th 2002 or until stocks last! *** LIMIT 1 PAIR PER PERSON ONLY *** Click Here to Learn More! Teddy Bears Looking For A Home! FREE Pocket Teddy Bear for 2002! For a limited time, the vendor is giving away this for FREE! Get one of these cute little pocket size teddy bears while stock lasts! You can place Teddy on your desk, in your car or make Teddy your keychain! Click Here to Get Yours! Special Offer Traffic for Less Than a Penny!!!Click Here! • FREE OFFERS! Click Here • FREE Promotion! Click Here Webmaster Extras Webmaster Extras • Web Design • Web Software • Domain Names • Web Hosting • E-Commerce • Work at Home! • Tech Jobs • Education To unsubscribe, please Click Here. razor-agents-2.85/Razor2-Preproc-deHTMLxs/testit/html.20000644000000000000000000001237210252347671017546 0ustar Hi Daniel A Hale,

Just kidding. It was used to be $130 but it's now $6.95.
Rock..Baby..Rock..
This mother and baby bears set inspires the most enchanting atmosphere.

This crystal contains 24% to 30% lead with strict quality control. They were specifically ordered by oversea distributors to be sold to department stores. Due to the Economic downturn, the distributor went bankrupt, which also brought down the manufacturer. We were able to pick up the inventory at pennies on a dollar. We just pass the saving to you. That's why you're seeing rediculus prices here.

Similar item like this sell for more than $130 in retail store, but it will be yours for $6.95 .
To qualify for this invitation, please fill out the following questions.
Your responses will in no way go into your personal profile. We are interested in statistical data only.

Questions Response
Do you own or use any kind of PDA(Personal Digital Assistant)? yes
no
Do you own or use a digital camera or camcorder? yes
no
Do you own or use a Sony game console such as PS1,PS2 or Gameboy? yes
no
Do you own or use a MP3 player? yes
no
Do you own or use a DVD player? yes
no
Group Profile:
Area Code Gender:
Male Female 		Age Group Income
After you selected your choices, don't forget to

This email is sent to dhale@pobox.com. If you believe you did not belong to our sponsors customers list,
you can remove your email address from our distribution list by clicking the link below.
Click here if you prefer not to receive future e-mail from us.
Click here to view our permission marketing policy.
razor-agents-2.85/Razor2-Preproc-deHTMLxs/testit/html.2.deHTMLxs0000644000000000000000000000336010256602064021164 0ustar Hi Daniel A Hale, Just kidding. It was used to be $130 but it's now $6.95. Rock..Baby..Rock.. This mother and baby bears set inspires the most enchanting atmosphere. This crystal contains 24% to 30% lead with strict quality control. They were specifically ordered by oversea distributors to be sold to department stores. Due to the Economic downturn, the distributor went bankrupt, which also brought down the manufacturer. We were able to pick up the inventory at pennies on a dollar. We just pass the saving to you. That's why you're seeing rediculus prices here. Similar item like this sell for more than $130 in retail store, but it will be yours for $6.95 .To qualify for this invitation, please fill out the following questions. Your responses will in no way go into your personal profile. We are interested in statistical data only. Questions Response Do you own or use any kind of PDA(Personal Digital Assistant)? yes no Do you own or use a digital camera or camcorder? yes no Do you own or use a Sony game console such as PS1,PS2 or Gameboy? yes no Do you own or use a MP3 player? yes no Do you own or use a DVD player? yes no Group Profile: Area Code Gender: Male Female Age Group select below 18 and below 19-30 31-45 46-60 60+ Income select below less than 20k 20-30k 30-40k 40-60k 60-80k 80-100k 100k+ After you selected your choices, don't forget to This email is sent to dhale@pobox.com. If you believe you did not belong to our sponsors customers list, you can remove your email address from our distribution list by clicking the link below. Click here if you prefer not to receive future e-mail from us. Click here to view our permission marketing policy. razor-agents-2.85/Razor2-Preproc-deHTMLxs/testit/html.30000644000000000000000000003451010252347671017545 0ustar


Dear Preferred Customer,

Don't miss your last chance to save big during the Britannica Store Annual Reference sale. As a valued customer, you still have time to take advantage of exceptional savings on over 50 of our most popular print and electronic reference products at savings of up to 90% off our regular prices! Yes — 90% off.

And with 0% interest, $100 down installment plans for our reference suites, it's even easier to take advantage of these smart savings.

Don't delay — supplies are limited. This sale ends April 6th.

     
 


Britannica® 2001 DVD Edition

Sale Price $19.95 (USD)
Orig Price $69.95 (USD)
You Save 70%!

With Nobel Prize-winning contributors and Internet tools that give you access to the very latest information available, this multimedia-rich resource is a must for any home or office.

You might also be interested in:

•

Great Books of the Western World®
50% off!

•

First Edition Replica Set
75% off!

•

The Annals of America
85% off!

•

Merriam-Webster Premium Gift Set
35% off!


Merriam-Webster's Third New International Dictionary® CD-ROM

Sale Price $41.95 (USD)
Orig Price $69.95 (USD)
You Save 40%!

With this powerful electronic version of the world's largest, most comprehensive American dictionary, a wealth of language information is as close as your computer.

You might also be interested in:

•

Britannica® Premium Online Service Gift Certificate
50% off!

•

NEW! 2002 Compton's Student Encyclopedia
20% off!

•

Clever Kids Discovery Workshop, Grades 6-8
40% off!

  
   
 
 
 
Sponsored by:
iExplore.com

Britannica Members
Get $100 off any trip! 		  The Hot List
Our top selling destinations:
1 Exploring the Galapagos Islands & Ecuador
   2 Hiking Machu Picchu & Peru
   3 Costa Rica
  
   
 


Offer good on products shipped in the U.S. and Canada only. About these offers: All products are US versions. Additional shipping charges and taxes will apply. All prices are in US dollars. Items ordered from the Britannica Store ship from the US, so customs and duties may apply. All customs and duties are the responsibility of the recipient. The same or similar products may be found at a location closer to you. Follow the links below for local pricing and shipping charges.

Britannica offers price adjustments on sale items if a price is reduced within 14 days after the purchase date. Your purchase price will be adjusted to reflect the difference between the two prices (not inclusive of taxes). To receive the price adjustment, you must contact us within 7 days of the start of the sale (Call 1-800-323-1229 or e-mail us at specialoffer@us.britannica.com.)

We sent you this e-mail because you requested to receive promotional e-mails from Britannica. If you prefer not to receive future product and service update mailings from Britannica, simply click here.

Our International Sites:
Australia | India | United Kingdom

© 2002 Encyclopædia Britannica, Inc.

 

  
razor-agents-2.85/Razor2-Preproc-deHTMLxs/testit/html.3.deHTMLxs0000644000000000000000000000622510256602064021170 0ustar Dear Preferred Customer, Don't miss your last chance to save big during the Britannica Store Annual Reference sale. As a valued customer, you still have time to take advantage of exceptional savings on over 50 of our most popular print and electronic reference products at savings of up to 90% off our regular prices! Yes — 90% off.And with 0% interest, $100 down installment plans for our reference suites, it's even easier to take advantage of these smart savings. Don't delay — supplies are limited. This sale ends April 6th. Britannica® 2001 DVD EditionSale Price $19.95 (USD)Orig Price $69.95 (USD)You Save 70%!With Nobel Prize-winning contributors and Internet tools that give you access to the very latest information available, this multimedia-rich resource is a must for any home or office.You might also be interested in: • Great Books of the Western World® 50% off! • First Edition Replica Set 75% off! • The Annals of America 85% off! • Merriam-Webster Premium Gift Set 35% off! Merriam-Webster's Third New International Dictionary® CD-ROMSale Price $41.95 (USD) Orig Price $69.95 (USD)You Save 40%! With this powerful electronic version of the world's largest, most comprehensive American dictionary, a wealth of language information is as close as your computer.You might also be interested in: • Britannica® Premium Online Service Gift Certificate 50% off! • NEW! 2002 Compton's Student Encyclopedia 20% off! • Clever Kids Discovery Workshop, Grades 6-8 40% off! Sponsored by: Britannica MembersGet $100 off any trip! Our top selling destinations: 1 Exploring the Galapagos Islands & Ecuador 2 Hiking Machu Picchu & Peru 3 Costa Rica Click to See Rest of Top Ten Offer good on products shipped in the U.S. and Canada only. About these offers: All products are US versions. Additional shipping charges and taxes will apply. All prices are in US dollars. Items ordered from the Britannica Store ship from the US, so customs and duties may apply. All customs and duties are the responsibility of the recipient. The same or similar products may be found at a location closer to you. Follow the links below for local pricing and shipping charges. Britannica offers price adjustments on sale items if a price is reduced within 14 days after the purchase date. Your purchase price will be adjusted to reflect the difference between the two prices (not inclusive of taxes). To receive the price adjustment, you must contact us within 7 days of the start of the sale (Call 1-800-323-1229 or e-mail us at specialoffer@us.britannica.com.) We sent you this e-mail because you requested to receive promotional e-mails from Britannica. If you prefer not to receive future product and service update mailings from Britannica, simply click here. Our International Sites:Australia | India | United Kingdom © 2002 Encyclopædia Britannica, Inc. razor-agents-2.85/Razor2-Preproc-deHTMLxs/testit/html.40000644000000000000000000000130410253375364017542 0ustar Untitled Document
¨ç Ä«µå´ë³³/Ä«µå¿¬Ã¼/Ä«µå´ëÃâ Çö±Ý¼­ºñ½º 10ºÐÀÇ1 ±Ý¸®!!
¨è ½ÃÁßÀºÇຸ´Ù Àú·ÅÇÑ ±Ý¸®·Î Àå±âÇҺδëÃâµµ °¡´ÉÇÕ´Ï´Ù.
¨é ±¹³»ÃÖÀú Ä«µå±Ý¸® È®½Çº¸Àå!! ÀÎÅÍ³Ý ½Åû¼­ ÀÛ¼º¸¸À¸·Î ¼­·ùÁغñ ³¡!
¨ê ³ë¼÷ÀÚ/¹«Á÷ÀÚ/Àü¾÷ÁֺΠ´©±¸¶óµµ ¹«¼­·ù ´çÀÏ100%ÀÔ±Ý!

¢Ï Ä«µå´ëÃâ 100% ´çÀÏ ½ÂÀÎ ¹× ÀÔ±Ý---[½ÅûÇϱâ]


razor-agents-2.85/Razor2-Preproc-deHTMLxs/testit/html.4.deHTMLxs0000644000000000000000000000050310256602064021162 0ustar Untitled Document ¨ç Ä«µå´ë³³/Ä«µå¿¬Ã¼/Ä«µå´ëÃâ Çö±Ý¼­ºñ½º 10ºÐÀÇ1 ±Ý¸®!! ¨è ½ÃÁßÀºÇຸ´Ù Àú·ÅÇÑ ±Ý¸®·Î Àå±âÇҺδëÃâµµ °¡´ÉÇÕ´Ï´Ù.¨é ±¹³»ÃÖÀú Ä«µå±Ý¸® È®½Çº¸Àå!! ÀÎÅÍ³Ý ½Åû¼­ ÀÛ¼º¸¸À¸·Î ¼­·ùÁغñ ³¡!¨ê ³ë¼÷ÀÚ/¹«Á÷ÀÚ/Àü¾÷ÁֺΠ´©±¸¶óµµ ¹«¼­·ù ´çÀÏ100%ÀÔ±Ý! ¢Ï Ä«µå´ëÃâ 100% ´çÀÏ ½ÂÀÎ ¹× ÀÔ±Ý---[½ÅûÇϱâ] razor-agents-2.85/Razor2-Preproc-deHTMLxs/testit/html.50000644000000000000000000000130410253375364017543 0ustar Untitled Document
¨ç Ä«µå´ë³³/Ä«µå¿¬Ã¼/Ä«µå´ëÃâ Çö±Ý¼­ºñ½º 10ºÐÀÇ1 ±Ý¸®!!
¨è ½ÃÁßÀºÇຸ´Ù Àú·ÅÇÑ ±Ý¸®·Î Àå±âÇҺδëÃâµµ °¡´ÉÇÕ´Ï´Ù.
¨é ±¹³»ÃÖÀú Ä«µå±Ý¸® È®½Çº¸Àå!! ÀÎÅÍ³Ý ½Åû¼­ ÀÛ¼º¸¸À¸·Î ¼­·ùÁغñ ³¡!
¨ê ³ë¼÷ÀÚ/¹«Á÷ÀÚ/Àü¾÷ÁֺΠ´©±¸¶óµµ ¹«¼­·ù ´çÀÏ100%ÀÔ±Ý!

¢Ï Ä«µå´ëÃâ 100% ´çÀÏ ½ÂÀÎ ¹× ÀÔ±Ý---[½ÅûÇϱâ]


razor-agents-2.85/Razor2-Preproc-deHTMLxs/testit/html.5.deHTMLxs0000644000000000000000000000050310256602064021163 0ustar Untitled Document ¨ç Ä«µå´ë³³/Ä«µå¿¬Ã¼/Ä«µå´ëÃâ Çö±Ý¼­ºñ½º 10ºÐÀÇ1 ±Ý¸®!! ¨è ½ÃÁßÀºÇຸ´Ù Àú·ÅÇÑ ±Ý¸®·Î Àå±âÇҺδëÃâµµ °¡´ÉÇÕ´Ï´Ù.¨é ±¹³»ÃÖÀú Ä«µå±Ý¸® È®½Çº¸Àå!! ÀÎÅÍ³Ý ½Åû¼­ ÀÛ¼º¸¸À¸·Î ¼­·ùÁغñ ³¡!¨ê ³ë¼÷ÀÚ/¹«Á÷ÀÚ/Àü¾÷ÁֺΠ´©±¸¶óµµ ¹«¼­·ù ´çÀÏ100%ÀÔ±Ý! ¢Ï Ä«µå´ëÃâ 100% ´çÀÏ ½ÂÀÎ ¹× ÀÔ±Ý---[½ÅûÇϱâ] razor-agents-2.85/Razor2-Preproc-deHTMLxs/testit/html.60000644000000000000000000000115210253375364017545 0ustar
¨ç Á÷ÀåÀÎ ´ëÃâ!! Á÷ÀåÀÎ ´ëÃâ±Ý¸® ´ëÆøÀÎÇÏ!!
¨è ¹«¹æ¹®!! ¹«º¸Áõ!! Á÷ÀåÀÎÀÌ¸é ´©±¸³ª 100% ´ëÃâ!!
¨é ÀÎÅÍ³Ý ½Åû¼­¸¸ ÀÛ¼ºÇÏ½Ã¸é ¸ðµç ¼­·ùÁغñ ³¡!
¨ê Á÷ÀåÀÎ ½Å¿ë/ÀçÁ¤»óÅ ¹«°üÇÏ°Ô ¿øŬ¸¯ 100%´ëÃâ!

¢Ï ±¹³» ÃÖÀú±Ý¸® Á÷ÀåÀÎ ´ëÃâ---[½ÅûÇϱâ] razor-agents-2.85/Razor2-Preproc-deHTMLxs/testit/html.6.deHTMLxs0000644000000000000000000000037010253375364021175 0ustar ¨ç Á÷ÀåÀÎ ´ëÃâ!! Á÷ÀåÀÎ ´ëÃâ±Ý¸® ´ëÆøÀÎÇÏ!!¨è ¹«¹æ¹®!! ¹«º¸Áõ!! Á÷ÀåÀÎÀÌ¸é ´©±¸³ª 100% ´ëÃâ!!¨é ÀÎÅÍ³Ý ½Åû¼­¸¸ ÀÛ¼ºÇÏ½Ã¸é ¸ðµç ¼­·ùÁغñ ³¡!¨ê Á÷ÀåÀÎ ½Å¿ë/ÀçÁ¤»óÅ ¹«°üÇÏ°Ô ¿øŬ¸¯ 100%´ëÃâ!¢Ï ±¹³» ÃÖÀú±Ý¸® Á÷ÀåÀÎ ´ëÃâ---[½ÅûÇϱâ] razor-agents-2.85/Razor2-Preproc-deHTMLxs/testit/html.70000644000000000000000000000115210253375364017546 0ustar
¨ç Á÷ÀåÀÎ ´ëÃâ!! Á÷ÀåÀÎ ´ëÃâ±Ý¸® ´ëÆøÀÎÇÏ!!
¨è ¹«¹æ¹®!! ¹«º¸Áõ!! Á÷ÀåÀÎÀÌ¸é ´©±¸³ª 100% ´ëÃâ!!
¨é ÀÎÅÍ³Ý ½Åû¼­¸¸ ÀÛ¼ºÇÏ½Ã¸é ¸ðµç ¼­·ùÁغñ ³¡!
¨ê Á÷ÀåÀÎ ½Å¿ë/ÀçÁ¤»óÅ ¹«°üÇÏ°Ô ¿øŬ¸¯ 100%´ëÃâ!

¢Ï ±¹³» ÃÖÀú±Ý¸® Á÷ÀåÀÎ ´ëÃâ---[½ÅûÇϱâ] razor-agents-2.85/Razor2-Preproc-deHTMLxs/testit/html.7.deHTMLxs0000644000000000000000000000037010253375364021176 0ustar ¨ç Á÷ÀåÀÎ ´ëÃâ!! Á÷ÀåÀÎ ´ëÃâ±Ý¸® ´ëÆøÀÎÇÏ!!¨è ¹«¹æ¹®!! ¹«º¸Áõ!! Á÷ÀåÀÎÀÌ¸é ´©±¸³ª 100% ´ëÃâ!!¨é ÀÎÅÍ³Ý ½Åû¼­¸¸ ÀÛ¼ºÇÏ½Ã¸é ¸ðµç ¼­·ùÁغñ ³¡!¨ê Á÷ÀåÀÎ ½Å¿ë/ÀçÁ¤»óÅ ¹«°üÇÏ°Ô ¿øŬ¸¯ 100%´ëÃâ!¢Ï ±¹³» ÃÖÀú±Ý¸® Á÷ÀåÀÎ ´ëÃâ---[½ÅûÇϱâ] razor-agents-2.85/Razor2-Preproc-deHTMLxs/testit/html.80000644000000000000000000000130410253375364017546 0ustar Untitled Document
¨ç Ä«µå´ë³³/Ä«µå¿¬Ã¼/Ä«µå´ëÃâ Çö±Ý¼­ºñ½º 10ºÐÀÇ1 ±Ý¸®!!
¨è ½ÃÁßÀºÇຸ´Ù Àú·ÅÇÑ ±Ý¸®·Î Àå±âÇҺδëÃâµµ °¡´ÉÇÕ´Ï´Ù.
¨é ±¹³»ÃÖÀú Ä«µå±Ý¸® È®½Çº¸Àå!! ÀÎÅÍ³Ý ½Åû¼­ ÀÛ¼º¸¸À¸·Î ¼­·ùÁغñ ³¡!
¨ê ³ë¼÷ÀÚ/¹«Á÷ÀÚ/Àü¾÷ÁֺΠ´©±¸¶óµµ ¹«¼­·ù ´çÀÏ100%ÀÔ±Ý!

¢Ï Ä«µå´ëÃâ 100% ´çÀÏ ½ÂÀÎ ¹× ÀÔ±Ý---[½ÅûÇϱâ]


razor-agents-2.85/Razor2-Preproc-deHTMLxs/testit/html.8.deHTMLxs0000644000000000000000000000050310256602064021166 0ustar Untitled Document ¨ç Ä«µå´ë³³/Ä«µå¿¬Ã¼/Ä«µå´ëÃâ Çö±Ý¼­ºñ½º 10ºÐÀÇ1 ±Ý¸®!! ¨è ½ÃÁßÀºÇຸ´Ù Àú·ÅÇÑ ±Ý¸®·Î Àå±âÇҺδëÃâµµ °¡´ÉÇÕ´Ï´Ù.¨é ±¹³»ÃÖÀú Ä«µå±Ý¸® È®½Çº¸Àå!! ÀÎÅÍ³Ý ½Åû¼­ ÀÛ¼º¸¸À¸·Î ¼­·ùÁغñ ³¡!¨ê ³ë¼÷ÀÚ/¹«Á÷ÀÚ/Àü¾÷ÁֺΠ´©±¸¶óµµ ¹«¼­·ù ´çÀÏ100%ÀÔ±Ý! ¢Ï Ä«µå´ëÃâ 100% ´çÀÏ ½ÂÀÎ ¹× ÀÔ±Ý---[½ÅûÇϱâ] razor-agents-2.85/Razor2-Preproc-deHTMLxs/typemap0000644000000000000000000000004510252347665016602 0ustar Razor2::Preproc::deHTMLxs T_PTROBJ razor-agents-2.85/SERVICE_POLICY0000644000000000000000000000056610406347354013071 0ustar Razor2 Service Policy V2.0 March 13, 2006 Razor2 Service Policy Razor2 agents connect to the Cloudmark Collaborative Security Network to report spam and check for fingerprints. Cloudmark provides free and open access to the CCSN but reserves the right to deny access to anyone. If you have questions about Razor2 usage, please send them to razor2-usage@cloudmark.com. razor-agents-2.85/bin/0000755000000000000000000000000010625104016011515 5ustar razor-agents-2.85/bin/razor-admin0000755000000000000000000000150210434711206013667 0ustar #!/usr/bin/perl -w ## ## I do the following. ## ## razor-admin - registers a new reporter, creates razorhome, etc.. ## ## Copyright (c) 1998, Vipul Ved Prakash. All rights reserved. ## This code is free software; you can redistribute it and/or modify ## it under the same terms as Perl itself. ## ## $Id: razor-admin,v 1.1 2005/06/16 19:45:54 rsoderberg Exp $ use lib qw(lib); use strict; use Razor2::Client::Agent; my $agent = new Razor2::Client::Agent('razor-admin') or die $Razor2::Client::Agent::errstr; $agent->read_options() or die $agent->errstr ."\n"; $agent->do_conf() or die $agent->errstr ."\n"; # quiet warning my $dummy = $Razor2::Client::Agent::errstr; # # doit() will not exit # my $response = $agent->doit(); if ($response > 1) { # error print STDERR $agent->errstr; } exit $response; razor-agents-2.85/bin/razor-check0000755000000000000000000000150410434711206013656 0ustar #!/usr/bin/perl -w ## ## I do the following. ## ## razor-check - check spam message against a Razor Catalogue Server. ## ## Copyright (c) 1998, Vipul Ved Prakash. All rights reserved. ## This code is free software; you can redistribute it and/or modify ## it under the same terms as Perl itself. ## ## $Id: razor-check,v 1.1 2005/06/16 19:45:54 rsoderberg Exp $ use lib qw(lib); use strict; use Razor2::Client::Agent; my $agent = new Razor2::Client::Agent('razor-check') or die $Razor2::Client::Agent::errstr; $agent->read_options() or die $agent->errstr ."\n"; $agent->do_conf() or die $agent->errstr ."\n"; # quiet warning my $dummy = $Razor2::Client::Agent::errstr; # # doit() will not exit # my $response = $agent->doit(); if ($response > 1) { # error print STDERR $agent->errstr; } exit $response; razor-agents-2.85/bin/razor-client0000755000000000000000000000103110254372406014057 0ustar #!/usr/bin/perl -w ## ## I do nothing. This is a placeholder for upgrades from pre-2.72. ## ## Copyright (c) 1998, Vipul Ved Prakash. All rights reserved. ## This code is free software; you can redistribute it and/or modify ## it under the same terms as Perl itself. ## ## $Id: razor-client,v 1.10 2005/06/16 21:54:14 vipul Exp $ # No longer creates symlinks, leaving this wrapper behind to ensure # that upgrades work as expected. print "This program is deprecated and no longer necessary. You may begin using Razor now.\n"; exit; razor-agents-2.85/bin/razor-report0000755000000000000000000000151010434711206014111 0ustar #!/usr/bin/perl -w ## ## I do the following. ## ## razor-report - report email as NOT spam to a Razor Nomination Server. ## ## Copyright (c) 1998, Vipul Ved Prakash. All rights reserved. ## This code is free software; you can redistribute it and/or modify ## it under the same terms as Perl itself. ## ## $Id: razor-report,v 1.1 2005/06/16 19:45:54 rsoderberg Exp $ use lib qw(lib); use strict; use Razor2::Client::Agent; my $agent = new Razor2::Client::Agent('razor-report') or die $Razor2::Client::Agent::errstr; $agent->read_options() or die $agent->errstr ."\n"; $agent->do_conf() or die $agent->errstr ."\n"; # quiet warning my $dummy = $Razor2::Client::Agent::errstr; # # doit() will not exit # my $response = $agent->doit(); if ($response > 1) { # error print STDERR $agent->errstr; } exit $response; razor-agents-2.85/bin/razor-revoke0000755000000000000000000000151010434711206014071 0ustar #!/usr/bin/perl -w ## ## I do the following. ## ## razor-revoke - report email as NOT spam to a Razor Nomination Server. ## ## Copyright (c) 1998, Vipul Ved Prakash. All rights reserved. ## This code is free software; you can redistribute it and/or modify ## it under the same terms as Perl itself. ## ## $Id: razor-revoke,v 1.1 2005/06/16 19:45:54 rsoderberg Exp $ use lib qw(lib); use strict; use Razor2::Client::Agent; my $agent = new Razor2::Client::Agent('razor-revoke') or die $Razor2::Client::Agent::errstr; $agent->read_options() or die $agent->errstr ."\n"; $agent->do_conf() or die $agent->errstr ."\n"; # quiet warning my $dummy = $Razor2::Client::Agent::errstr; # # doit() will not exit # my $response = $agent->doit(); if ($response > 1) { # error print STDERR $agent->errstr; } exit $response; razor-agents-2.85/docs/0000755000000000000000000000000011041214747011703 5ustar razor-agents-2.85/docs/razor-admin.pod0000644000000000000000000001226111041214747014634 0ustar =head1 NAME C - Razor Registering Agent =head1 SYNOPSIS razor-admin [options] [ -register | -create | -discover ] =head1 DESCRIPTION C is the Razor Agent that performs administrative functions, most notably registering (-register) =head1 USAGE C must have one of the following arguments: =over 4 =item C<-register> Registers a new identity, used for authenticating with Razor Nomination Servers. Identities are a user + password pair stored in CrazorhomeE/identity-EuserE>. The first time C exits successfully, a symlink C is created to point to the active CuserE> file. After that, new identities can be created, but in order to use them the symlink C must be changed to point to them. In general, it should be called once from the command line. Exits 0 for success, exits 1 on failure with a human-readable output message. Both razor-report(1) and razor-revoke(1) require user authentication to work, razor-check(1) does not. This allows the Razor Nomination Server to keep track of how many messages a user reports and revokes. The more messages a user correctly reports and/or correctly revokes, the more trust the user earns. Likewise, when messages are incorrectly reported or revoked, the trust goes down for that user. Highly trusted users will have the most affect on the Razor database. =item C<-discover> Force discovery. This will create C files in ErazorhomeE. =item C<-create> Explicitly creates C file in ErazorhomeE, as well as ErazorhomeE if it does not exist. Normally loads C if it exists, using defaults for anything not found. Does not attempt to register with server, but will do discovery, see C<-discover>. =back =head1 OPTIONS C takes following optional arguments: =over 4 =item C<-h> Print a usage message and exit. =item C<-v> Print the version number and exit. =item C<-d | --verbose> Print debugging information. =item C<-debuglevel=n | -dl=n> Set debug level to 'n'. Default is 3 without C<-d> option, 9 with. =item C<-s> Simulate a check. Do everything except talk to the server. =item C<-conf=filename> Specifies an alternate configuration file. If not specified, it is computed, see razor-agents(1) manpage for details. See razor-agent.conf(5) manpage for various configuration options. The default is CrazorhomeE/razor-agent.conf>. =item C<-home=directory> Specify razorhome directory. This is where the configuration file, logfiles, identities, and server files live. If not specified, it is computed, see razor-agents(1) manpage for details. =item C<-logfile=file> Specify file to log to instead of what is in the configuration file. The default is CrazorhomeE/razor-agent.log>. =item C<-ident=filename> Specify an identify file to use for storing a newly registered identity. If not specified, CrazorhomeE/identity-EuserE> is used. =item C<-rs=razor.server.com> Use this Razor Nomination Server instead of reading C. =item C<-user=user@domain.com> Request to be known as this username. Must be less than 64 chars and may contain A-Z, a-z, 0-9, as well printable chars [ex: - _ @ . + / ]. If not specified, a username will be assigned. Razor users are encouraged to use their email addresses as their username. =item C<-pass=password> Request this password. Valid chars are the same as for -user. If not specified, it will be assigned. =item C<-l> The identity created during this C becomes the default. Normally, the first identity file created by C is the default one used. =back =head1 EXAMPLES =over 4 =item razor-admin -d -create With no global razorhome defined (default) in /etc/razor/razor-agents.conf, creates .razor directory in user's home directory. With global razorhome defined in /etc/razor/razor-agents.conf, will try to use that one, will fail if it does not have correct permissions. =item razor-admin -register Registers a new identity, storing it in razorhome. User and pass will be server generated. An identity is required for razor-report(1) and razor-revoke(1). =item razor-admin -register -user me@a.com Attempts to register a new identity using the user name 'me\@a.com'. Will fail if user is already taken. =item razor-admin -d -create -home=/home/me/.razor Creates .razor directory in user's home directory, which will then be the default home unless specified from cmd-line. Sends debugging information to stdout, and does not talk to any Razor Servers. =item razor-admin -d -create -home=/etc/razor Creates global razorhome, /etc/razor. This is the magic directory that will be consulted if no razorhome is specified on the cmd-line or found in user's home directory. =back =head1 AUTHORS Vipul Ved Prakash Email@vipul.netE, and Chad Norwood Echad@samo.orgE =cut =head1 SEE ALSO razor-agents(1), razor-agent.conf(5), razor-check(1), razor-report(1), razor-revoke(1), razor-whitelist(5) =head1 LICENSE This is free software, distributed under the Artistic License 2.0. razor-agents-2.85/docs/razor-agent.conf.pod0000644000000000000000000001057411041214747015573 0ustar =head1 NAME C - Configuration file for Razor Agents =head1 DESCRIPTION C is a configuration file read by the razor agents, which include razor-check(1), razor-admin(1), razor-report(1), and razor-revoke(1). The format is "attribute = value" pairs, one pair per line. Lines that begin with `#' are treated as comments. =head1 ATTRIBUTES Following attributes can be specified: =over 4 =item B Directory where Razor Agents look for files. All files in C without a full path will be relative to C. The default is C for root, and C<~/.razor/> for every other user. If C does not exist, it will be created. =item B Log file for the Razor Agents. The default is C. =item B Controls the amount of messages written to logfile. It is an integer between 0 and 20. For Example, a value of C<1> logs only startup and error messages, C<5> includes every transaction with the server, and C<14> is extremely verbose information intended for debugging use only. NOTE: C<15> and higher create debug files on your filesystem -- do not use unless you know what you are doing. The default is C<5>. =item B Specify an identify file to use for storing a newly registered identity during razor-admin(1). For razor-report(1) and razor-revoke(1), use this identity when authenticating with Razor Servers. If not specified, CrazorhomeE/identity-EuserE> is used. =item B File where Razor Nomination Servers are listed, in order of closest TCP ping time. Nomination Servers are used by razor-report(1) and razor-revoke(1). This file is created automatically. The default is C. =item B File where Razor Catalogue Servers are listed, in order of closest TCP ping time. Catalogue Servers are used by razor-check(1). This file is created automatically. The default is C. =item B File where Razor Discovery Servers are listed, in random order. This file is created automatically using DNS. The default is C. =item B Max time in seconds Razor Agents will wait before computing a new C using DNS. The default is C<604800>, which is 7 days. =item B Max time in seconds Razor Agents will wait before computing a new C and a new C. The default is C<172800>, which is 2 days. =item B Turns off closest host discovery. When set to 1, C and C will not be updated and C is not read or updated. The default is C<0>. =item B Automatically ignore mailing list posts. If set to C<0>, mailing list posts will be handled like all other mail. The default is C<0>. =item B Name of whitelist file. Razor Agents can consult a whitelist of addresses and SHA1 hashes before checking a mail with Razor Servers. If the address/hash is found on the whitelist, the mail is marked `not spam', without checking against the server. The format of the whitelist can be found in razor-whitelist(5) manpage. The default is C. =item B When checking spam, the server optionally returns a spam confidence value ranging from 0 (not confident) to 100 (absolutely or 100% confident). To be considered spam, the server's spam confidence value must be greater than or equal to C. C can be a number or an expression containing ac, the average confidence published by a Razor Server. Examples: 0, 60, 100, ac, ac + 10, ac - 20. If an expression evaluates to less than 0 it becomes 0, likewise those greater than 100 become 100. The default is C. =item B When reporting spam, the entire email (headers and body) is sent to a Razor Nomination Server. When set to C<0>, all the headers are removed except headers beginning with C before sending, and a special header beginning with C is added to note this action. The default is C<1>. =back =head1 AUTHORS Vipul Ved Prakash, Email@vipul.netE and Chad Norwood Echad@samo.orgE =head1 SEE ALSO razor-agents(1), razor-check(1), razor-admin(1), razor-report(1), razor-revoke(1), razor-whitelist(5) =cut razor-agents-2.85/docs/razor-agents.pod0000644000000000000000000000647111041214747015033 0ustar =head1 NAME Razor-Agents - Collection of files for checking, reporting, and revoking spam =head1 DESCRIPTION Vipul's Razor is a distributed, collaborative, spam detection, reporting, and filtering network. The primary focus of the system is to identify and remove all email spam from the internet. Visit the website at http://razor.sourceforge.net/. =head1 USAGE First a razorhome directory should be created where log, conf, and cached server information will live. This is done via C<-create> option to razor-admin(1). See man page for details. You can immediately check spam using razor-check(1). See man page for details. To report spam, an identity must be registered. This is done via C<-register> option to razor-admin(1). After that, razor-report(1) and razor-revoke(1) will work flawlessly. =head1 CONFIGURATION All Razor-Agents share a configuration file. The contents of the configuration file are detailed in the razor-agent.conf(5) manpage. Config file is computed before razorhome, in the following order: -conf=/path/file.conf used if readable, else /.razor/razor-agent.conf used if readable, else /etc/razor/razor-agent.conf used if readable, else all defaults are used. To see configuration defaults, do razor-admin -create -conf=/tmp/razor2-defaults.conf =head1 RAZORHOME All Razor-Agents also share a razorhome directory, where identity, logging, and cached information about servers is stored. Razorhome is computed after configuration file, in the following order. -home=/tmp/razor/ used if readable, else 'razorhome' from configuration file used if readable, else /.razor/ used if readable, else /.razor/ is created. if that fails, no razorhome. NOTE: If there is no razorhome, razor-report and razor-revoke will not work unless you specify -ident=/path/identity razor-check will still work. =head1 FILES Besides those listed at the end with their own manpages, Razor Agents also has the following files. =over 4 =item B Usually a symlink to identity file containing user+pass. Used by razor-report(1) and razor-revoke(1). =item B Default log file. To change, edit razor-agent.conf(5). =item B Cached list of Razor Servers. If more than one, they are ordered by closest ping time. =item BnameE.lst> Cached info for EnameE server. The C key in this file is compared against the server greeting, and if server's is greater, new cache info is retrieved from the server. =back =head1 EXAMPLES =over 4 =item razor-check -d -debuglevel=9 mbox Checks spam in mbox. prints numbers for those found to be spam. -d logs to stdout, -debuglevel=9 is verbose logging =item razor-admin -create -home=/home/chad/.razor -d -s Creates razorhome in /home/chad/.razor, log to stdout, does not connect to server (-s simulate). =item razor-report spam -debuglevel=0 sends spam to server, with no log msgs. =back =head1 AUTHORS Vipul Ved Prakash, Email@vipul.netE and Chad Norwood Echad@samo.orgE =head1 SEE ALSO razor-agent.conf(5), razor-check(1), razor-admin(1), razor-report(1), razor-revoke(1), razor-whitelist(5) =cut razor-agents-2.85/docs/razor-check.pod0000644000000000000000000001054711041214747014626 0ustar =head1 NAME C - Razor Filtering Agent =head1 SYNOPSIS razor-check [options] [ mail1 [ mail2 .. ] ] $ cat mbox | razor-check $ razor-check ./mbox $ razor-check -d mbox mail.1 mail.2 mail.3 =head1 DESCRIPTION C checks a mail against the distributed Razor Catalogue by communicating with a Razor Catalogue Server. It should be invoked before the mail is delivered or processed by a human. C terminates with exit value C<0> if the signature for the mail is catalogued on the server (spam) or C<1> if the mail is not catalogued by the server (not a spam). C should be invoked against every incoming mail by mail processors (like procmail) or MTAs (like sendmail). An alternate method would be to call C from cron, at regular intervals, to identify and mark spam in queued mailboxes. If C is passed more than one mail, it will check each against the database, printing out the serial number of every mail considered to be spam. C supports mbox-formatted files with 1 or more mails in them as well as files containing a single RFC 822 (non-mbox) mail. More than one file may be present on the command line, can be either a non-mbox or mbox in any order. However, more than one non-mbox mail cannot be read from stdin. =head1 USAGE C is usually run by piping the contents of the mail to it, or by providing the name of the file that contains the mail message to be checked as the last argument. C takes the following arguments: =over 4 =item C<-h> Print a usage message and exit. =item C<-v> Print the version number and exit. =item C<-d | --verbose> Print debugging information. =item C<-debuglevel=n | -dl=n> Set debug level to 'n'. Default is 3 without C<-d> option, 9 with. =item C<-whitelist=file> Specify file to use for whitelisting. Overrides 'whitelist' option in C. =item C<-s> Simulate a check. Do everything except talk to the server. =item C<-conf=filename> Specifies an alternate configuration file. If not specified, it is computed, see razor-agents(1) manpage for details. See razor-agent.conf(5) manpage for various configuration options. The default is CrazorhomeE/razor-agent.conf>. =item C<-home=dir> Specify razorhome directory. This is where the configuration file, logfiles, identities, and server files live. If not specified, it is computed, see razor-agents(1) manpage for details. =item C<-logfile=file> Specify file to log to instead of what is in the configuration file. The default is CrazorhomeE/razor-agent.log>. =item C<-rs=razor.server.com> Use this Razor Catalogue Server instead of reading C. =item C<-H> Compute and print the signature of the mail contents and exit. If C<-e=integer> is not specified, all supported engines will be used. =item C<-S=string> Accept a list of pre-computed (with C<-H>) signatures on the command line, instead of computing one from mail content. Signatures can be submitted in hex or base64, but base64 is preferred. Requires C<-e=integer>. Usage: C =item C<-e=integer> Specify engine used to create signatures. Must be 1, 2, 3, or 4 in this version. Engine 1, or C<-e=1>, is used for Razor 1.x signatures. Used only with C<-S=string> or C<-H>. =item C<-ep4=string> String used by engine 4 when computing signatures. Published by the Razor Catalogue Servers and updated very frequently. Used only when C<-e=4>. =back =head1 RECIPES C is usually invoked from procmail(1). Here are some common ways of using it with procmail: =over 4 =item To change the C header if mail is spam: :0 Wc | razor-check :0 Waf | formail -i "Subject: Razor Warning: SPAM/UBE/UCE" =item To add a C header to spam: :0 Wc | razor-check :0 Waf | formail -A "X-Razor2-Warning: SPAM." =item To file spam in a mailbox :0 Wc | razor-check :0 Wa /home/foo/Mail/razor-caught =back =head1 AUTHORS Vipul Ved Prakash Email@vipul.netE, and Chad Norwood Echad@samo.orgE =cut =head1 SEE ALSO razor-agents(1), razor-agent.conf(5), razor-admin(1), razor-report(1), razor-revoke(1), razor-whitelist(5) =head1 LICENSE This is free software, distributed under the Artistic License 2.0. razor-agents-2.85/docs/razor-report.pod0000644000000000000000000001205611041214747015061 0ustar =head1 NAME C - Razor Reporting Agent =head1 SYNOPSIS razor-report [options] file_with_mail_in_rfc822_format $ cat mail | razor-report $ razor-report ./mail $ razor-report -d ./mail =head1 DESCRIPTION C is the Razor Reporting Agent which is used for reporting spam messages to a Razor Nomination Server. C should be generally called from a MUA, although there are no restrictions on invoking it from the command-line. C is a filter, which means that spam messages should be piped through it. By default, C backgrounds and detaches itself from the control terminal at start-up. If C is passed more than one mail, it will report each against the database. Please use this with caution, we don't want the database filled up with mails incorrectly identified as spam. C supports mbox-formatted files with 1 or more mails in them as well as files containing a single RFC 822 (non-mbox) mail. More than one file may be present on the command line, can be either a non-mbox or mbox in any order. However, more than one non-mbox mail cannot be read from stdin. Both C and razor-revoke(1) require user authentication to work, see razor-admin(1). This allows the Razor Nomination Server to keep track of how many messages a user reports and revokes. The more messages a user correctly reports and/or correctly revokes, the more trust the user earns. Likewise, when messages are incorrectly reported or revoked, the trust goes down for that user. Highly trusted users will have the most affect on the Razor Catalogue. =head1 USAGE C takes following arguments: =over 4 =item C<-h> Print a usage message and exit. =item C<-v> Print the version number and exit. =item C<-d | --verbose> Print debugging information to stdout. =item C<-debuglevel=n | -dl=n> Set debug level to 'n'. Default is 3 without C<-d> option, 9 with. =item C<-whitelist=file> Specify file to use for whitelisting. Overrides 'whitelist' option in C. =item C<-s> Simulate a check. Do everything except talk to the server. =item C<-conf=filename> Specifies an alternate configuration file. If not specified, it is computed, see razor-agents(1) manpage for details. See razor-agent.conf(5) manpage for various configuration options. The default is CrazorhomeE/razor-agent.conf>. =item C<-home=dir> Specify razorhome directory. This is where the configuration file, logfiles, identities, and server files live. If not specified, it is computed, see razor-agents(1) manpage for details. =item C<-logfile=file> Specify file to log to instead of whats in configuration file. The default is CrazorhomeE/razor-agent.log>. =item C<-ident=filename> Specify an identify file to use for authenticating with Razor Servers. If not specified, CrazorhomeE/identity-EuserE> is used. =item C<-rs=razor.server.com> Use this Razor Nomination Server instead of reading C. =item C<-H> Compute and print the signature of the mail contents and exit. If C<-e=integer> is not specified, all supported engines will be used. =item C<-S=string> Accept a list of pre-computed (with C<-H>) signatures on the command line, instead of computing one from mail content. Signatures can be submitted in hex or base64, but base64 is preferred. Requires C<-e=integer>. Usage: razor-report -e 1 -S a8a3d545adb73f9733675571ffeaf10cba87745b =item C<-e=integer> Specify engine used to create signatures. Must be 1, 2, 3, or 4 in this version. Engine 1, or C<-e=1>, is used for Razor 1.x signatures. Used only with C<-S=string> or C<-H>. =item C<-ep4=string> String used by engine 4 when computing signatures. Published by the Razor Nomination Servers and updated very frequently. Used only when C<-e=4>. =item C<-i=filename> Use identity from filename instead of reading ErazorhomeE/identity. Razor Servers compute trust for each unique identity. Razor Agents figure out the identity by a 2 step process. First, check if identity is specified via cmd-line (-i=file). If not there, then look in ErazorhomeE for identity file. If has no identity file, authentication will fail - you cannot report or revoke. See razor-agents.conf(5) for more on ErazorhomeE. ---fixme---- =item C<-a> Authenticate only. If authenticated, exit 0; if not, exit 1. =item C<-f> Stay in foreground, do not detach and run in background. =back =head1 INTEGRATION WITH MUTT Add the following line to C macro index S "|/usr/bin/razor-report" Then press S on the spam message in C to report it with C. Since C forks, the control will return immediately. =head1 AUTHORS Vipul Ved Prakash Email@vipul.netE, and Chad Norwood Echad@samo.orgE =cut =head1 SEE ALSO razor-agents(1), razor-agent.conf(5), razor-check(1), razor-admin(1), razor-revoke(1), razor-whitelist(5) =head1 LICENSE This is free software, distributed under the Artistic License 2.0. razor-agents-2.85/docs/razor-revoke.pod0000644000000000000000000001066511041214747015045 0ustar =head1 NAME C - Razor Revoking Agent =head1 SYNOPSIS razor-revoke [options] file_with_mail_in_rfc822_format $ cat mail | razor-revoke $ razor-revoke ./mail $ razor-revoke -d ./mail =head1 DESCRIPTION C is the Razor Revoking Agent which is used for reporting messages as NOT spam to a Razor Nomination Server. For instance, it can be invoked if a check incorrectly marked a message as spam or after a message was incorrectly reported as spam. C should be generally called from a MUA, although there are no restrictions on invoking it from the command-line. C is a filter, which means that spam messages should be piped through it. By default, C backgrounds and detaches itself from the control terminal at start-up. If C is passed more than one mail, it will revoke each against the database. Please use this with caution, we don't want the database to have inaccurate information. C supports mbox-formatted files with 1 or more mails in them as well as files containing a single RFC 822 (non-mbox) mail. More than one file may be present on the command line, can be either a non-mbox or mbox in any order. However, more than one non-mbox mail cannot be read from stdin. Both razor-report(1) and C require user authentication to work, see razor-admin(1). This allows the Razor Nomination Server to keep track of how many messages a user reports and revokes. The more messages a user correctly reports and/or correctly revokes, the more trust the user earns. Likewise, when messages are incorrectly reported or revoked, the trust goes down for that user. Highly trusted users will have the most affect on the Razor database. Note that even after a successful revoke, a mail might still be considered spam in the Razor Catalogue. For instance, this can occur if more trusted users consider the mail spam than not spam. =head1 USAGE C takes following arguments: =over 4 =item C<-h> Print a usage message and exit. =item C<-v> Print the version number and exit. =item C<-d | --verbose> Print debugging information. =item C<-debuglevel=n | -dl=n> Set debug level to 'n'. Default is 3 without C<-d> option, 9 with. =item C<-whitelist=file> Specify file to use for whitelisting. Overrides 'whitelist' option in C. =item C<-s> Simulate a check. Do everything except talk to the server. =item C<-conf=filename> Specifies an alternate configuration file. If not specified, it is computed, see razor-agents(1) manpage for details. See razor-agent.conf(5) manpage for various configuration options. The default is CrazorhomeE/razor-agent.conf>. =item C<-home=dir> Specify razorhome directory. This is where the configuration file, logfiles, identities, and server files live. If not specified, it is computed, see razor-agents(1) manpage for details. =item C<-logfile=file> Specify file to log to instead of whats in configuration file. The default is CrazorhomeE/razor-agent.log>. =item C<-ident=filename> Specify an identify file to use for authenticating with Razor Servers. If not specified, CrazorhomeE/identity-EuserE> is used. =item C<-rs=razor.server.com> Use this Razor Nomination Server instead of reading C. =item C<-M | --mbox> Accept a mailbox name on the command line and revoke every mail in the mailbox against the database. If in foreground, C<-f>, C will print out the mail number of every mail that was accepted by the Catalogue server. C =item C<-i=filename> Used identity from filename instead of reading ErazorhomeE/identity. =item C<-a> Authenticate only. If authenticated, exit 0; if not, exit 1. =item C<-f> Stay in foreground, do not detach and run in background. =back =head1 INTEGRATION WITH MUTT Add the following line to C macro index R "|/usr/bin/razor-revoke" Then press R on the spam message in C to report it with C. Since C forks, the control will return immediately. =head1 AUTHORS Vipul Ved Prakash Email@vipul.netE, and Chad Norwood Echad@samo.orgE =cut =head1 SEE ALSO razor-agents(1), razor-agent.conf(5), razor-check(1), razor-admin(1), razor-report(1), razor-whitelist(5) =head1 LICENSE This is free software, distributed under the Artistic License 2.0. razor-agents-2.85/docs/razor-whitelist.pod0000644000000000000000000000326711041214747015566 0ustar =head1 NAME C - Format for Vipul's Razor Whitelist =head1 DESCRIPTION The razor whitelist is a list of email addresses and body signatures. Emails that match the whitelist are not processed by any of the Razor Agents. That is, They are not checked, reported, or revoked. In the case of razor-check(1), they are instantly marked as non-spam. =head1 LOCATION The razor whitelist is usually CrazorhomeE/razor-whitelist>. The C parameter in razor-agent.conf(5) should point to this file. If the C parameter in razor-agent.conf(5) is missing, C is not used. =head1 FORMAT Each whitelist rule is placed on a line of its own. Lines that begin in a `#' character are considered to be comments and are ignored by the parser. A rule contains the name of a header and the string to match against the header, separated by whitespace. Here are some examples: to bugtraq@securityfocus.com cc a.list@somewhere.net These rules imply that when a mail contains C in its `to' and `cc' headers, it should be whitelisted. It's worth noting that a match occurs if the address string matches any part of the address. from @mydomain.com A special rule called `sha1' can be used for whitelisting signatures. For example: sha1 75f8bcc2357366bbfa9c6ab0b6e5648ed0cf7083 whitelists a message with the body of `test'. =head1 AUTHORS Vipul Ved Prakash Email@vipul.netE, and Chad Norwood Echad@samo.orgE =cut =head1 SEE ALSO razor-agents(1), razor-agent.conf(5), razor-check(1), razor-admin(1), razor-report(1), razor-revoke(1) =head1 LICENSE This is free software, distributed under the Artistic License 2.0. =cut razor-agents-2.85/lib/0000755000000000000000000000000010625104016011513 5ustar razor-agents-2.85/lib/Razor2/0000755000000000000000000000000010625104016012672 5ustar razor-agents-2.85/lib/Razor2/Client/0000755000000000000000000000000010625104016014110 5ustar razor-agents-2.85/lib/Razor2/Client/Agent.pm0000644000000000000000000007771610515343154015534 0ustar #!/usr/bin/perl -sw ## ## Razor2::Client::Agent -- UI routines for razor agents. ## ## Copyright (c) 2002, Vipul Ved Prakash. All rights reserved. ## This code is free software; you can redistribute it and/or modify ## it under the same terms as Perl itself. ## ## $Id: Agent.pm,v 1.98 2006/10/18 06:15:08 rsoderberg Exp $ package Razor2::Client::Agent; use lib qw(lib); use strict; use Getopt::Long; use IO::File; use Razor2::String qw(fisher_yates_shuffle); use base qw(Razor2::Client::Core); use base qw(Razor2::Client::Config); use base qw(Razor2::Logger); use base qw(Razor2::String); use Razor2::Preproc::Manager; use Data::Dumper; use vars qw( $VERSION $PROTOCOL ); $PROTOCOL = $Razor2::Client::Version::PROTOCOL; $VERSION = $Razor2::Client::Version::VERSION; sub new { my ($class, $breed) = @_; # For Taint Friendliness delete $ENV{PATH}; delete $ENV{BASH_ENV}; my @valid_program_names = qw( razor-check razor-report razor-revoke razor-admin ); my $ok = 0; foreach (@valid_program_names) { $breed =~ /$_$/ and $ok = $_; } unless ($ok) { if ($breed =~ /razor-client$/) { # We no longer create symlinks, but for backwards compatibility # return success. exit 0; } die "Invalid program name, must be one of: @valid_program_names\n"; } $ok =~ /razor-(.*)$/; my %me = ( name_version => "Razor-Agents v$VERSION", # used in register breed => $1, preproc => new Razor2::Preproc::Manager (no_deHTMLcomment => 1), preproc_vr8 => new Razor2::Preproc::Manager (no_deHTML => 1), global_razorhome => '/etc/razor', ); return bless \%me, $class; } sub do_conf { my $self = shift; # parse config-related cmd-line args # # identity is parsed later after razorhome is fully resolved if ($self->{opt}->{config}) { if ($self->{opt}->{create_conf}) { $self->{razorconf} = $self->{opt}->{config}; } elsif (-r $self->{opt}->{config}) { $self->{razorconf} = $self->{opt}->{config}; } else { return $self->error("Can't read conf file: $self->{opt}->{config}") } } if ($self->{opt}->{razorhome}) { if (-d $self->{opt}->{razorhome}) { $self->{razorhome} = $self->{opt}->{razorhome}; } else { return $self->error("Can't read: $self->{opt}->{razorhome}") unless $self->{opt}->{create_conf}; } # once razorhome is successfully overridden, override the global razorhome as well. $self->{global_razorhome} = $self->{razorhome}; } return unless $self->read_conf(); if ($self->{opt}->{create_conf}) { $self->{force_discovery} = 1; $self->{force_bootstrap_discovery} = 1; $self->log(8," -create will force complete discovery"); } if ($self->{opt}->{force_discovery}) { $self->{force_discovery} = 1; $self->{force_bootstrap_discovery} = 1; $self->log(8," -discover will force complete discovery"); } if ($self->{opt}->{debug} && !$self->{opt}->{debuglevel}) { $self->{conf}->{debuglevel} ||= 9; $self->{conf}->{debuglevel} = 9 if $self->{conf}->{debuglevel} < 9; } # # Note: we start logging before we process '-create' , # so logfile will not go into a newly created razorhome # #my $logto = $self->{opt}->{debug} ? "stdout" : "file:$self->{conf}->{logfile}"; my $logto; if ($self->{opt}->{debug}) { $logto = 'stdout'; } elsif ($self->{conf}->{logfile} eq 'syslog') { $logto = 'syslog'; } elsif ($self->{conf}->{logfile} eq 'sys-syslog') { $logto = 'sys-syslog'; } else { $logto = "file:$self->{conf}->{logfile}"; } if (exists $self->{conf}->{logfile}) { my $debuglevel = exists $self->{conf}->{debuglevel} ? $self->{conf}->{debuglevel} : 9; my $logger = new Razor2::Logger ( LogDebugLevel => $debuglevel, LogTo => $logto, LogPrefix => $self->{breed}, LogTimestamp => 1, DontDie => 1, Log2FileDir => defined($self->{conf}->{tmp_dir}) ? $self->{conf}->{tmp_dir} : "/tmp", ); $self->{logref} = ref($logger) ? $logger : 0; # log error strings at loglevel 11. Pick a high number 'cuz # if its really an error, it will be in errstr for caller $self->{logerrors} = 11; } $self->logobj(15,"cmd-line options", $self->{opt}); $self->{preproc}->{rm}->{log} = $self->{logref}; # creates razorhome, and sets $self->{razorhome} if successful return $self->errprefix("Could not create 'razorhome'") unless $self->create_home_conf(); $self->compute_identity; $self->log(5,"computed razorhome=$self->{razorhome}, conf=$self->{razorconf}, ident=$self->{identity}"); return 1; } # if a debug log statement requires extra work, check this call before doing it. sub logll { my ($self, $loglevel) = @_; return unless $self->{logref}; return 1 if ($self->{logref}->{LogDebugLevel} >= $loglevel); return; } sub create_home_conf { my $self = shift; unless ($self->{opt}->{create_conf}) { # # if the global razorhome exists, don't create anything # without '-create' option # return 1 if (-d $self->{global_razorhome}); # # if there is not global razorhome, # try to create razorhome one anyway. # if it fails, thats ok. # $self->create_home($self->{razorhome_computed}); $self->errstrrst; # nuke error string return 1; } # # user passed in 'create' option, so create. # my $rhome = $self->{opt}->{razorhome} ? $self->{opt}->{razorhome} : $self->{razorhome_computed}; if ($rhome) { if (-d $rhome) { $self->log(6,"Not creating razorhome $rhome, already exists"); } else { return unless $self->create_home($rhome); } } if ($self->{opt}->{config}) { # if create and conf specified, exit if write is not successful # $self->{razorconf} = $self->{opt}->{config}; return $self->write_conf(); } else { # else just try and create, if fail ok. # $self->compute_razorconf(); $self->{razorconf} ||= $self->{computed_razorconf}; $self->write_conf(); $self->errstrrst; # nuke error string } return 1; } # wrapper for log sub log { my $self = shift; my $level = shift; my $msg = shift; if ($self->{logref}) { return $self->{logref}->log($level, $msg); } elsif ($self->{opt}->{debug}) { print " Razor-Log: $msg\n" if $self->{opt}->{debug}; } } sub log2file { my $self = shift; return unless $self->{logref}; return $self->{logref}->log2file(@_); } sub doit { my $self = shift; my $args = shift; my $r; $self->log(2," $self->{name_version} starting razor-$self->{breed} $self->{args}"); # $self->log(9,"uname -a: ". `uname -a`) if $self->logll(9); $r = $self->checkit($args) if $self->{breed} eq 'check'; $r = $self->adminit($args) if $self->{breed} eq 'admin'; $r = $self->reportit($args) if $self->{breed} eq 'report'; $r = $self->reportit($args) if $self->{breed} eq 'revoke'; # return exit code # 0, 1 => ok # > 1 => error (caller should prolly print $self->errstr) # if ($r > 1) { my $msg = $self->errstr; $self->log(1,"razor-$self->{breed} error: ". $msg); } else { $self->log(8,"razor-$self->{breed} finished successfully."); } return $r; } sub _help { my ($self,$breed) = @_; chomp(my $all = </razor.conf -home=dir Use this as razorhome -ident=file Use this identity file instead of /identity -rs Use this razor server instead of reading .lst EOFALL chomp(my $sigs = <{breed}}; } # maybe this should be in Client::Config # sub read_options { my ($self, $agent) = @_; $self->{args} = join ' ', @ARGV; Getopt::Long::Configure ("no_ignore_case"); my %opt; # # These options override what is loaded in config file # the names on the right should match keys in config file # my $ret = GetOptions( 's' => \$opt{simulate}, 'd' => \$opt{debug}, 'verbose' => \$opt{debug}, 'v' => \$opt{version}, 'h' => \$opt{usage}, 'help' => \$opt{usage}, 'H' => \$opt{printhash}, 'C=s' => \$opt{printcleaned}, 'sig=s' => \$opt{sig}, 'S=s' => \$opt{sig}, 'e=s' => \$opt{sigengine}, 'ep4=s' => \$opt{sigep4}, 'mbox' => \$opt{mbox}, 'M' => \$opt{mbox}, 'n' => \$opt{negative}, 'conf=s' => \$opt{config}, 'config=s' => \$opt{config}, 'home=s' => \$opt{razorhome}, 'f' => \$opt{foreground}, 'noml' => \$opt{noml}, 'user=s' => \$opt{user}, 'u=s' => \$opt{user}, 'pass=s' => \$opt{pass}, 'a' => \$opt{authen_only}, 'rs=s' => \$opt{server}, 'server=s' => \$opt{server}, 'r' => \$opt{register}, 'register' => \$opt{register}, 'l' => \$opt{symlink}, 'i=s' => \$opt{identity}, 'ident=s' => \$opt{identity}, 'create' => \$opt{create_conf}, 'logfile=s' => \$opt{logfile}, 'discover' => \$opt{force_discovery}, 'dl=s' => \$opt{debuglevel}, 'debuglevel=s' => \$opt{debuglevel}, 'whitelist=s' => \$opt{whitelist}, 'lm=s' => \$opt{logic_method}, 'le=s' => \$opt{logic_engines}, ); if ($ret == 0) { $self->error("failed to parse command line options.\n"); return; } # remove elements not set in the cmd-line foreach (keys %opt) { delete $opt{$_} unless defined $opt{$_}; } if ($opt{usage}) { $self->error($self->_help); return; } elsif ($opt{mbox} && $opt{sig}) { $self->error("--mbox and --sig are mutually exclusive.\n"); return; } elsif ($opt{sig} && !$opt{sigengine}) { $self->error("--sig requires -e (engine used to generate sig)\n"); return; # # fixme - require ep4 if -e 4 is used ? # } elsif ($opt{version}) { $self->error("Razor Agents $VERSION, protocol version $PROTOCOL"); return; } $self->{opt} = \%opt; return 1; } # returns 0 if match (spam) # returns 1 if no match (legit) # returns 2 if error sub checkit { my $self = shift; my $args = shift; # check for spam. # input can be one of # file - single mail # mbox - many mail # sig - 1 or more sigs # or a filehandle provided via args my $objects; if ($self->{conf}->{sig}) { my @sigs; # # cmd-line sigs # # prepare 1 mail object per sig # foreach my $sig (split ',', $self->{conf}->{sig}) { $sig =~ s/^\s*//; $sig =~ s/\s*$//; my $hr = { eng => $self->{conf}->{sigengine}, sig => $sig, }; $hr->{ep4} = "7542-10"; $hr->{ep4} = $self->{conf}->{sigep4} if $self->{conf}->{sigep4}; push @sigs, $hr; } $self->log (5,"received ". (scalar @sigs) ." valid cmd-line sigs."); $objects = $self->prepare_objects(\@sigs) or return 2; } else { my $mails = $self->parse_mbox($args) or return 2; $objects = $self->prepare_objects($mails) or return 2; # # if mail is whitelisted, its not spam. # flag it so it we don't check it against server # foreach my $obj (@$objects) { if ($self->local_check($obj)) { $obj->{skipme} = 1; $obj->{spam} = 0; } else { next; } } } # compute_sigs needs server info like ep4, so get_server_info first $self->get_server_info() or return 2; my $printable_sigs = $self->compute_sigs($objects) or return 2; if ($self->{opt}->{printhash}) { my $i = 0; foreach (@$printable_sigs) { if ($self->{opt}->{sigengine}) { next unless (/ e$self->{opt}->{sigengine}: /); } print "$_\n"; $i++; } $self->log (4, "Done. Printed $i sig(s) for ". scalar(@$objects) ." mail(s)"); } if ($self->{opt}->{printcleaned}) { my $totalp = 0; my $totalc = 0; foreach my $obj (@$objects) { my $n = 0; mkdir("$self->{opt}->{printcleaned}/cleaned"); foreach ($obj->{headers}, @{$obj->{bodyparts_cleaned}}) { my $fn = "$self->{opt}->{printcleaned}/cleaned/mail$obj->{id}.". $n++; $self->write_file($fn, $_); $totalc++; } $n = 0; mkdir("$self->{opt}->{printcleaned}/uncleaned"); foreach ($obj->{headers}, @{$obj->{bodyparts}}) { my $fn = "$self->{opt}->{printcleaned}/uncleaned/mail$obj->{id}.". $n++; $self->write_file($fn, $_); $totalp++; } } $self->log (4, "Done. $totalp uncleaned, $totalc cleaned mails saved in $self->{opt}->{printcleaned}"); print "Done. $totalp uncleaned, $totalc cleaned mails saved in $self->{opt}->{printcleaned}\n"; return 1; } return 1 if $self->{opt}->{printhash}; # only check good objects my @goodones; # this should be optimized! foreach my $obj (@$objects) { next if $obj->{skipme}; push @goodones, $obj; } unless (scalar @goodones) { $self->log (4,"Done. No valid mail or signatures to check."); return 1; } if ($self->{conf}->{simulate}) { $self->log (4, "Done. (simulate only)"); return 1; } # # Connect to catalogue server # $self->{s}->{list} = $self->{s}->{catalogue}; $self->nextserver(); $self->connect() or return 2; # # Check against server # $self->check (\@goodones) or return 2; $self->disconnect() or return 2; # # print out responses and exit # my $only1check = (scalar(@$objects) == 1) ? 1 : 0; my $has_spam = 0; foreach my $obj (@$objects) { $obj->{spam} = 0 if $obj->{skipme}; $obj->{spam} = 0 unless defined $obj->{spam}; if ($obj->{spam} > 0) { return 0 if $only1check; $has_spam = 1; print $obj->{id} ."\n"; next; } elsif ($obj->{spam} == 0) { return 1 if $only1check; print "-". $obj->{id} ."\n" if $self->{conf}->{negative}; next; } else { # error # $self->logobj(1,"bad 'spam' in checkit", $obj); return 2 if $only1check; print "-". $obj->{id} ."\n" if $self->{conf}->{negative}; next; } } return 0 if $has_spam; return 1; } # returns 0 if success # returns 2 if error sub adminit { my $self = shift; my $done_something = 0; if ($self->{opt}->{create_conf}) { $done_something++; # $self->create_home_conf() is always checked } if ( $self->{opt}->{force_discovery} || $self->{opt}->{create_conf}) { $done_something++; # get_server_info() calls nextserver() which calls discovery() $self->get_server_info() or return 2; } if ($self->{opt}->{register}) { $done_something++; my $r = $self->registerit(); return $r if $r; } unless ($done_something) { $self->error("An option needs to be specified, -h for help."); return 2; } return 0; } # returns 0 if success # returns 2 if error sub registerit { my($self, $auto) = @_; unless ($self->{razorhome} || $self->{opt}->{identity}) { $self->errprefix("Unable to register without a valid razorhome or identity"); return 2; } my $ident; if (exists $self->{opt}->{user} && ($ident = $self->get_ident) && $ident->{user} eq $self->{opt}->{user} ) { $self->error("You are already registered as user=$ident->{user} in $self->{razorhome}"); return 2; } if ($self->{conf}->{simulate}) { $self->log(5,"Done - simulate only."); return 0; } if ($self->{opt}->{create_conf}) { $self->log(3, "Register create successful."); return 0; } if ($auto) { $self->log(3, "Write test underway"); my($ident) = { user => 'writetest', pass => 'writetest', }; my($fn); unless ($fn = $self->save_ident($ident)) { $self->log(3, "Unable to write identity to home"); return 2; } unlink($fn) or return 2; $self->log(3, "Write test completed"); } $self->get_server_info() or return 2; $self->connect() or return 2; $self->log(3, "Attempting to register."); # attempt to register the user/pass $ident = $self->register_identity($self->{opt}->{user}, $self->{opt}->{pass}); $self->disconnect() or return 2; unless (ref $ident) { $self->log(3, "Failed to register identity."); return 2; } if (my $fn = $self->save_ident($ident)) { my $msg = "Register successful. Identity stored in $fn"; $self->log(3, $msg); print "$msg\n"; return 0; } else { $self->log(3, "Register failed."); return 2; } } # # handles report and revoke # # returns 0 if success # returns 2 if error sub reportit { my ($self, $args) = @_; my $ident = $self->get_ident; unless ($ident) { $self->log(3, "Razor2 identity not found. Attempting to register automatically."); if ($self->registerit("auto")) { $self->log(3, "Automatic registration failed."); $self->errprefix("Bootstrap Error: Your Razor2 identity was not found.\n " . " If you haven't registered, please do so:\n" . " \"razor-admin -register -user=[name/email_address] -pass=[password]\".\n". " (Further information can be found in the razor-admin(1) manpage)\n" . " If you did register, please ensure your identity symlink (or file) is in order.\n"); return 2; } $ident = $self->get_ident; unless ($ident) { $self->log(3, "Unable to load automatically registered identity."); $self->errprefix("Bootstrap Error: Your Razor2 identity was not found.\n " . " If you haven't registered, please do so:\n" . " \"razor-admin -register -user=[name/email_address] -pass=[password]\".\n". " (Further information can be found in the razor-admin(1) manpage)\n" . " If you did register, please ensure your identity symlink (or file) is in order.\n"); return 2; } } if (!$self->{opt}{foreground} && (@ARGV < 1 || $ARGV[0] eq "-" || $ARGV[0] eq "")) { if (-t STDIN) { $self->error("Unable to read from a TTY using STDIN while forked. \n" . "Doing so leads to undefined behaviour in certain shells."); return 2; } } # background myself unless ($self->{opt}->{foreground}) { chdir '/'; fork && return 0; POSIX::setsid; # close 0, 1, 2; } if ($self->{opt}->{authen_only}) { $self->authenticate($ident) or return; $self->log(5,"Done - authenticate only."); return 0 if $self->{authenticated}; return 2; } my $mails = $self->parse_mbox($args) or return 2; my $objects = $self->prepare_objects($mails) or return 2; # compute_sigs needs server info like ep4, so get_server_info first $self->get_server_info() or return 2; my $printable_sigs = $self->compute_sigs($objects) or return 2; if ($self->{opt}->{printhash}) { foreach (@$printable_sigs) { if ($self->{opt}->{sigengine}) { next unless (/ e$self->{opt}->{sigengine}: /); } print "$_\n"; } exit 0; } if ( $self->{conf}->{simulate}) { $self->log (4, "Done. (simulate only)"); exit 0; } unless (scalar @$objects) { $self->log (4,"Done. No valid mail or signatures to check."); exit 1; } $self->{s}->{list} = $self->{s}->{nomination}; $self->nextserver(); $self->connect() or return 2; $self->authenticate($ident) or return 2; $self->report($objects) or return 2; $self->disconnect() or return 2; if ($self->{opt}->{foreground}) { foreach my $obj (@$objects) { # my $line = debugobj($obj->{r}); # $line =~ /(\S+=\S+)/s; # could be res=0|1, err=xxx # print "$obj->{id}: $1\n"; #print "$obj->{id}\n" if $obj->{r}->{res} == '1'; } } return 0; } sub parse_mbox { my ($self, $args) = @_; my @mails; my @message; my $passed_fh = 0; my $aref; # There are different kinds of mbox formats, we just split on simplest case. # djb defines mbox, mboxrd, mboxcl, mboxcl2 # http://www.qmail.org/qmail-manual-html/man5/mbox.html # # non-mbox support added, thanx to Aaron Hopkins if (exists $$args{"fh"}) { @ARGV = (); push @ARGV, $$args{'fh'}; $passed_fh = 1; } elsif (exists $$args{"aref"}) { $aref = $$args{"aref"}; } elsif (!scalar @ARGV) { push @ARGV, "-" } if ($$args{'aref'}) { my @foo = (\join'', @{$$args{'aref'}}); return \@foo; } foreach my $file (@ARGV) { my $fh = new IO::File; my @message = (); if (ref $file) { $fh = $file } else { open $fh, "<$file" or return $self->error("Can't open $file: $!"); } my $line = <$fh>; next unless $line; if ($line =~ /^From /) { $self->log(8,"reading mbox formatted mail from ". ($file eq '-' ? "" : $file)); while (1) { push @message, $line; $line = <$fh>; if (!defined($line) || $line =~ /^From /) { push @mails, \join ('', @message); @message = (); last unless defined $line; } } } else { $self->log(8,"reading straight RFC822 mail from ". ($file eq '-' ? "" : $file)); push @mails, \join ('', map {s/^(>*From )/>$1/; $_} $line, <$fh>); } close $fh unless $passed_fh; } my $cnt = scalar @mails; $self->log (6, "read $cnt mail". ($cnt>1 ? 's' : '') ); return \@mails; } sub raise_error { my ($self, $errstr) = @_;; my $str; if (ref $self) { $str = $self->errstr; } $str = $errstr if $errstr; my ($code) = $str =~ /Razor Error (\d+):/; $code = 255 unless $code; print "FATAL: $str"; exit $code; } # returns 1 if mail should be skipped # sub local_check { my ($self, $obj) = @_; my ($headers, $body) = split /\n\r*\n/, ${$obj->{orig_mail}}, 2; $headers =~ s/\n\s+//sg; # merge multi-line headers if ($self->{conf}->{ignorelist}) { if ($headers =~ /\n((X-)?List-Id[^\n]+)/i) { my $listid = $1; my ($line1) = substr(${$obj->{orig_mail}}, 0, 50) =~ /^([^\n]+)/; $self->log (5,"Mailing List post; mail ". $obj->{id} ." not spam."); #$self->log (5,"Mailing List post; mail ". $obj->{id} ." not spam.\n $line1\n $listid"); return 1; } } return 0 if $self->{no_whitelist}; if (-s $self->{conf}->{whitelist}) { $self->read_whitelist; foreach my $sh (keys %{$self->{whitelist}}) { if ($sh ne 'sha1') { while ($headers =~ /^$sh:\s+(.*)$/img) { last unless $1; my $fc = $1; $self->log (13,"whitelist checking headers for match $sh: $fc"); foreach my $address (@{$self->{whitelist}->{$sh}}) { if ($fc =~ /$address/i) { $self->log (3,"ignoring mail $obj->{id}, whitelisted by rule: $sh: $address"); return 1; } } } } } $self->log (12,"Whitelist rules did not match mail $obj->{id}"); } elsif ($self->{conf}->{whitelist}) { $self->log (6,"skipping whitelist file (empty?): $self->{conf}->{whitelist}"); $self->{no_whitelist} = 1; } return 0; } sub read_whitelist { my ($self) = @_; return if $self->{whitelist}; my %whitelist; my $lines = $self->read_file($self->{conf}->{whitelist},0,1); for (@$lines) { s/^\s*//; next if /^#/; chomp; my ($type, $value) = split /\s+/, $_, 2; $type =~ y/A-Z/a-z/ if $type; push @{$whitelist{$type}}, $value if ($type && $value); } $self->{whitelist} = \%whitelist; $self->log (8,"loaded ". scalar(keys %whitelist) ." different types of whitelist"); #$self->logobj (15,"loaded whitelist:", \%whitelist); return 1; } sub logerr { my ($self,$msg) = @_; $msg = $self->errstr unless $msg; $self->log(1,"$self->{breed} error: ". $msg); return; } # see nextserver() for explanation of how data is stored # sub get_server_info { my $self = shift; unless (exists $self->{s}) { $self->{s} = {}; } if ($self->{opt}->{server}) { # cmd-line $self->{s}->{list} = [$self->{opt}->{server}]; $self->log(8,"Using cmd-line server ($self->{opt}->{server}), skipping .lst files"); } else { $self->readservers; } $self->loadservercache; #$self->logobj(6,"find_closest_server server info (before nextserver)", $self->{s}); $self->{loaded_servers} = 1; return $self->nextserver; # this will connect and get state info if not cached } # see nextserver() for explanation of how data is stored # sub readservers { my $self = shift; unless (exists $self->{s}) { $self->{s} = {}; } # read .lst files foreach my $lf (qw(discovery nomination catalogue)) { my $h = $self->read_file($self->{conf}->{"listfile_$lf"},0,1) or next; $self->{s}->{$lf} = []; foreach (@$h) { push @{$self->{s}->{$lf}}, $1 if /^(([^\.\s]+\.)+[^\.\s]+(:\S+)?)/; } if (defined($self->{s}->{$lf}) && ref($self->{s}->{$lf})) { $self->log(11,"Read ". scalar(@{$self->{s}->{$lf}}) ." from server listfile: ". $self->{conf}->{"listfile_$lf"}); } } foreach my $lf (qw(discovery nomination catalogue)) { next unless defined($self->{s}->{$lf}); next unless ref($self->{s}->{$lf}); next unless @{$self->{s}->{$lf}} > 1; fisher_yates_shuffle($self->{s}->{$lf}); } if ($self->{breed} =~ /^check/) { $self->{s}->{list} = $self->{s}->{catalogue}; $self->{s}->{listfile} = $self->{conf}->{listfile_catalogue}; # for discovery() } else { $self->{s}->{list} = $self->{s}->{nomination}; $self->{s}->{listfile} = $self->{conf}->{listfile_nomination}; # for discovery() } } sub loadservercache { my $self = shift; # # Read in server-specific config, using defaults for stuff not found # # NOTE: this reads all server.*.conf files in razor home, not just those in .lst # # load defaults for .lst servers foreach (qw(nomination catalogue)) { next unless $self->{s}->{$_}; foreach my $server (@{$self->{s}->{$_}}) { next if $self->{s}->{allconfs}->{$server}; # avoid repeats $self->{s}->{allconfs}->{$server} = $self->default_server_conf(); $self->log(9,"Assigning defaults to $server"); } } my @fns; my $sep = '\.'; $sep = '_' if $^O eq 'VMS'; if (opendir D,$self->{razorhome}) { @fns = map {s/_/./g; "$self->{razorhome}/$_";} grep /^server$sep[\S]+\.conf$/, readdir D; @fns = map { /^(\S+)$/, $1 } @fns; # untaint closedir D; } foreach (@fns) { /server\.(.+)\.conf$/ and my $sn = $1; next unless $sn; $self->{s}->{allconfs}->{$sn} = $self->read_file($_, $self->{s}->{allconfs}->{$sn} ); if ($self->{s}->{allconfs}->{$sn}) { #$self->log(8,"Loaded server specific conf info for $sn"); } else { $self->log(5,"loadservercache skipping $_"); } } return $self; } sub writeservers { my $self = shift; unless ($self->{razorhome}) { $self->log(5,"no razorhome, not caching server info to disk"); return; } foreach (@{$self->{s}->{modified_lst}}) { my $fn = $self->{conf}->{"listfile_$_"}; $self->write_file($fn, $self->{s}->{$_}, 0, 0, 1) || $self->log(5,"writeservers skipping .lst file: $fn"); } $self->log(11,"No bootstrap_discovery (DNS) recently, not recording .lst files") unless scalar (@{$self->{s}->{modified_lst}}); $self->{s}->{modified_lst} = []; foreach (@{$self->{s}->{modified}}) { my $fn = "$self->{razorhome}/server.$_.conf"; my $header = "#\n# Autogenerated by $self->{name_version}, ". localtime() ."\n"; $self->write_file($fn, $self->{s}->{allconfs}->{$_}, 0, $header) || $self->debug("writeservers skipping $fn"); } $self->{s}->{modified} = []; $self->errstrrst; # nuke error string if write errors return $self; } 1; razor-agents-2.85/lib/Razor2/Client/Config.pm0000644000000000000000000004104510625102527015664 0ustar #!/usr/bin/perl -s ## ## Razor2::Client:Config ## ## Copyright (c) 2002, Vipul Ved Prakash. All rights reserved. ## This code is free software; you can redistribute it and/or modify ## it under the same terms as Perl itself. ## ## $Id: Config.pm,v 1.66 2007/05/10 20:32:10 rsoderberg Exp $ package Razor2::Client::Config; use strict; use Data::Dumper; use vars qw( $VERSION ); use File::Copy; use File::Spec; use Razor2::Logger; #use base qw(Razor2::Logger); sub new { my ($class) = @_; return bless {}, $class; } # # figures out razorhome and razorconf file # sub read_conf { my ($self,$params) = @_; my $default_conf_fn = "$self->{global_razorhome}/razor-agent.conf"; my $conf; my $defaults = $self->default_agent_conf(); my $use_engines = $defaults->{use_engines}; if ($self->{razorconf}) { # # cmd-line config file specified # $conf = $self->read_file($self->{razorconf},$defaults) unless ($self->{opt}->{create} && $self->{opt}->{config}); if ($self->{opt}->{razorhome}) { $self->{computed_razorhome} = $self->{razorhome} = $self->{opt}->{razorhome}; } else { $self->find_home($self->{opt}->{razorhome} || $conf->{razorhome}); } } else { $self->compute_razorconf(); if ($self->{razorconf}) { $conf = $self->read_file($self->{razorconf},$defaults); } else { $self->log(6, "No razor-agent.conf found, using defaults. "); $conf = $defaults; } } foreach (keys %{$defaults}) { next if exists $conf->{$_}; $conf->{$_} = $defaults->{$_}; } # Override use_engines from defaults. To store use_engines # in the config file is a design flaw, since the client # supported engines are defined by the razor-agents source, # and could potentially be incorrect in the config file # after an upgrade. $conf->{use_engines} = $use_engines; foreach (keys %{$self->{opt}}) { next if ($_ eq '' || $_ eq 'use_engines' || $_ eq 'razorzone'); $conf->{$_} = $self->{opt}->{$_}; } if ($params) { foreach (keys %$params) { next if ($_ eq '' || $_ eq 'use_engines' || $_ eq 'razorzone'); $conf->{$_} = $params->{$_}; } } $self->{conf} = $conf; # # post config processing # insert things that should not be in conf here # # turn off run-time warnings unless debug flag passed # http://www.perldoc.com/perl5.6.1/pod/perllexwarn.html $^W = 0 unless $conf->{debug}; # add full path to all config values that need them # if ($self->{razorhome}) { foreach (qw( logfile pidfile listfile_catalogue listfile_nomination listfile_discovery whitelist identity)) { next unless $conf->{$_}; next if $conf->{$_} =~ /^\//; next if ($_ eq 'logfile' && ($conf->{$_} eq 'syslog' || $conf->{$_} eq 'sys-syslog')); $conf->{$_} = "$self->{razorhome}/$conf->{$_}"; } } return $self->{conf}; } # # Figure out which conf to use - user's own, or system conf. # # If no user conf or no system conf, razorconf will be blank # but computed_razorconf will be set. # # However, if razorhome is still unknown, computed_razorconf can be blank # sub compute_razorconf { my $self = shift; my $default_conf_fn = "$self->{global_razorhome}/razor-agent.conf"; $self->{razorconf} = ""; $self->find_home(); if ($self->{razorhome}) { my $mycf = "$self->{razorhome}/razor-agent.conf"; $self->{computed_razorconf} = $mycf; if (-r $mycf) { $self->{razorconf} = $mycf; } elsif (-e $mycf) { $self->log(5, "Found but can't read $mycf, skipping."); } else { $self->log(5, "No $mycf found, skipping."); } } if (!$self->{razorconf} && -e $default_conf_fn) { if (-r $default_conf_fn) { $self->{razorconf} = $default_conf_fn; } else { $self->log(5, "Found but can't read $default_conf_fn, skipping."); $self->{computed_razorconf} ||= $default_conf_fn; } } } sub write_conf { my ($self,$hash) = @_; unless ($self->{razorconf}) { $self->log(5,"Cannot write_conf without razorconf set"); return $self->error("Cannot write_conf without razorconf set"); } my $now = localtime(); my $srcmsg; unless ($hash) { $hash = $self->default_agent_conf(); if (-r $self->{razorconf}) { $hash = $self->read_file( $self->{razorconf}, $hash); $srcmsg = "Non-default values taken from $self->{razorconf}"; } else { $srcmsg = "Created with all default values"; } } my $clientheader = <{name_version} # $now # $srcmsg # # see razor-agent.conf(5) man page # EOFCLIENT return $self->write_file($self->{razorconf}, $hash, 0, $clientheader); } sub find_user { my $self = shift; return 1 if $self->{user}; $self->{user} = getpwuid($>) || do { $self->log(1, "Can't figure out who the effective user is: $!"); return undef; }; return 1; } # compute razorhome. like so: # # -home=/tmp/razor/ used if readable, else # 'razorhome' from config file used if readable, else # /.razor/ used if readable, else # /.razor/ is created. if that fails, no razorhome. # -conf=/foo/razor/razor.conf if all else fails pick it up from the config file path, # if one is available sub find_home { my ($self,$rhome) = @_; my $dotrazor = '.razor'; $dotrazor = '_razor' if $^O eq 'VMS'; if (defined $self->{razorhome}) { $self->{razorhome_computed} = $self->{razorhome}; return 1; } if (defined $self->{opt}->{razorhome}) { $self->{razorhome_computed} = $self->{razorhome}; return 1; } # if razorhome is read from config file, its passed as rhome unless ($rhome) { if (defined $ENV{HOME}) { $rhome = File::Spec->catdir("$ENV{HOME}", "$dotrazor"); } else { return unless $self->find_user(); $rhome = File::Spec->catdir((getpwnam($self->{user}))[7], "$dotrazor") || "/home/$self->{user}/$dotrazor"; } $rhome = VMS::Filespec::unixify($rhome) if $^O eq 'VMS'; $self->log(8,"Computed razorhome from env: $rhome"); } $self->{razorhome_computed} = $rhome; if (-d $rhome) { if (-w $rhome) { $self->log(6,"Found razorhome: $rhome"); } else { $self->log(6,"Found razorhome: $rhome, however, can't write to it."); } $self->{razorhome} = $rhome; return 1; } if ($self->{razorconf}) { my $path = $$self{razorconf}; if ($path =~ m:/:) { if ($path =~ m:(.*)/:) { $self->{razorhome} = $1; return 1; } } } $self->log(5,"No razorhome found, using all defaults"); $self->{razorhome} = ""; return 1; } sub create_home { my ($self,$rhome) = @_; if (-d $rhome) { $self->{razorhome} = $rhome; return 1; } if (mkdir $rhome, 0755) { $self->log(6,"Created razorhome: $rhome"); $self->{razorhome} = $rhome; return 1; } return $self->error("Could not mkdir $rhome: $!"); } sub compute_identity { my ($self) = @_; $self->find_home() or return; return 1 if $self->{identity}; my $id; if ($id = $self->{opt}->{identity}) { $self->{identity} = $self->my_readlink($id); # warn we can't read it unless we are registering new identity $self->log(6,"Can't read identity: $self->{identity}") unless ($self->{opt}->{register}) || (-r $self->{identity}); return 1; # if not specified via cmd-line, just compute it, don't read it. } elsif ($id = $self->{conf}->{identity}) { $self->{identity} = $self->my_readlink($id); return 1; } else { $id = $self->{razorhome} ? "$self->{razorhome}/identity" : ""; $self->{identity} = $self->my_readlink($id); return 1; } } sub get_ident { my ($self) = @_; $self->find_home() or return; my $idfn = $self->{identity}; return $self->error("Cannot read the identity file: $idfn") unless -r $idfn; $idfn = $self->my_readlink($idfn); my $mode = ((stat($idfn))[2]) & 07777; # mask off file type if ($mode & 0007) { $self->log(2,"Please chmod $idfn so it is not world readable."); } return $self->read_file( $idfn ); } # returns { user => $user, pass => $pass } if success # returns 2 if error sub register_identity { my($self, $user, $pass) = @_; my $ident = $self->register({ user => $user, pass => $pass, }); $self->disconnect() or return 2; return $ident || 2; } sub ident_fn { my ($self,$ident) = @_; $self->find_home() or return; my $orig; my $syml; my $obase = "identity-$ident->{user}"; $obase = $1 if $obase =~ /^(\S+)$/; # untaint obase # if it's a user specified identity file, don't symlink unless ($orig = $self->{opt}->{identity}) { $orig = "$self->{razorhome}/$obase"; $syml = "$self->{razorhome}/identity"; $orig = $1 if $orig =~ /^(\S+)$/; # untaint orig $syml = $1 if $syml =~ /^(\S+)$/; # untaint syml } return ($orig, $obase, $syml); } sub save_ident { my ($self,$ident) = @_; my ($orig, $obase, $syml) = $self->ident_fn($ident); unless (length $orig) { return $self->error("couldn't figure out identity filename"); } rename($orig,"$orig.bak") if -s $orig; my $umask = umask 0077; # disable group and all from read/write/execute $self->write_file($orig,$ident) or return; umask $umask; # don't create a symlink if user specified identity file from cmd-line return $orig unless $syml; unless ($self->{opt}->{symlink}) { return $orig if -e $syml; # already has another identity } unlink $syml; if (eval { symlink("",""); 1 } ) { $obase = $1 if $obase =~ /^(\S+)$/; # untaint obase $syml = $1 if $syml =~ /^(\S+)$/; # untaint syml symlink $obase, $syml or return $self->error("Created $orig, but could not symlink to it $syml: $!"); } else { $self->log(5, "symlinks don't work on this machine"); copy($orig,$syml); } return $orig; } sub my_readlink { my ($self,$fn) = @_; while (1) { return $fn unless -l $fn; if ($fn =~ /^(.*)\/([^\/]+)$/) { my $dir = $1; $fn = readlink $fn; $fn = $1 if $fn =~ /^(\S+)$/; # untaint readlink $fn = "$dir/$fn" unless $fn =~ /^\//; } else { $fn = readlink $fn; $fn = $1 if $fn =~ /^(\S+)$/; # untaint readlink } } } sub parse_value { my ($self, $value) = @_; $value =~ s/^\s+//; $value =~ s/\s+$//; if ($value =~ m:,:) { my @values = split /,\s*/, $value; return [@values]; } else { return $value; } } # given filename, returns hash ref of key = val from file # if $nothash, than no key && val, just return array ref containing all lines. # sub read_file { my ($self,$fn,$h,$nothash) = @_; unless (defined $fn && length $fn) { $self->log(5,"Filename not provided to read_file"); return; } my $conf = ref($h) eq 'HASH' ? $h : {}; if( $^O eq 'VMS' && $fn !~ /\[/ ) { my ($dir,$file,$ext) = ($fn =~ /(^.*\/)(.*)(\..*)$/); $dir =~ s/\./_/g; $file =~ s/\./_/g; $fn = $dir . $file . $ext; } $fn = $1 if $fn =~ /^(\S+)$/; # untaint $fn unless (defined($fn) && (($fn =~ /^\//) || -e $fn)) { $self->log(7,"Can't read file $fn, looking relative to $self->{razorhome}"); $fn = "$self->{razorhome}/$fn"; $fn = $1 if $fn =~ /^(\S+)$/; # untaint $fn } my $total = 0; my @lines; unless (open CONF, "<$fn") { $self->log(5,"Can't read file $fn: $!"); return; } # set $/ to the default in case someone has overwritten $/ elsewhere local $/ = "\n"; for () { chomp; next if /^\s*#/; if ($nothash) { next unless s/^\s*(.+?)\s*$/$1/; # untaint $conf->{$_} = 7; push @lines, $_; } else { next unless /=/; my ($attribute, $value) = /^\s*(.+?)\s*=\s*(.+?)\s*$/; # untaint next unless (defined $attribute && defined $value); $conf->{$attribute} = $self->parse_value($value); } $total++; } close CONF; $self->log(5, "read_file: $total items read from $fn"); return $nothash ? \@lines : $conf; } # given hash ref, writes to file key = val # NOTE: key should not contain '='; # # given array ref, writes to file each item # # given scalar ref, writes to file # sub write_file { my ($self,$fn,$hash,$append,$header,$lock) = @_; $fn = "$self->{razorhome}/$fn" unless ($fn =~ /^\//); $fn = ">$fn" if $append; if( $^O eq 'VMS' && $fn !~ /\[/ ) { my ($dir,$file,$ext) = ($fn =~ /(^.*\/)(.*)(\..*)$/); $dir =~ s/\./_/g; $file =~ s/\./_/g; $fn = $dir . $file . $ext; } $fn = $1 if $fn =~ /^(\S+)$/; # untaint $fn # check for lock file my $lockfile = "$fn.lock"; $lockfile = "${fn}_lock;1" if $^O eq 'VMS'; if ($lock) { if (-r "$lockfile") { return $self->error("File is locked, try again later: $lockfile"); } else { unless (open LOCK, ">$fn.lock") { return $self->error("Can't create lock file $fn.lock: $!"); } close LOCK; } } unless (open CONF, ">$fn") { return $self->error("Can't write file $fn: $!"); } print CONF "$header\n" if $header; my $total = 0; if (ref($hash) eq 'HASH') { foreach (sort keys %$hash) { return $self->error("Key cannot contain '=': $_") if /=/; printf CONF "%-22s = ", $_; if (ref($hash->{$_}) eq "ARRAY") { print CONF join(',', @{$hash->{$_}}) ."\n"; } else { print CONF $hash->{$_} ."\n"; } $total++; } } elsif (ref($hash) eq 'ARRAY') { foreach (@$hash) { next unless /\S/; if (ref($_) eq "ARRAY") { print CONF join(', ', @$_) ."\n"; } else { print CONF $_ ."\n"; } $total++; } } elsif (ref($hash) eq 'SCALAR') { printf CONF $$hash; $total++; } close CONF; if ($lock) { 1 while unlink "$lockfile"; } $self->log(5, "wrote $total ". ref($hash) ." items to file: $fn"); #return $total; return 1; } sub default_server_conf { my $self = shift; my $defaults = { srl => -1, ep4 => '7542-10', bql => 4, ac => 0, bqs => 128, se => 'C8', # engines 4, 8 dre => 4, zone => 'razor2.cloudmark.com', logic_method => 4, }; # split strings with , into array foreach (keys %$defaults) { $defaults->{$_} = $self->parse_value($defaults->{$_}); } return $defaults; } sub default_agent_conf { my $self = shift; # # These get overwritten by whatever's in config file, # which in turn gets overwritten by cmd-line options. # my $defaults = { debuglevel => "3", logfile => "razor-agent.log", listfile_catalogue => "servers.catalogue.lst", listfile_nomination => "servers.nomination.lst", listfile_discovery => "servers.discovery.lst", min_cf => "ac", turn_off_discovery => "0", ignorelist => "0", razordiscovery => "discovery.razor.cloudmark.com", rediscovery_wait => "172800", report_headers => "1", whitelist => "razor-whitelist", use_engines => "4, 8", identity => "identity", logic_method => 4, }; # 'razorhome' can exist in .conf, but we compute it instead of listing it here # 'rlimit' ? # split strings with , into array foreach (keys %$defaults) { $defaults->{$_} = $self->parse_value($defaults->{$_}); } return $defaults; } 1; razor-agents-2.85/lib/Razor2/Client/Core.pm0000644000000000000000000017630610435713265015366 0ustar #!/usr/bin/perl -sw ## ## Razor2::Client::Core - Vipul's Razor Client API ## ## Copyright (c) 2001, Vipul Ved Prakash. All rights reserved. ## This code is free software; you can redistribute it and/or modify ## it under the same terms as Perl itself. ## ## $Id: Core.pm,v 1.92 2006/05/27 00:00:53 rsoderberg Exp $ package Razor2::Client::Core; use strict; use IO::Socket; use IO::Select; use Errno qw(:POSIX); use Razor2::Client::Version; use Data::Dumper; use vars qw( $VERSION $PROTOCOL ); use base qw(Razor2::String); use base qw(Razor2::Logger); use base qw(Razor2::Client::Engine); use base qw(Razor2::Errorhandler); use Razor2::Client::Version; use Razor2::String qw(hextobase64 makesis parsesis hmac_sha1 xor_key prep_mail debugobj to_batched_query from_batched_query hexbits2hash fisher_yates_shuffle); ($VERSION) = do { my @r = (q$Revision: 1.92 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; $PROTOCOL = $Razor2::Client::Version::PROTOCOL; sub new { my ($class, $conf, %params) = @_; my $self = {}; bless $self, $class; $self->debug ("Razor Agents $VERSION, protocol version $PROTOCOL."); return $self; } # # We store server-specific config info for each server we know about. # All info about razor servers is stored in $self->{s}. # # Basically we get the server name/ip from {list}, # load that server's specific info from {allconfs} into {conf}, # and do stuff. If server is no good, we get nextserver from {list} # # $self->{s}->{list} ptr to {nomination} if report,revoke; or {catalogue} if check # or the cmd-line server (-rs server) # $self->{s}->{new_list} set to 1 when discover gets new lists # $self->{s}->{catalogue} array ref containing catalogue servers # $self->{s}->{nomination}array ref containing nomination servers # $self->{s}->{discovery} array ref containing discovery servers # # $self->{s}->{modified} array ref containing servers whose .conf needs updating # $self->{s}->{modified_lst} array ref containing which .lst files need updating # # $self->{s}->{ip} string containing ip (or dns name) of current server from {list}) # $self->{s}->{port} string containing port, taken from server:port from {list} # $self->{s}->{engines} engines supported, derived from {conf}->{se} # $self->{s}->{conf} hash ref containing current server's config params # read from $razorhome/server.$ip.conf # # $self->{s}->{allconfs} hash ref of all servers' configs. key={ip}, val={conf} # as read from server.*.conf file # # $self->{s}->{listfile} string containing path/file of server.lst, either # nomination or catalogue depending $self->{breed} # $self->{conf}->{listfile_discovery} string containing path/file of discovery server # # NOTE: if we are razor-check, server is Catalogue Server # otherwise server is Nomination server. # # everytime we update our server list, $self->{s}->{list}; # we want to write that to disk - $self->{s}->{listfile} # sub nextserver { my ($self) = @_; $self->log (16,"entered nextserver"); # see if we need to discover (.lst files might be too old) $self->discover() or return $self->errprefix ("nextserver"); # first time we don't remove from list # or if we've rediscovered. shift @{$self->{s}->{list}} unless ($self->{s}->{new_list} || !$self->{s}->{ip}); $self->{s}->{new_list} = 0; my $next = ${$self->{s}->{list}}[0]; # do we ever want to put current back on the end of list? # push @{$self->{s}->{list}}, $self->{s}->{ip}; if ($next) { ($self->{s}->{port}) = $next =~ /:(.*)$/; $next =~ s/:.*$//; # optional $self->{s}->{ip} = $next; # ip can be IP or DNS name $self->{s}->{port} ||= $self->{conf}->{port} || 2703; $self->{s}->{conf} = $self->{s}->{allconfs}->{$next}; my $svrport = "$self->{s}->{ip}:$self->{s}->{port}"; # get rid of server specific stuff delete $self->{s}->{greeting}; unless (ref($self->{s}->{conf})) { # never used this server before, no cached info. go get it! $self->{s}->{conf} = {}; $self->connect; # calls parse_greeting which calls compute_server_conf } else { $self->compute_server_conf(1); # computes supported engines, logs info } $self->writeservers(); my $srl = defined($self->{s}->{conf}->{srl}) ? $self->{s}->{conf}->{srl} : ""; $self->log(8, "Using next closest server $svrport, cached info srl $srl"); #$self->logobj(11, "Using next closest server $svrport, cached info", $self->{s}->{conf}); return 1; } else { return $self->error ("Razor server $self->{opt}->{server} not available at this time") if $self->{opt}->{server}; $self->{force_discovery} = 1; if ($self->{done_discovery} && !($self->discover)) { return $self->errprefix("No Razor servers available at this time"); } return $self->nextserver; } } sub load_at_runtime { my ($self,$class,$sub,$args) = @_; $sub = 'new' unless defined $sub; $args = "" unless defined $args; eval "use $class"; if ($@) { $self->log(2,"$class not found, please to fix."); return $self->error("\n\n$@"); } my $evalstr; if ($sub && $sub ne "new") { $evalstr = $class ."::$sub($args);"; } else { $evalstr = $class . "->new($args)"; } if (my $dude = eval $evalstr) { $self->log(12,"Found and evaled $evalstr ==> $dude"); return $dude; } else { $self->log(5,"Found but problem (bad args?) with $evalstr"); return $self->error("Problem with $evalstr"); } } # # uses DNS to find Discovery servers # puts discovery servers in $self->{s}->{discovery} # sub bootstrap_discovery { my ($self) = @_; $self->log (16,"entered bootstrap_discovery"); if ($self->{conf}->{server}) { $self->log(8,"no bootstap_discovery when cmd-line server specified"); return 1; } unless ($self->{force_bootstrap_discovery}) { if (ref($self->{s}->{discovery}) && scalar(@{$self->{s}->{discovery}})) { $self->log(8,"already have ". scalar(@{$self->{s}->{discovery}}) ." discovery servers"); return 1; } elsif ($self->{done_bootstrap}) { # if we've done it before {s}->{discovery} should be set $self->log(8,"already have done bootstrap_discovery"); return 1; } } unless (defined $self->{conf}->{listfile_discovery}) { $self->log(6,"discovery listfile not defined!"); } elsif (-s $self->{conf}->{listfile_discovery}) { my $wait = $self->{conf}->{rediscovery_wait_dns} || 604800; # 604800 secs == 7 days my $randomize = int(rand($wait/7)); my $timeleft = ((stat ($self->{conf}->{listfile_discovery}))[9] + $wait - $randomize) - time; if ($timeleft > 0) { $self->log (7,"$timeleft seconds before soonest DNS discovery"); return 1 unless $self->{force_bootstrap_discovery}; $self->log (5,"forcing DNS discovery"); } else { $self->log (5,"DNS discovery overdue by ". (0-$timeleft) ." seconds"); } } else { if (-e $self->{conf}->{listfile_discovery}) { $self->log (6,"empty discovery listfile: $self->{conf}->{listfile_discovery}"); } else { $self->log (6,"no discovery listfile: $self->{conf}->{listfile_discovery}"); } } $self->{s}->{discovery} = [ $self->{conf}->{razordiscovery} ]; push @{$self->{s}->{modified_lst}}, "discovery"; return 1; } # # uses Discovery Servers to find closest Nomination/Catalogue Servers. # called every day or so of if .lst file is empty # # puts servers in $self->{s}->{list} # sub discover { my ($self) = @_; $self->log (16,"entered discover"); # # do we need to discover? # # no discover if cmd-line server return 1 if $self->{opt}->{server}; # # don't discover if conf says turn_off_discovery (unless force_discovery) # return 1 if $self->{conf}->{turn_off_discovery} && (!($self->{force_discovery})); return $self->error ("No Razor servers available at this time") if $self->{done_discovery}; # so if user has their own servers, and they are temporarily down, force_discovery. # good: shit will work # bad: it will erase their custom server*.lst file # unless (defined $self->{s}->{listfile}) { $self->debug ("listfile not defined!"); } elsif (-s $self->{s}->{listfile}) { my $randomize = int(rand($self->{conf}->{rediscovery_wait}/7)); my $timeleft = ((stat ($self->{s}->{listfile}))[9] + $self->{conf}->{rediscovery_wait} - $randomize) - time; if ($timeleft > 0) { $self->debug ("$timeleft seconds before closest server discovery"); return 1 unless $self->{force_discovery}; $self->debug ("forcing discovery"); } else { $self->debug ("server discovery overdue by ". (0-$timeleft) ." seconds"); } } else { if (-e $self->{s}->{listfile}) { $self->debug ("empty listfile: $self->{s}->{listfile}"); } else { $self->debug ("no listfile: $self->{s}->{listfile}"); } } # # we need to discover. # return $self->errprefix("discover0") unless $self->bootstrap_discovery(); # # Go ahead and do discovery for both csl and nsl. # my %stype = ( csl => 'catalogue', nsl => 'nomination' ); my $srvs = {csl => {}, nsl => {} }; my $list_orig = $self->{s}->{list}; $self->{s}->{list} = $self->{s}->{discovery}; foreach (@{$self->{s}->{discovery}}) { unless (defined $_) { $self->log (5,"Razor Discovery Server not defined!"); next; } $self->log (8,"Checking with Razor Discovery Server $_"); unless ($self->connect( server => $_, discovery_server => 1 ) ) { $self->log (5,"Razor Discovery Server $_ is unreachable"); next; } foreach my $querytype (qw(csl nsl)) { my $query = "a=g&pm=$querytype\r\n"; my $resp = $self->_send([$query]); unless ($resp) { $self->{s}->{list} = $list_orig; return $self->errprefix("discover1"); } # from_batched_query wants "-" in beginning, but not ".\r\n" at end $resp->[0] =~ s/\.\r\n$//sg; my $h = from_batched_query($resp->[0], {}); foreach my $href (@$h) { next unless $href->{$querytype}; $self->log (8,"Discovery Server $_ replying with $querytype=$href->{$querytype}"); $srvs->{$querytype}->{$href->{$querytype}} = 1; } unless (keys %{$srvs->{$querytype}}) { $self->log (5,"Razor Discovery Server $_ had no valid $querytype servers"); next; } } } $self->{s}->{list} = $list_orig; foreach my $querytype (qw(csl nsl)) { my @list = keys %{$srvs->{$querytype}}; #return $self->error("Could not get valid info from Discovery Servers") # unless @list; unless (@list) { if ($self->{force_bootstrap_discovery}) { return $self->error("Bootstrap discovery failed. Giving up."); } $self->log(5, "Couldn't talk to discovery servers. Will force a bootstrap..."); $self->{force_bootstrap_discovery} = 1; return $self->error("Bootstrap discovery failed. Giving up.") unless $self->bootstrap_discovery(); return $self->discover(); } fisher_yates_shuffle(\@list) if @list > 1; $self->{s}->{$stype{$querytype}} = \@list; push @{$self->{s}->{modified_lst}}, $stype{$querytype}; } $self->disconnect(); unless ($self->{opt}->{server}) { if ($self->{breed} =~ /^check/) { $self->{s}->{list} = $self->{s}->{catalogue}; $self->{s}->{listfile} = $self->{conf}->{listfile_catalogue}; # for discovery() } else { $self->{s}->{list} = $self->{s}->{nomination}; $self->{s}->{listfile} = $self->{conf}->{listfile_nomination}; # for discovery() } } $self->{s}->{new_list} = 1; $self->{done_discovery} = 1; $self->writeservers(); return $self; } # only for debugging and errorchecking # sub logobj { my ($self, $loglevel, $prefix, @objs) = @_; return unless $self->logll($loglevel); foreach my $obj (@objs) { my $line = debugobj($obj); $self->log($loglevel, "$prefix:\n $line"); } } # # Mail Object # # Main data type used by check and report is the Mail Object. # an array of hash ref's, where array order matches mails in mbox (or stdin). # # key = value (not all defined) # # id = integer NOTE: only key guaranteed to exist # orig_mail = ref to string containing orig email (headers+body) # headers = headers of orig_email # spam = 0, not spam, >1 spam # skipme = 0|1 (not checked against server, usually whitelisted mail) # p = array ref to mimeparts. see below # e1 = similar to p, but special for engine 1 # # e1: each mail obj contains a special part for engine 1 # # skipme = 0|1 (ex: 1 if cleaned body goes to 0 len) # spam = 0, not spam, >1 spam # body = body of orig_mail # cleaned = body sent thru razor 1 preproc # e1 = hash using engine 1 # sent = hash ref sent to server # resp = hash ref of server response # # p: each mail obj contains 1 or more mimeparts, which can contain: # # id = string - mailid.part # skipme = 0|1 (ex: 1 if cleaned body goes to 0 len) # spam = 0, not spam, >1 spam # body = bodyparts (mimeparts) of orig_email, has X-Razor & Content-* headers # cleaned = body sent through preprocessors (deHtml, deQP, etc..), debugging use only # e2 = hash using engine 2 # e3 = hash using engine 2 # e4 = hash using engine 2 # sent = array ref of hash ref's sent to server # resp = array ref of hash ref's, where hash is parsed sis of server response # # sub prepare_objects { my ($self, $objs) = @_; my @objects; unless ($self->{s}->{engines} || ($self->{s}->{engines} = $self->compute_supported_engines() ) ) { $self->log(1, "ALLBAD. supported engines not defined"); } my $i = 1; if (ref($objs->[0]) eq 'HASH') { # checking cmd-line signatures foreach my $o (@$objs) { my $obj = { id => $i++ }; $obj->{p}->[0]->{id} = "$obj->{id}.0"; $obj->{p}->[0]->{"e$o->{eng}"} = $o->{sig}; $obj->{ep4} = $o->{ep4} if $o->{ep4}; push @objects, $obj; } } elsif (ref($objs->[0]) eq 'SCALAR') { # checking/reporting mail foreach my $o (@$objs) { my $obj = { id => $i++ }; $obj->{orig_mail} = $o; $self->log2file( 16, $o, "$obj->{id}.orig_mail" ); # includes headers and all push @objects, $obj; } $self->prepare_parts(\@objects); } $self->logobj(14,"prepared objs", \@objects); return \@objects; } sub prepare_parts { my ($self, $objs) = @_; my $prep_mail_debug = 0; # debug print, 0=none, 1=split_mime stuff, 2=more verbose $prep_mail_debug++ if $self->{conf}->{debuglevel} > 15; $prep_mail_debug++ if $self->{conf}->{debuglevel} > 16; foreach my $obj (@$objs) { next if ($obj->{skipme} || !$obj->{orig_mail}); # # now split up mime parts from orig mail # my ($headers, @bodyparts) = prep_mail ( $obj->{orig_mail}, $self->{conf}->{report_headers}, 4 * 1024, 60 * 1024, 15 * 1024, $self->{name_version}, $prep_mail_debug, # $debug, ); my $lines = " prep_mail done: mail $obj->{id} headers=". length($$headers); foreach (0..$#bodyparts) { $lines .= ", mime$_=". length(${$bodyparts[$_]}); } $self->log(8,$lines); unless (@bodyparts) { $self->log(2,"empty body in mail $obj->{id}, skipping"); next; } $$headers =~ s/\r\n/\n/gs; $obj->{headers} = $headers; # $obj->{e1} = { # id => "$obj->{id}.e1", # body => $obj->{orig_mail}, # }; $obj->{p} = []; foreach (0..$#bodyparts) { $bodyparts[$_] =~ s/\r\n/\n/gs; $obj->{p}->[$_] = { id => "$obj->{id}.$_", body => $bodyparts[$_], }; } } return 1; } # given mail objects, fills out # # - e1 # # and for each body part of mail object, fills out # # - cleaned # - e2 # - e3 # - e4 # # also returns array ref of sigs suitable for printing # sub compute_sigs { my ($self, $objects) = @_; my @printable_sigs; foreach my $obj (@$objects) { next if ($obj->{skipme} || !$obj->{orig_mail}); if (${$obj->{orig_mail}} =~ /\n(Subject: [^\n]+)\n/) { my $subj = substr $1, 0, 70; $self->log(8,"mail ". $obj->{id} ." $subj"); } else { $self->log(8,"mail ". $obj->{id} ." has no subject"); } # # clean each bodypart, removing if new length is 0 # next unless $obj->{p}; foreach my $objp (@{$obj->{p}}) { next if $objp->{skipme}; my $olen = length(${$objp->{body}}); my $clnpart = ${$objp->{body}}; # We'll do a VR8 preproc to determine emptiness # of email, and store it so VR8 can use it. my $clnpart_vr8 = $clnpart; $self->{preproc_vr8}->preproc( \$clnpart_vr8 ); # in da future: $self->{s}->{conf}->{dre} $objp->{cleaned_vr8} = \$clnpart_vr8; # This for VR4 (the only other signature scheme # supported at this time. $self->{preproc}->preproc( \$clnpart ); $objp->{cleaned} = \$clnpart; my $clen = length($clnpart_vr8); $self->log2file( 15, $objp->{body}, "$objp->{id}.before_preproc.as_reported"); $self->log2file( 15, $objp->{cleaned}, "$objp->{id}.after_preproc"); if ($clen eq 0) { $self->log(6,"preproc: mail $objp->{id} went from $olen bytes to 0, erasing"); $objp->{skipme} = 1; next; } elsif (($clen < 128) and ($clnpart =~ /^(Content\S*:[^\n]*\n\r?)+(Content\S*:[^\n]*)?\s*$/s)) { $self->log(6,"preproc: mail $objp->{id} seems empty, erasing"); $objp->{skipme} = 1; next; } elsif ($clnpart_vr8 !~ /\S/) { $self->log(6,"preproc: mail $objp->{id} went to all whitespace, erasing"); $objp->{skipme} = 1; next; } elsif ($clen eq $olen) { $self->log(6,"preproc: mail $objp->{id} unchanged, bytes=$olen"); } else { $self->log(6,"preproc: mail $objp->{id} went from $olen bytes to $clen "); } } # # compute sig for bodyparts that are cleaned. # if ($self->{s}->{conf}->{ep4}) { $obj->{ep4} = $self->{s}->{conf}->{ep4}; } else { $obj->{ep4} = '7542-10'; $self->log(8,"warning: no ep4 for server $self->{s}->{ip}, using $obj->{ep4}"); } foreach my $objp (@{$obj->{p}}) { next if $objp->{skipme}; $self->log(15, "mail part is [${$objp->{cleaned}}]"); if (${$objp->{cleaned}} =~ /^\s+$/) { $self->log(6, "mail $objp->{id} is whitespace only; skipping!"); } $self->log(6,"computing sigs for mail $objp->{id}, len ". length(${$objp->{cleaned}})); foreach (sort keys %{$self->{s}->{engines}}) { my $engine_no = $_; my $sig; if ($engine_no == 4) { $sig = $self->compute_engine( $engine_no, $objp->{cleaned}, $obj->{ep4} ); } elsif ($engine_no == 8) { $sig = $self->compute_engine( $engine_no, $objp->{cleaned_vr8} ); } else { # Unsupported signature type, don't calculate. next; # handled above } if ($sig) { $objp->{"e$engine_no"} = $sig; my @sigs; if (ref $sig eq 'ARRAY') { @sigs = @$sig; } else { push @sigs, $sig; } for (@sigs) { my $line = "$objp->{id} e$engine_no: $_"; $line .= ", ep4: $obj->{ep4}" if ($engine_no eq '4'); push @printable_sigs, $line; } } else { $self->log(6,"Engine ($engine_no) didn't produce a signature for mail $objp->{id}"); } } } $self->logobj(14,"computed sigs for obj", $obj); } return \@printable_sigs; } # # this function is the only one that has to be aware # of razor protocol syntax. (not including random logging) # the hashes generated here are eventually sent to to_batched_query. # sub make_query { my ($self, $params) = @_; if ($params->{action} =~ /^check/) { if (ref $params->{sig} eq 'ARRAY') { # Multiple signature per part, VR8 my $sigs = $params->{sig}; my @queries; for (@$sigs) { my %query = ( a => 'c', e => $params->{eng}, s => $_ ); push @queries, \%query; } return \@queries; } else { my %query = ( a => 'c', e => $params->{eng}, s => $params->{sig} ); $query{ep4} = $params->{ep4} if $query{e} eq '4'; return \%query; } } elsif ($params->{action} =~ /^rcheck/) { my %query = ( a => 'r', e => $params->{eng}, s => $params->{sig}, ); $query{ep4} = $params->{ep4} if $query{e} eq '4'; return \%query; } elsif ($params->{action} =~ /(report)/) { # prep_mail already truncated headers and body parts > 64K my @dudes; my $n = 0; while ($params->{obj}->{p}->[$n]) { my $line = ${$params->{obj}->{headers}}; while (1) { my $body = $params->{obj}->{p}->[$n]->{body}; last unless ( (length($$body) + length($line) < $self->{s}->{conf}->{bqs} * 1024)); $self->log(11, "bqs=". ($self->{s}->{conf}->{bqs} * 1024) . " adding to line [len=". length($line) ."] mail $params->{obj}->{p}->[$n]->{id}" ." [len=". length($$body) ."], total len=". (length($$body) + length($line)) ); $line .= "\r\n". $$body; $n++; last unless $params->{obj}->{p}->[$n]; } push @dudes, $line; } my @queries; foreach (@dudes) { push @queries, { a => $params->{action} eq 'report' ? 'r' : 'revoke', message => $_, }; } return @queries; } elsif ($params->{action} =~ /revoke/) { # Never send messages on revoke. Revoke all signature # that we were able to compute. my $n = 0; my @queries; while ($params->{obj}->{p}->[$n]) { for my $engine (keys %{$self->{s}->{engines}}) { my $sigs; if ($sigs = $params->{obj}->{p}->[$n]->{"e$engine"}) { if (ref $sigs eq 'ARRAY') { for my $sig (@$sigs) { push @queries, {a => 'revoke', e => $engine, s => $sig}; } } else { push @queries, {a => 'revoke', e => $engine, s => $sigs}; } } } $n++; } return @queries; } } # # prepare queries in correct syntax for sending over network # sub obj2queries { my ($self, $objects, $action) = @_; my @queries = (); foreach my $obj (@$objects) { next if $obj->{skipme}; push @queries, $obj->{e1}->{sent} if $obj->{e1}->{sent}; foreach my $objp (@{$obj->{p}}) { next if $objp->{skipme}; #$self->log(8,"not skipping mail part $objp->{id}, sent: ". scalar(@{$objp->{sent}})); push @queries, @{$objp->{sent}} if $objp->{sent}; } } if (scalar(@queries)) { $self->log(8,"preparing ". scalar(@queries) ." queries"); } else { $self->log(8,"objects yielded no valid queries"); return []; } my $qbatched = to_batched_query( \@queries, $self->{s}->{conf}->{bql}, $self->{s}->{conf}->{bqs}, 1); $self->log(8,"sending ". scalar(@$qbatched) ." batches"); return $qbatched; } # # Parse response syntax, add info to appropriate object # sub queries2obj { my ($self, $objs, $responses, $action) = @_; my @resp; foreach (@$responses) { # from_batched_query wants "-" in beginning, but not ".\r\n" at end s/\.\r\n$//sg; my $arrayref = from_batched_query($_); push @resp, @$arrayref; } $self->log(12,"processing ". scalar(@resp) ." responses"); $self->logobj(14,"from_batched_query", \@resp); my $j = 0; while (@resp) { my $obj = $objs->[$j++]; return $self->error("more responses than mail objs!") unless $obj; next if $obj->{skipme}; if ($obj->{e1}->{sent} && !$obj->{e1}->{skipme}) { $obj->{e1}->{resp} = shift @resp; $self->log(12,"adding a resp to mail $obj->{e1}->{id}") ; } foreach my $objp (@{$obj->{p}}) { next unless $objp->{sent}; # for each part, shift out as many responses as there were queries foreach (@{$objp->{sent}}) { push @{$objp->{resp}}, shift @resp; $self->log(12,"adding a resp to mail $objp->{id}"); } } #$self->logobj(13,"end of queries2obj",$obj); } return 1; } sub check_resp { my ($self, $me, $sent, $resp, $objp) = @_; # default is no contention $objp->{ct} = 0; $objp->{ct} = $resp->{ct} if exists $resp->{ct}; if (exists $resp->{err}) { $self->logobj(4,"$me: got err $resp->{err} for query", $sent); return 0; } if ($resp->{p} eq '1') { if (exists $resp->{cf}) { if ($resp->{cf} < $self->{s}->{min_cf}) { $self->log (6,"$me: Not spam: cf $resp->{cf} < min_cf $self->{s}->{min_cf}"); return 0; } else { $self->log (6,"$me: Is spam: cf $resp->{cf} >= min_cf $self->{s}->{min_cf}"); return 1; } } $self->log (6,"$me: sig found, no cf, ok."); return 1; } if ($resp->{p} eq '0') { $self->log (6,"$me: sig not found."); return 0; } # should never get here $self->logobj(2,"$me: got bad response from server - sent obj, resp obj", [$sent, $resp] ); return 0; } sub rcheck_resp { my ($self, $me, $sent, $resp) = @_; $self->log(8,"$me: invalid $sent") unless ref($sent); $self->log(8,"$me: invalid $resp") unless ref($resp); if (exists $resp->{err}) { if ($resp->{err} eq '230') { $self->log(8,"$me: err 230 - server wants mail"); return 1; } $self->logobj(4,"$me: got err $resp->{err} for query", $sent); return 0; } if ($resp->{res} eq '1') { $self->log (5,"$me: Server accepted report."); return 0; } if ($resp->{res} eq '0') { $self->log (1,"$me: Server did not accept report. Shame on the server."); return 0; } # should never get here $self->logobj(2,"$me: got bad response from server - sent obj, resp obj", [$sent, $resp] ); return 0; } sub check { my ($self, $objects) = @_; my $valid = 0; foreach my $obj (@$objects) { next if $obj->{skipme}; # # Logic used in ordering of check queries # # queries should go like this: (e=engine, p=part) # e1, p0e2, p0e3, p0e4, p1e2, p1e3, p1e4, etc.. # unless cmd-line sigs are passed. # # engine 1 is for entire mail, not parts if ($obj->{e1} # cmd-line sig checks don't have this && $self->{s}->{engines}->{1}) { $obj->{e1}->{sent} = $self->make_query( { action => 'check', sig => $obj->{e1}->{e1}, eng => 1 } ); } # rest of engines and mime parts foreach my $objp (@{$obj->{p}}) { if ($objp->{skipme}) { $self->log(8,"mail $objp->{id} skipped in check"); next; } $objp->{sent} = []; foreach (sort keys %{$self->{s}->{engines} }) { my $engine_save = $_; next if $_ eq 1; # engine 1 done above my $sig = $objp->{"e$_"}; unless ($sig) { $self->log(5,"mail $objp->{id} e$_ got no sig"); next; } unless ($self->{s}->{engines}->{$_}) { # warn if cmd-lig sig check is not supported $self->log(5,"mail $objp->{id} engine $_ is not supported, sig check skipped") if ($sig && !$obj->{orig_mail}); next; } if (ref $sig) { for (@$sig) { $self->log(8,"mail $objp->{id} e$engine_save sig: $_"); } } else { $self->log(8,"mail $objp->{id} e$engine_save sig: $sig"); } my $query = $self->make_query( { action => 'check', sig => $sig, ep4 => $obj->{ep4}, eng => $_ } ); $valid++ if $query; if (ref $query eq 'ARRAY') { push @{$objp->{sent}}, @$query; } else { push @{$objp->{sent}}, $query; } } } } unless ($valid) { $self->log (5,"No queries, no spam"); return 1; } $self->{s}->{list} = $self->{s}->{catalogue}; $self->connect; # Build query text strings # my $queries = $self->obj2queries($objects, 'check') or return $self->errprefix("check 1"); # send to server and store answers in mail obj # my $response = $self->_send($queries) or return $self->errprefix("check 2"); $self->queries2obj($objects, $response, 'check') or return $self->errprefix("check 3"); foreach my $obj (@$objects) { # check_logic will parse response for each object, decide if its spam # $self->check_logic($obj); $self->log (3,"mail $obj->{id} is ". ($obj->{spam} ? '' : 'not ') ."known spam."); } return 1; } sub check_logic { my ($self, $obj) = @_; # default is not spam $obj->{spam} = 0; if ($obj->{skipme}) { next; } # # Logic for Spam # # my $logic_method = $self->{conf}->{logic_method} || 4; my $logic_engines = $self->{conf}->{logic_engines} || 'any'; # cmd-line sig checks default to logic_method 1 $logic_method = 1 unless $obj->{orig_mail}; my $leng; if ($logic_engines eq 'any') { $leng = ""; # not a hash ref, implies 'any' logic_engine } elsif ($logic_engines eq 'all') { $leng = $self->{s}->{engines}; } elsif ($logic_engines =~ /^(\d\,)+$/) { $leng = {}; foreach (split /,/,$logic_engines) { unless ($self->{s}->{engines}->{$_}) { $self->log(3, "logic_engine $_ not supported, skipping"); next; } $leng->{$_} = 1; } } else { $self->log(3, "invalid logic_engines: $logic_engines, defaulting to 'any'"); $leng = ""; # not a hash ref, implies 'any' logic_engine } # iterate through sent queries and responses, # perform engine analysis (logic_engines). # # engine 1 case my $sent = $obj->{e1}->{sent}; my $resp = $obj->{e1}->{resp}; if ($resp && $sent) { # if skipme, there would be no resp my $logmsg = "mail $obj->{id} e=1 sig=$sent->{s}"; $obj->{e1}->{spam} = $self->check_resp($logmsg, $sent, $resp, $obj->{e1}); } # all other engines for all parts foreach my $objp (@{$obj->{p}}) { $objp->{spam} = 0; if ($objp->{skipme}) { $self->log(8,"doh. $objp->{id} is skipped, yet has sent") if $objp->{sent}; next; } next unless $objp->{sent}; my $not_spam = 0; foreach (0..(scalar(@{$objp->{sent}}) - 1)) { $sent = $objp->{sent}->[$_]; $resp = $objp->{resp}->[$_]; unless ($resp) { $self->log(5,"doh. more sent queries than responses"); next; } my $logmsg = "mail $objp->{id} e=$sent->{e} sig=$sent->{s}"; my $is_spam = $self->check_resp($logmsg, $sent, $resp, $objp); if (ref($leng)) { if ($leng->{$sent->{e}} && $is_spam) { $self->log(8,"logic_engines requires $sent->{e}, and it is. cool."); $objp->{spam} = 1; } elsif ($leng->{$sent->{e}} && !$is_spam) { $self->log(8,"logic_engines requires $sent->{e}, and it is not, part not spam"); $not_spam = 1; } else { $self->log(8,"logic_engines doesn't care about $sent->{e}, skipping"); } } else { # not a hash ref, implies 'any' logic_engine $objp->{spam} += $is_spam; } $objp->{spam} = 0 if $not_spam; } } # mime part analysis (logic_methods) # if ($logic_method == 1) { $obj->{spam} = 0; if ($obj->{e1}) { $obj->{spam} += $obj->{e1}->{spam} if $obj->{e1}->{spam}; } foreach my $objp (@{$obj->{p}}) { $obj->{spam} += $objp->{spam} if $objp->{spam}; } } elsif ($logic_method =~ /^(2|3)$/) { # logic_methods > 1 foreach my $objp (@{$obj->{p}}) { next if $objp->{skipme}; next unless $objp->{body}; my ($hdrs, $body) = split /\n\n/, ${$objp->{body}}, 2; $hdrs .= "\n"; #$self->log(8,"$objp->{id} hdrs:\n$hdrs"); my $type = ""; $objp->{is_text} = 0; $objp->{is_inline} = 0; $objp->{is_inline} = 1 if $hdrs =~ /Content-Disposition: inline/i; #$type = $1 if $hdrs =~ /Content-Type:\s([^\;\n]+)/i; $type = $1 if $hdrs =~ /Content-Type:\s([^\n]+)/i; $objp->{is_text} = 1 if $type =~ /text\//i; $objp->{is_text} = 1 if $type =~ /type unknown/; # assume text ? $self->log(8,"mail $objp->{id} Type $objp->{is_text},$objp->{is_inline} $type"); } } if ($logic_method == 2) { # in this method, only 1 dude decides if mail is spam. decider. # the first part is the default decider. can be overwritten, tho. my $decider = $obj->{p}->[0]; # basically the first inline text/* becomes the decider. # however, if no inline, the first text/* is used my $found = 0; foreach my $objp (@{$obj->{p}}) { next if $objp->{skipme}; if ($objp->{is_inline} && $objp->{is_text}) { $decider = $objp; last; } if (!$found && $objp->{is_text}) { $decider = $objp; $found = 1; } } $self->log (7,"method 2: $decider->{id} is the spam decider"); $obj->{spam} = $decider->{spam}; } elsif ($logic_method == 3) { # in this method, all text/* parts must be spam for obj to be spam # non-text parts are ignored my $found = 0; foreach my $objp (@{$obj->{p}}) { next if $objp->{skipme}; next unless $objp->{is_text}; $found = 1; $obj->{spam} = $objp->{spam}; unless ($objp->{spam}) { $self->log (7,"method 3: $objp->{id} is_text but not spam, mail not spam"); last; } } $self->log (7,"method 3: mail $obj->{id}: all is_text parts spam, mail spam") if $obj->{spam}; # if no parts where text, use the first part as spam indicator unless ($found) { $self->log (6,"method 3: mail $obj->{id}: no is_text, using part 1"); $obj->{spam} = 1 if $obj->{p}->[0]->{spam}; } } elsif ($logic_method == 4) { # in this method, if any non-contention parts is spam, mail obj is spam # contention parts are ignored. $obj->{spam} = 0; foreach my $objp (@{$obj->{p}}) { next if $objp->{skipme}; if ($objp->{ct}) { $self->log (7,"method 4: mail $objp->{id}: contention part, skipping"); } else { $self->log (7,"method 4: mail $objp->{id}: no-contention part, spam=$objp->{spam}"); $obj->{spam} = 1 if $objp->{spam}; } } if ($obj->{spam}) { $self->log (7,"method 4: mail $obj->{id}: a non-contention part was spam, mail spam"); } else { $self->log (7,"method 4: mail $obj->{id}: all non-contention parts not spam, mail not spam"); } } elsif ($logic_method == 5) { # in this method, all non-contention parts must be spam for obj to be spam # contention parts are ignored. my $not_spam = 0; my $is_spam = 0; foreach my $objp (@{$obj->{p}}) { next if $objp->{skipme}; if ($objp->{ct}) { $self->log (7,"method 5: mail $objp->{id}: contention part, skipping"); next; } else { $self->log (7,"method 5: mail $objp->{id}: no-contention part, spam=$objp->{spam}"); } if ($objp->{spam}) { $is_spam = 1; } else { $not_spam = 1; } } if ($is_spam && !$not_spam) { $obj->{spam} = 1; $self->log (7,"method 5: mail $obj->{id}: all non-contention parts spam, mail spam"); } else { $self->log (7,"method 5: mail $obj->{id}: a non-contention part not spam, mail not spam"); $obj->{spam} = 0; } } return 1; } # returns hash ref if successfully registered # returns 0 if not sub register { my ($self, $p,) = @_; my @queries; my $registrar = $self->{name_version}; my %qr = ( a => 'reg', registrar => $registrar ); $qr{user} = $p->{user} if $p->{user}; $qr{pass} = $p->{pass} if $p->{pass}; $queries[0] = makesis(%qr); $self->{s}->{list} = $self->{s}->{nomination}; $self->connect; my $response = $self->_send(\@queries) or return $self->errprefix("register"); my %resp = parsesis($$response[0]); if ($resp{err} && $resp{err} eq '210') { if ($qr{user} && $qr{pass}) { my($creds) = { user => $qr{user}, pass => $qr{pass} }; if ($self->authenticate($creds)) { $self->log(6, "Successfully registered provided credentials.\n"); return $creds; } } return $self->error("Error $resp{err}: User exists. Try another name. aborting.\n") } return $self->error("Error $resp{err} while performing register, aborting.\n") if ($resp{err}); return $self->error("No success (res=$resp{res}) while performing register, aborting.\n") if ($resp{res} ne '1'); $self->log(6,"Successfully registered with $self->{s}->{ip} identity: $resp{user}"); # otherwise return hash containing 'user' and 'pass' delete $resp{res}; return \%resp; } sub authenticate { my ($self, $options) = @_; my @queries; unless (($options->{user} =~ /\S/) && ($options->{pass} =~ /\S/)) { return $self->error("authenticate did not get valid user + pass"); } my %qr = ( a => 'ai', user => $options->{user}, cn => 'razor-agents', cv => $Razor2::Client::Version::VERSION ); $queries[0] = makesis(%qr); $self->{s}->{list} = $self->{s}->{nomination}; $self->connect; my $response = $self->_send(\@queries) or return $self->errprefix("authenticate 1"); my %resp = parsesis($$response[0]); if ($resp{err}) { if (($resp{err} eq '213') && !defined($self->{reregistered})) { # 213 = unknown user. # Try to register with current user+pass and continue with authenticate $self->log (8,"unknown user, attempting to re-register"); my $id = $self->register($options); $self->{reregistered} = 1; if (($id->{user} eq $options->{user}) && ($id->{pass} eq $options->{pass})) { $self->log (5,"re-registered user $id->{user} with $self->{s}->{ip}"); return $self->authenticate($options); } else { return $self->error("Error 213 while authenticating, aborting.\n") } } else { return $self->error("Error $resp{err} while authenticating, aborting.\n") } } my ($iv1, $iv2) = xor_key($options->{pass}); my ($my_digest) = hmac_sha1($resp{achal}, $iv1, $iv2); %qr = ( a => 'auth', aresp => $my_digest ); $queries[0] = makesis(%qr); $response = $self->_send(\@queries) or return $self->errprefix("authenticate 2"); %resp = parsesis($$response[0]); return $self->error("Error $resp{err} while authenticating, aborting.\n") if ($resp{err}); return $self->error("Authentication failed for user=$options->{user}") if ($resp{res} ne '1'); $self->log (5,"Authenticated user=$options->{user}"); $self->{authenticated} = 1; return 1; } # # handles report and revoke # sub report { my ($self, $objs) = @_; return $self->error("report: Not Authenticated") unless $self->{authenticated}; return $self->error("report/revoke for engine 1 not supported") if ($self->{s}->{conf}->{dre} == 1); $self->{s}->{list} = $self->{s}->{nomination}; $self->connect; my @robjs; my $valid = 0; if ($self->{breed} eq 'report') { # # Before reporting entire email, check to see if server already has it # unless ($self->{s}->{conf}->{dre}) { $self->logobj(8,"server has no default dre, using 4", $self->{s}->{conf}); $self->{s}->{conf}->{dre} = 4; } foreach my $obj (@$objs) { next if $obj->{skipme}; # handle special case for engine 1 # note: razor 1 does not store emails in its db, just sigs. # so we should never get a res=230 for e=1 a=r sig=xxx # #$obj->{e1}->{sent} = $self->make_query( { # action => 'rcheck', # sig => $obj->{e1}->{e1}, # eng => 1, } ); #$valid++ if $obj->{e1}->{sent}; # rest of engines and mime parts foreach my $objp (@{$obj->{p}}) { if ($objp->{skipme}) { $self->log(13,"mail $objp->{id} skipped in report"); next; } my $q = $self->make_query( { action => 'rcheck', sig => $objp->{"e$self->{s}->{conf}->{dre}"}, ep4 => $obj->{ep4}, eng => $self->{s}->{conf}->{dre}, } ); $objp->{sent} = [$q]; $valid++; } } unless ($valid) { $self->log (5,"No report check queries, no spam"); return 1; } $valid = 0; # Build query text strings - signatures computed already (see reportit) my $queries = $self->obj2queries($objs,'rcheck') or return $self->errprefix("report1"); # send to server and store answers in mail obj my $response = $self->_send($queries) or return $self->errprefix("report2"); $self->queries2obj($objs, $response, 'rcheck') or return $self->errprefix("report3"); # # If server wants email or certain body parts, # create new {sent} and add obj to @robjs # foreach my $obj (@$objs) { next if $obj->{skipme}; #$self->log(12,"mail $obj->{id} read ". scalar(@{$obj->{resp}}) ." queries"); # handle engine 1 special case #if ( !$obj->{e1}->{skipme} && $self->rcheck_resp( # "mail ". $obj->{id} .", orig_email, special case eng 1", # $obj->{e1}->{sent}, # $obj->{e1}->{resp} # ) ) { # $self->log(5,"doh. Server should not send res=230 for eng=1 report"); #} #delete $obj->{e1}->{sent}; my $wants_orig_mail = 0; foreach my $objp (@{$obj->{p}}) { next if $objp->{skipme}; $self->logobj(14,"checking response for $objp->{id}", $objp); unless ( $self->rcheck_resp( "mail $objp->{id}, eng $self->{s}->{conf}->{dre}", $objp->{sent}->[0], $objp->{resp}->[0] )) { $objp->{skipme} = 1; } else { $wants_orig_mail++; } $objp->{resp} = []; # clear responses from rcheck $objp->{sent} = []; } if ($wants_orig_mail) { # reports are special, all parts need to be together, so use part 0's sent my $objp = $obj->{p}->[0]; $objp->{skipme} = 0 if $objp->{skipme}; push @{$objp->{sent}}, $self->make_query( { action => 'report', obj => $obj, } ); push @robjs, $obj; } $valid += $wants_orig_mail; } } else { # revoke foreach my $obj (@$objs) { # don't revoke eng 1 # engines > 1 we send all the body parts, use part 0 to store sent my $objp = $obj->{p}->[0]; $objp->{sent} = []; push @{$objp->{sent}}, $self->make_query( { action => 'revoke', obj => $obj, } ); $valid++ if scalar(@{$objp->{sent}}); $self->log (9,"revoke sent:". scalar(@{$objp->{sent}})); push @robjs, $obj; } } unless ($valid && scalar(@robjs)) { $self->log (3,"Finished $self->{breed}."); return 1; } #$self->logobj(14,"report objs", \@robjs); # # send server mails/body parts either # revoked, or requested if reporting # my $queries = $self->obj2queries( \@robjs,$self->{breed}) or return $self->errprefix("report4"); my $response = $self->_send( $queries ) or return $self->errprefix("report5"); $self->queries2obj( \@robjs, $response,$self->{breed}) or return $self->errprefix("report6"); # we just do this to log server's response # foreach my $obj (@robjs) { my $objp = $obj->{p}->[0]; my $cur = -1; while ($objp->{sent}->[++$cur]) { $self->rcheck_resp( "$self->{breed}: mail $obj->{id}, $cur", $objp->{sent}->[$cur], $objp->{resp}->[$cur] ) unless ($objp->{skipme}); } } $self->logobj(14,"report objs", \@robjs); $self->log (3,"Sent $self->{breed}."); return 1; } sub _send { my ($self, $msg, $closesock, $skipread) = @_; $self->log (16,"entered _send"); unless ($self->{connected_to}) { $self->connect() or return $self->errprefix("_send"); } my @response; my $select = $self->{select}; my $sock = ($select->handles)[0]; $self->{sent_cnt} = 0 unless $self->{sent_cnt}; foreach my $i (0 .. ((scalar @$msg) -1) ) { my @handles = $select->can_write (15); if ($handles[0]) { $self->log (4,"$self->{connected_to} << ". length($$msg[$i]) ); if ($$msg[$i] =~ /message/) { my $line = debugobj($$msg[$i]); $self->log (6, $line ); $self->log2file(16, \$$msg[$i], "sent_to.". $self->{sent_cnt}); } else { $self->log (6, $$msg[$i] ); } local $\; undef $\; print $sock $$msg[$i]; $self->{sent_cnt}++; } else { return $self->error("Timed out (15 sec) while writing to $self->{s}->{ip}"); } next if $skipread; @handles = $select->can_read (15); if ($sock=$handles[0]) { local $/; undef $/; $response[$i] = $self->_read($sock) or return $self->error("Error reading socket"); $self->log (4,"$self->{connected_to} >> ". length($response[$i]) ); $self->log (6,"response to sent.$self->{sent_cnt}\n". $response[$i]); } else { return $self->error("Timed out (15 sec) while reading from $self->{s}->{ip}"); } } if ($closesock) { $select->remove($sock); close $sock; } return \@response; } sub _read { my ($self, $socket) = @_; my ($query, $read); # fixme - need to trim this down (copied from server) # unless ($read = sysread($socket, $query, 1024)) { # There was an error on sysread(), could be a real error or a # blocking error. if ($! == EWOULDBLOCK) { # write would block, so we try again later $self->debug ("_read: EWOULDBLOCK"); return; } elsif ($! == EINTR or $! == EIO) { # sysread() got interupted by a signal. # we will process this socket on next wheelwalk. $self->debug ("_read: EINTR"); return; } elsif ($! == EPIPE or $! == EISDIR or $! == EBADF or $! == EINVAL or $! == EFAULT) { $self->debug ("_read: EPIPE"); return; } else { # This happens when client breaks the connection. # Find out why we don't get an EPIPE instead. FIX! $self->debug ("_read: connection_closed"); return; } } if ($read > 0) { # Now we are absolutely sure there is data on the socket. return $query; } else { # Otherwise we got an EOF, expire the socket $self->debug ("_read: EOF, connection_closed"); return; } } sub connect { my ($self, %params) = @_; my $sock; $self->log (16,"entered connect"); if ($self->{simulate}) { return $self->error ("Razor Error 4: This is a simulation. Won't connect to $self->{s}->{ip}."); } my $server = $params{server} || $self->{s}->{ip}; unless ($self->{s}->{ip}) { $self->{s}->{ip} = $server; } if ($self->{sock} && $self->{connected_to}) { unless ($server) { $self->log (13,"no server specified, using already connected server $self->{connected_to}"); return 1; } if ($server eq $self->{connected_to}) { $self->log (15,"already connected to server $self->{connected_to}"); return 1; } return 1 if $self->{disconnecting}; $self->log(6,"losing old server connection, $self->{connected_to}, for new server, $server"); $self->disconnect; } unless ($server) { $self->log (6,"no server specified, not connecting"); return; } my $port = $params{port} || $self->{s}->{port}; unless (defined($port) && $port =~ /^\d+$/) { my $portlog = defined($port) ? " ($port)" : ""; $self->log (6, "No port specified$portlog, using 2703"); # bootstrap_discovery will come here $port = 2703; } $self->log (5,"Connecting to $server ..."); if (my $proxy = $self->{conf}->{proxy}) { # # Proxy stuff never been tested # $proxy =~ s!^http://!!; $proxy =~ s!:(\d+)/?$!!; my $pport = $1 || 80; $self->debug ("HTTP tunneling through $proxy:$pport."); $sock = IO::Socket::INET->new( PeerAddr => $proxy, PeerPort => $pport, Proto => 'tcp', Timeout => 20, ); unless ( $sock ) { $self->debug ("Unable to connect to proxy $proxy:$pport; Reason: $!."); } else { $sock->printf( "CONNECT %s:%d HTTP/1.0\r\n\r\n", $server, $port ); if( $sock->getline =~ m!^HTTP/1\.\d+ 200 ! ){ # Skip through remaining part of MIME header. while( $sock->getline !~ m!^\r! ){ ; } } else { $self->log (4, "HTTP tunneling is disabled at $proxy."); $sock = undef; } } } # if proxy, we already might have a $sock. # if proxy failed to connect, try without proxy. # if ($self->{conf}->{socks_server}) { my $socks_module = "Net::SOCKS"; eval "require $socks_module"; $self->log(6, "Will try to connect through the SOCKS server on $$self{conf}{socks_server}..."); my $socks_sock = Net::SOCKS->new ( socks_addr => $$self{conf}{socks_server}, socks_port => 1080, protocol_version => 4 ); if ($socks_sock) { $sock = $socks_sock->connect(peer_addr => $server, peer_port => $port); if ($sock) { $self->log(6, "Connected to $server via SOCKS server $$self{conf}{socks_server}."); } } } unless ($sock) { $sock = IO::Socket::INET->new( PeerAddr => $server, PeerPort => $port, Proto => 'tcp', Timeout => 20, ); unless ( $sock ) { $self->log (3,"Unable to connect to $server:$port; Reason: $!."); return if $params{discovery_server}; $self->nextserver or do { return $self->errprefix("connect1"); }; return $self->connect; } } my $select = new IO::Select ($sock); my @handles = $select->can_read (15); if ($handles[0]) { $self->log (8,"Connection established"); my $greeting = <$sock>; # $sock->autoflush; # this is on by default as of IO::Socket 1.18 $self->{sock} = $sock; $self->{connected_to} = $server; $self->{select} = $select; $self->log(4,"$server >> ". length($greeting) ." server greeting: $greeting"); return 1 if $params{discovery_server}; unless ($self->parse_greeting($greeting) ) { $self->nextserver or return $self->errprefix("connect2"); return $self->connect; } return 1; } else { $self->log (3, "Timed out (15 sec) while reading from $self->{s}->{ip}."); $select->remove($sock); $sock->close(); return $self->errprefix("connect3") if $params{skip_greeting}; $self->nextserver or return $self->errprefix("connect4"); return $self->connect; } } sub disconnect { my $self = shift; unless ($self->{sock}) { $self->log (5,"already disconnected from server ". $self->{connected_to}); return 1; } $self->log (5,"disconnecting from server ". $self->{connected_to}); $self->{disconnecting} = 1; $self->_send(["a=q\r\n"], 0, 1); delete $self->{disconnecting}; delete $self->{sock}; # _send closes socket return 1; } sub parse_greeting { my ($self, $greeting) = @_; $self->log (16,"entered parse_greeting($greeting)"); my %server_greeting = parsesis($greeting); $self->{s}->{greeting} = \%server_greeting; unless ($self->{s}->{greeting} && $self->{s}->{greeting}->{sn}) { $self->log(1,"Couldn't parse server greeting\n"); return; } # server greeting must contain: sn, srl # server greeting may contain: ep4, redirect, a, # # fixme - add support for redirect, etc. # # # current server config info is stored in $self->{s}->{conf} # see nextserver for more info # # If server greeting says there are new values # (which we know if greeting's srl > conf's srl) # we ask server for new values, update conf, then # put that server on modified list so it gets recorded to disk # # fixme - in the future, we could have a key with no value # in .conf file - forcing client to ask server 'a=g&pm=key' # if ($self->{s}->{greeting}->{a} eq 'cg') { my $version = $Razor2::Client::Version::VERSION; my @cg = ("cn=razor-agents&cv=$version\r\n"); $self->_send(\@cg, 0, 1); } if (defined($self->{s}->{greeting}->{srl}) && defined($self->{s}->{conf}->{srl}) && $self->{s}->{greeting}->{srl} <= $self->{s}->{conf}->{srl}) { $self->compute_server_conf; return 1 ; } # srl > our cached srl, request update (a=g&pm=state) # and rediscover # my @queries = ("a=g&pm=state\r\n"); my $response = $self->_send(\@queries) or return $self->errprefix("parse_greeting"); # should be just one response # from_batched_query wants "-" in beginning, but not ".\r\n" at end $response->[0] =~ s/\.\r\n$//sg; my $h = from_batched_query($response->[0], {}); foreach my $href (@$h) { foreach (sort keys %$href) { $self->{s}->{conf}->{$_} = $href->{$_}; #$self->log(8,"updated: $_=$href->{$_}"); } } $self->log(1,"Bad info while trying to get server state (a=g&pm=state)") unless scalar(@$h); $self->{s}->{conf}->{srl} = $self->{s}->{greeting}->{srl}; push @{$self->{s}->{modified}}, $self->{s}->{ip}; $self->{s}->{allconfs}->{$self->{s}->{ip}} = $self->{s}->{conf}; # in case new server # now we're up to date $self->log(5,"Updated to new server state srl ". $self->{s}->{conf}->{srl} ." for server ". $self->{s}->{ip}); $self->compute_server_conf(); $self->writeservers; # writes to disk servers listed in $self->{s}->{modified} $self->log(5,"srl was updated, forcing discovery ..."); $self->{done_discovery} = 0; $self->{force_discovery} = 1; $self->discover(); return 1; } # Returns engines supported # # can be called with no paramaters or # with hash of server supported engines sub compute_supported_engines { my ($self, $orig) = @_; my %all; my $se = $self->supported_engines(); # local supported engines foreach (@{$self->{conf}->{use_engines}}) { if ($orig) { $all{$_} = 1 if (exists $se->{$_}) && (exists $orig->{$_}); } else { $all{$_} = 1 if exists $se->{$_}; } } if ($orig) { $self->log(8, "Computed supported_engines: ". join(' ', sort(keys %all)) ); } else { $self->log(8, "Client supported_engines: ". join(' ', sort(keys %all)) ); } return \%all; } # called when we need to parse server conf # - after initial parse_greeting # - if state (srl) changes # - when we switch to cached server conf info in nextserver # sub compute_server_conf { my ($self, $cached) = @_; # # compute a confindence (cf) from razor-agent.conf's 'min_cf' # and server's average confidence (ac) # # min_cf can be 'n', 'ac', 'ac + n', or 'ac - n' # where 'n' can be 1..100 # my $cf = $self->{s}->{conf}->{ac}; # default is server's ac my $min_cf = $self->{conf}->{min_cf}; $min_cf =~ s/\s//g; if ($min_cf =~ /^ac\+(\d+)$/) { $cf = $self->{s}->{conf}->{ac} + $1; } elsif ($min_cf =~ /^ac-(\d+)$/) { $cf = $self->{s}->{conf}->{ac} - $1; } elsif ($min_cf =~ /^ac$/) { $cf = $self->{s}->{conf}->{ac}; } elsif ($min_cf =~ /^(\d+)$/) { $cf = $min_cf; } else { $self->log(5,"Invalid min_cf $self->{conf}->{min_cf}"); } $cf = 100 if $cf > 100; $cf = 0 if $cf < 0; $self->{s}->{min_cf} = $cf; # # ep4 - special for vr4 # $self->{s}->{conf}->{ep4} = $self->{s}->{greeting}->{ep4} if $self->{s}->{greeting}->{ep4}; my $info = $cached ? $self->{s}->{conf} : $self->{s}->{greeting}; my $name = "Unknown-Type: "; if ($info->{sn}) { $name .= $info->{sn}; $name = "Nomination" if $info->{sn} =~ /N/; $name = "Catalogue" if $info->{sn} =~ /C/; $name = "Catalogue" if $info->{sn} =~ /S/; $name = "Discovery" if $info->{sn} =~ /D/; } $self->log (6, $self->{s}->{ip} ." is a $name Server srl ". $self->{s}->{conf}->{srl} ."; computed min_cf=$cf, Server se: $self->{s}->{conf}->{se}"); # # Supported Engines - greeting contains hex of bits # we turn into a hash so we can just quickly do # do_eng3_stuff if $self->{s}->{engines}->{3}; # # if we're just computing hashes locally, ignore what engines server currently supports # fixme - this prolly should be done somewhere else if ($self->{opt}->{printhash}) { $self->log (6, "Ignore what engines server supports for -H"); $self->{s}->{engines} = $self->compute_supported_engines(); } else { my $se = hexbits2hash($self->{s}->{conf}->{se}); $self->{s}->{engines} = $self->compute_supported_engines($se); } } # sub log2file moved to Agent.pm sub debug { my ($self, $message) = @_; $self->log(5,$message); } sub DESTROY { my $self = shift; #$self->debug ("Agent terminated"); } sub zonename { my ($zone, $type) = @_; my ($sub, $dom) = split /\./, $zone, 2; return "$sub-$type.$dom"; } 1; razor-agents-2.85/lib/Razor2/Client/Engine.pm0000644000000000000000000000266110253414741015666 0ustar package Razor2::Client::Engine; use strict; use Digest::SHA1 qw(sha1_hex); use Data::Dumper; use Razor2::Signature::Ephemeral; use Razor2::Engine::VR8; use Razor2::Preproc::Manager; use Razor2::String qw(hextobase64 makesis debugobj); # meant to be inherited # sub new { return {}; } sub supported_engines { my @a = qw( 4 8 ); my $hr = {}; foreach (@a) { $hr->{$_} = 1; } return wantarray ? @a : $hr; } sub compute_engine { my ($self, $engine, @params) = @_; return $self->vr4_signature(@params) if $engine == 4; return $self->vr8_signature(@params) if $engine == 8; $self->log (1,"engine $engine not supported"); return; } # # The following *_signature subroutines should be # the same as the ones on the server # # # VR4 Engine - Ephemereal signatures of decoded body content # sub vr4_signature { my ($self, $text, $ep4) = @_; my ($seed, $separator) = split /-/, $ep4, 2; return $self->log(1,"vr4_signature: Bad ep4: $ep4") unless ($seed && $separator); my $ehash = new Razor2::Signature::Ephemeral (seed => $seed, separator => $separator); my $digest = $ehash->hexdigest($$text); my $sig = hextobase64($digest); $self->log (11,"engine 4 computing on ". length($$text) .", sig=$sig"); return $sig; } sub vr8_signature { my ($self, $text) = @_; my $vr8 = Razor2::Engine::VR8->new(); my $sigs = $vr8->signature($text); return $sigs; } 1; razor-agents-2.85/lib/Razor2/Client/Version.pm0000644000000000000000000000060710620700512016074 0ustar #!/usr/bin/perl -sw ## ## ## ## Copyright (c) 2001, Vipul Ved Prakash. All rights reserved. ## This code is free software; you can redistribute it and/or modify ## it under the same terms as Perl itself. ## ## $Id: Version.pm,v 1.45 2007/05/10 20:32:10 rsoderberg Exp $ package Razor2::Client::Version; use strict; use vars qw($PROTOCOL $VERSION); $PROTOCOL = 3; $VERSION = '2.84'; 1; razor-agents-2.85/lib/Razor2/Engine/0000755000000000000000000000000010625104016014077 5ustar razor-agents-2.85/lib/Razor2/Engine/VR8.pm0000644000000000000000000000140010063443406015054 0ustar package Razor2::Engine::VR8; use Razor2::Signature::Whiplash; use Razor2::String qw(hextobase64); use Data::Dumper; sub new { my ($class, %args) = @_; my $self = bless { description => 'whiplash', has_greet_param => 0, whiplash => new Razor2::Signature::Whiplash, rm => $args{RM}, }, $class; die unless $self; return $self; } sub signature { my ($self, $text) = @_; my ($sigs, $meta) = $self->{whiplash}->whiplash($$text); my @sigs_to_return; return unless $sigs; if (scalar @$sigs) { for (@$sigs) { push @sigs_to_return, hextobase64($_); } } else { return; } return \@sigs_to_return; } 1; razor-agents-2.85/lib/Razor2/Errorhandler.pm0000644000000000000000000000576210274235155015702 0ustar #!/usr/bin/perl -sw ## ## Razor2::Errorhandler -- Base class that provides error ## handling functionality. ## ## Copyright (c) 2001, Vipul Ved Prakash. All rights reserved. ## This code is free software; you can redistribute it and/or modify ## it under the same terms as Perl itself. ## ## $Id: Errorhandler.pm,v 1.5 2005/08/03 21:43:09 rsoderberg Exp $ package Razor2::Errorhandler; use strict; sub new { bless {}, shift } sub error { no strict; my ($self, $errstr, $construction_error) = @_; if ($construction_error) { my ($package, @undef) = caller(); my $location = "$package\::errstr"; my $spot = *{$location}{SCALAR}; $$spot = "$errstr\n"; } else { $$self{errstr} = "$errstr\n"; } $self->log($self->{logerrors},"Error: $errstr\n") if $self->{logerrors}; use strict; return; } sub errstr { my $self = shift; return $$self{errstr}; } sub errprefix { my ($self, $prefix) = @_; $$self{errstr} = $prefix .": ". $$self{errstr}; return; } sub errstrrst { my $self = shift; $$self{errstr} = ""; } 1; =head1 NAME Razor::Errorhandler - Error handling mechanism for Razor. =head1 SYNOPSIS package Foo; use Razor::Errorhandler; @ISA = qw(Razor::Errorhandler); sub alive { .. .. return $self->error ("Awake, awake! Ring the alarum bell. \ Murther and treason!", $dagger) if $self->murdered($king); } package main; use Foo; my $foo = new Foo; $foo->alive($king) or print $foo->errstr(); # prints "Awake, awake! ... " =head1 DESCRIPTION Razor::Errorhandler encapsulates the error handling mechanism used by the modules in Razor bundle. Razor::Errorhandler doesn't have a constructor and is meant to be inherited. The derived modules use its two methods, error() and errstr(), to communicate error messages to the caller. When a method of the derived module fails, it calls $self->error() and returns to the caller. The error message passed to error() is made available to the caller through the errstr() accessor. error() also accepts a list of sensitive data that it wipes out (undef'es) before returning. The caller should B call errstr() to check for errors. errstr() should be called only when a method indicates (usually through an undef return value) that an error has occured. This is because errstr() is never overwritten and will always contain a value after the occurance of first error. =head1 METHODS =over 4 =item B The first argument to error() is $message which is placed in $self->{errstr} and the remaining arguments are interpretted as variables containing sensitive data that are wiped out from the memory. error() always returns undef. =item B errstr() is an accessor method for $self->{errstr}. =back =head1 AUTHOR Vipul Ved Prakash, Email@vipul.netE =head1 SEE ALSO Razor::Client(3) =cut razor-agents-2.85/lib/Razor2/Logger.pm0000644000000000000000000001000410252356204014446 0ustar # $Id: Logger.pm,v 1.22 2005/06/10 18:31:32 vipul Exp $ package Razor2::Logger; use strict; use Razor2::Syslog; use Time::HiRes qw(gettimeofday); use POSIX qw(strftime); use IO::File; # 2003/09/10 Anne Bennett: syslog of our choice (uses socket, # does not assume network listener). use Sys::Syslog; # designed to be inherited module # but can stand alone. sub new { my ($class, %args) = @_; my %self = ( %args ); my $self = bless \%self, $class; my $prefix = $args{LogPrefix} || 'razord2'; my $facility = $args{LogFacility} || 'local3'; my $loghost = $args{LogHost} || '127.0.0.1'; if ($self->{LogTo} eq 'syslog') { $$self{syslog} = new Razor2::Syslog (Facility=> $facility, Priority => 'debug', Name => $prefix, SyslogHost => $loghost); $self->{LogType} = 'syslog'; } elsif ($self->{LogTo} =~ /^file:(.*)$/) { $self->{LogType} = 'file'; my $name = $1; chomp $name; open (LOGF, ">>$name") or do { if ($self->{DontDie}) { open LOGF, ">>/dev/null" or do { print STDERR "Failed to open /dev/null, $!\n"; }; } else { die $!; } }; LOGF->autoflush(1); $self->{fd} = *LOGF{IO}; } elsif ($self->{LogTo} eq 'sys-syslog') { # 2003/09/10 Anne Bennett: syslog of our choice (uses socket, # does not assume network listener). $self->{LogType} = 'sys-syslog'; openlog($prefix,"pid",$facility); } elsif ($self->{LogTo} eq 'stdout') { $self->{LogType} = 'file'; $self->{fd} = *STDOUT{IO}; } elsif ($self->{LogTo} eq 'stderr') { $self->{LogType} = 'file'; $self->{fd} = *STDERR{IO}; } else { $self->{LogType} = 'file'; $self->{fd} = *STDERR{IO}; } $self->{LogTimeFormat} ||= "%b %d %H:%M:%S"; # formatting from strftime() $self->{LogDebugLevel} = exists $self->{LogDebugLevel} ? $self->{LogDebugLevel} : 5; $self->{Log2FileDir} ||= "/tmp"; # 2002/11/27 Anne Bennett: log this at level 2 so we can set level # 1 (to get errors only) and avoid this unneeded line. $self->log(2,"[bootup] Logging initiated LogDebugLevel=$self->{LogDebugLevel} to $self->{LogTo}"); return $self; } sub log { my ($self, $prio, $message) = @_; return unless $prio <= $self->{LogDebugLevel}; my ($package, $filename, $line) = caller; $filename =~ s:.*/::; if ($self->{LogType} eq 'syslog') { my $logstr = sprintf("[%2d] %s\n", $prio, $message); $logstr =~ s/\n+\n$/\n/; $self->{syslog}->send($logstr, Priority => 'debug'); } elsif ($self->{LogType} eq 'sys-syslog') { # 2003/09/10 Anne Bennett: syslog of our choice (uses socket, # does not assume network listener). my $logstr = sprintf("[%2d] %s\n", $prio, $message); $logstr =~ s/\n+$//g; syslog("debug",$logstr); } elsif ($self->{LogType} eq 'file') { my $now_string; if ($self->{LogTimestamp}) { my ($seconds, $microseconds) = gettimeofday; $now_string = strftime $self->{LogTimeFormat}, localtime($seconds); $now_string .= sprintf ".%06d ", $microseconds; } my $logstr = sprintf("%s[%d]: [%2d] %s\n", $self->{LogPrefix}, $$, $prio, $message); $logstr =~ s/\n+\n$/\n/; my $fd = $self->{fd}; print $fd "$now_string$logstr"; } return 1; } sub log2file { my ($self, $prio, $textref, $fn_ext) = @_; return unless $prio <= $self->{LogDebugLevel}; unless (ref($textref) eq 'SCALAR') { print "log2file: not a scalar ref ($fn_ext)\n"; return; } my $len = length($$textref); my $fn = "$self->{Log2FileDir}/razor.$$.$fn_ext"; if (open OUT, ">$fn") { print OUT $$textref; close OUT; $self->log($prio,"log2file: wrote message len=$len to file: $fn"); } else { $self->log($prio,"log2file: could not write to $fn: $!"); } } 1; razor-agents-2.85/lib/Razor2/Preproc/0000755000000000000000000000000010625104016014304 5ustar razor-agents-2.85/lib/Razor2/Preproc/Manager.pm0000644000000000000000000000556207677143310016241 0ustar package Razor2::Preproc::Manager; use Razor2::Preproc::deBase64; use Razor2::Preproc::deQP; use Razor2::Preproc::deHTMLxs; use Razor2::Preproc::deHTML; use Razor2::Preproc::deNewline; use Razor2::Preproc::deHTML_comment; use Data::Dumper; use strict; sub new { my ($class, %args) = @_; my %self = (); $self{deBase64} = new Razor2::Preproc::deBase64 unless exists $args{no_deBase64}; $self{deQP} = new Razor2::Preproc::deQP unless exists $args{no_deQP}; $self{deHTML} = new Razor2::Preproc::deHTMLxs unless exists $args{no_deHTML}; $self{deNewline} = new Razor2::Preproc::deNewline unless exists $args{no_deNewline}; $self{deHTML_comment} = new Razor2::Preproc::deHTML_comment if exists $args{deHTML_comment}; $self{rm} = $args{RM}; return bless \%self, $class; } # # $bodyref must be Headers\n\r*\nBody # for this to work. Cleaned ref to Body returned. # sub preproc { my ($self, $bodyref, $dolength) = @_; my $lengths = { '1_orig' => length($$bodyref) } if $dolength; #-- $self->{rm}->{log}->log(12, "before_deBase64:"); if (exists $$self{deBase64} && $self->{deBase64}->isit($bodyref)) { $self->{deBase64}->doit($bodyref); } #-- $self->{rm}->{log}->log(12, "after_deBase64:"); #$self->log2file($bodyref, "preproc.afta.debase64"); $lengths->{'2_after_deBase64'} = length($$bodyref) if $dolength; #-- $self->{rm}->{log}->log(12, "before_deQP:"); my $isQP; if (exists $$self{deQP} && ($isQP = $self->{deQP}->isit($bodyref))) { $self->{deQP}->doit($bodyref); } #-- $self->{rm}->{log}->log(12, "after_deQP:"); #$self->log2file($bodyref, "preproc.afta.deQP.$isQP"); $lengths->{'3_after_deQP'} = length($$bodyref) if $dolength; #-- $self->{rm}->{log}->log(12, "before_deHTML:"); if (exists $$self{deHTML} && $self->{deHTML}->isit($bodyref)) { $self->{deHTML}->doit($bodyref); } #-- $self->{rm}->{log}->log(12, "after_deHTML:"); if (exists $$self{deHTML_comment} && $self->{deHTML_comment}->isit($bodyref)) { $self->{deHTML_comment}->doit($bodyref); } #-- $self->{rm}->{log}->log(12, "before_deNewline:"); if (exists $$self{deNewline}) { $self->{deNewline}->doit($bodyref); } #-- $self->{rm}->{log}->log(12, "after_deNewline:"); #$self->log2file($bodyref, "preproc.afta.deHTML"); $lengths->{'4_after_deHTML'} = length($$bodyref) if $dolength; my ($hdr, $body) = split /\n\r*\n/, $$bodyref, 2; $$bodyref = $body; $lengths->{'5_after_header_removal'} = length($$bodyref) if $dolength; return $lengths; } sub log2file { my ($self, $msgref, $mailid) = @_; my $len = length($$msgref); my $fn = "/tmp/.razor.debug.msg.$$.$mailid"; if (open OUT, ">$fn") { print OUT $$msgref; close OUT; } else { } } 1; razor-agents-2.85/lib/Razor2/Preproc/deBase64.pm0000644000000000000000000000200510620174025016176 0ustar package Razor2::Preproc::deBase64; sub new { return bless {}, shift; } sub isit { my ($self, $text) = @_; return $$text =~ /^Content-Transfer-Encoding: base64/sim; } sub doit { my ($self, $text) = @_; my ($hdr, $body) = split /\n\r*\n/, $$text, 2; $body = $self->extract_base64($text); $body =~ tr|A-Za-z0-9+=/||cd; # remove non-base64 chars $body =~ s/=+$//; # remove padding $body =~ tr|A-Za-z0-9+/| -_|; # convert to uuencoded format my $decoded = ''; while ($body =~ /(.{1,60})/gs) { my $len = chr(32 + length($1)*3/4); # compute length byte $decoded .= unpack("u", $len . $1 ); # uudecode } $$text = "$hdr\n\n$decoded"; } sub extract_base64 { my ($self, $text) = @_; if ($$text =~ /Content-Transfer-Encoding: base64(.*)$/si) { my $rhs = $1; $rhs =~ /\r?\n\r?\n([^=]*)/s; # match to end of data or '=' return $1 . "=="; } return undef; } 1; razor-agents-2.85/lib/Razor2/Preproc/deHTML.pm0000644000000000000000000001400707504460522015732 0ustar package Razor2::Preproc::deHTML; sub new { my $class = shift; my %html_tags = ( "lt" => '<', "gt" => '>', "amp" => '&', "quot" => '"', "nbsp" => ' ', "iexcl" => chr(161), "cent" => chr(162), "pound" => chr(163), "curren" => chr(164), "yen" => chr(165), "brvbar" => chr(166), "sect" => chr(167), "uml" => chr(168), "copy" => chr(169), "ordf" => chr(170), "laquo" => chr(171), "not" => chr(172), "shy" => chr(173), "reg" => chr(174), "macr" => chr(175), "deg" => chr(176), "plusmn" => chr(177), "sup2" => chr(178), "sup3" => chr(179), "acute" => chr(180), "micro" => chr(181), "para" => chr(182), "middot" => chr(183), "cedil" => chr(184), "sup1" => chr(185), "ordm" => chr(186), "raquo" => chr(187), "frac14" => chr(188), "frac12" => chr(189), "frac34" => chr(190), "iquest" => chr(191), "Agrave" => chr(192), "Aacute" => chr(193), "Acirc" => chr(194), "Atilde" => chr(195), "Auml" => chr(196), "Aring" => chr(197), "AElig" => chr(198), "Ccedil" => chr(199), "Egrave" => chr(200), "Eacute" => chr(201), "Ecirc" => chr(202), "Euml" => chr(203), "Igrave" => chr(204), "Iacute" => chr(205), "Icirc" => chr(206), "Iuml" => chr(207), "ETH" => chr(208), "Ntilde" => chr(209), "Ograve" => chr(210), "Oacute" => chr(211), "Ocirc" => chr(212), "Otilde" => chr(213), "Ouml" => chr(214), "times" => chr(215), "Oslash" => chr(216), "Ugrave" => chr(217), "Uacute" => chr(218), "Ucirc" => chr(219), "Uuml" => chr(220), "Yacute" => chr(221), "THORN" => chr(222), "szlig" => chr(223), "agrave" => chr(224), "aacute" => chr(225), "acirc" => chr(226), "atilde" => chr(227), "auml" => chr(228), "aring" => chr(229), "aelig" => chr(230), "ccedil" => chr(231), "egrave" => chr(232), "eacute" => chr(233), "ecirc" => chr(234), "euml" => chr(235), "igrave" => chr(236), "iacute" => chr(237), "icirc" => chr(238), "iuml" => chr(239), "eth" => chr(240), "ntilde" => chr(241), "ograve" => chr(242), "oacute" => chr(243), "ocirc" => chr(244), "otilde" => chr(245), "ouml" => chr(246), "divide" => chr(247), "oslash" => chr(248), "ugrave" => chr(249), "uacute" => chr(250), "ucirc" => chr(251), "uuml" => chr(252), "yacute" => chr(253), "thorn" => chr(254), "yuml" => chr(255) ); return bless { html_tags => \%html_tags, }, $class; } sub isit { my ($self, $text) = @_; my $isit = 0; my ($hdr, $body) = split /\n\r*\n/, $$text, 2; return 0 unless $body; $isit = $body =~ /(?:|EOS, or $i+10, and use # that to build a compare string for use with substr. Otherwise, # requesting ``lengths'' from char arrays that exceeds the actual # array produce additional 'undef's. 10 is an arbitrary #, but at # least greater than the max length (+ 1) of any html &tag. my($offset) = (scalar @{$chars} - $i > 10 ? 10 : scalar @{$chars} ); my($s) = join ('', @{$chars}[$i .. $i + $offset]); while ( ($tag, $val) = each %{$self->{html_tags}} ) { if (substr($s, 0, length($tag)) eq $tag) { ($r_tag, $r_val) = ($tag => $val); $r_tag .= ';' # so the length($r_tag) consumes the ``;'' if (substr($s, length($tag), 1) eq ';'); } } return (length($r_tag), $r_val); } sub html_xlat { my($self, $chars, $i) = @_; #print "html_xlat($r_tag) start\n"; return 0 if ($$chars[$i] !~ /[a-zA-Z]/); my $r_tag; # we used to walk till we got a ';', but to be compatible # with c, we won't check for ';' while ($$chars[$i] && $$chars[$i] =~ /[a-zA-Z]/) { $r_tag .= $$chars[$i++]; } my $len = length($r_tag); # do not include ; $len++ if ($$chars[$i] eq ';'); my $val = $self->{html_tags}->{$r_tag}; #print "html_xlat($r_tag) = ($len,$val)\n"; return 0 unless $val; # not found return ( $len, $val ); } sub doit { my ($self, $text) = @_; my ($hdr, $body) = split /\n\r*\n/, $$text, 2; my(@chars) = split //, $body; my($len) = scalar @chars; my($last, $quote, $sgml, $tag) = ("", "", "", ""); my(@out); my($i) = 0; while ($i < $len) { my($c) = $chars[$i++]; if ($c eq $quote) { if ($c eq '-' && $last ne '-') { $last = $c; next; } else { $last = 0; } $quote = ""; } elsif (!$quote) { if ($c eq '<') { $tag = 1; if ($chars[$i++] eq '!') { my($s) = join('', @chars[$i .. $i + 10]); $sgml = 1; } } elsif ($c eq '>') { if ($tag) { $sgml = 0; $tag = 0; } } elsif ($c eq '-') { if ($sgml and $last eq '-') { $quote = '-'; } else { push @out, $c if (! $tag); } } elsif ($c eq "\"" or $c eq "\'") { if ($tag) { $quote = $c ; } else { push @out, $c if (! $tag); } } elsif ($c eq "&") { my($len, $char) = $self->html_xlat(\@chars, $i); if ($len) { push @out, $char; $i += $len; } else { push @out, $c; } } else { push @out, $c if (! $tag); } } $last = $c; } $$text = "$hdr\n\n". join('', @out); } 1; razor-agents-2.85/lib/Razor2/Preproc/deHTML_comment.pm0000644000000000000000000000107607671205302017454 0ustar package Razor2::Preproc::deHTML_comment; sub new { my $class = shift; return bless {}, $class; } sub isit { my ($self, $text) = @_; my $isit = 0; my ($hdr, $body) = split /\n\r*\n/, $$text, 2; return 0 unless $body; $isit = $body =~ /(?:|//gs; $$text = "$hdr\n\n$body"; } 1; razor-agents-2.85/lib/Razor2/Preproc/deNewline.pm0000644000000000000000000000055507504250736016576 0ustar package Razor2::Preproc::deNewline; use MIME::QuotedPrint; sub new { return bless {}, shift; } sub isit { 1; } sub doit { my ($self, $text) = @_; my ($hdr, $body) = split /\n\r*\n/, $$text, 2; return unless $body; unless ($body =~ s/\n+$//s) { return $text; } $$text = "$hdr\n\n$body"; return $text; } 1; razor-agents-2.85/lib/Razor2/Preproc/deQP.pm0000644000000000000000000000162010620174025015474 0ustar package Razor2::Preproc::deQP; #use MIME::QuotedPrint; sub new { return bless {}, shift; } sub isit { my ($self, $text) = @_; my ($hdr, $body) = split /\n\r*\n/, $$text, 2; return $hdr =~ /^Content-Transfer-Encoding: quoted-printable/ism; } sub doit { my ($self, $text) = @_; my ($hdr, $body) = split /\n\r*\n/, $$text, 2; # comment this out to be compatible with libpreproc.cc:qp_decode() #$body =~ s/[ \t]+?(\r?\n)/$1/g; # rule #3 (trailing space must be deleted) $body =~ s/=\r?\n//g; # rule #5 (soft line breaks) $body =~ s/=([\da-fA-F]{2})/pack("C", hex($1))/ge; $$text = "$hdr\n\n$body"; return $text; } sub extract_qp { my ($self, $text) = @_; if ($$text =~ /Content-Transfer-Encoding: quoted-printable(.*)$/sim) { my $rhs = $1; $rhs =~ /\r?\n\r?\n(.*)$/s; return $1; } return undef; } 1; razor-agents-2.85/lib/Razor2/Preproc/enBase64.pm0000644000000000000000000000147507476724732016247 0ustar package Razor2::Preproc::enBase64; sub new { return bless {}, shift; } sub isit { my ($self, $text) = @_; my $is_binary = ($$text =~ /^Content-Type-Encoding: 8-bit/) || ($$text =~ /([\x00-\x1f|\x7f-\xff])/ and $1 !~ /[\r\n\t]/); return $is_binary; } sub doit { my ($self, $text) = @_; pos($$text) = 0; # ensure start at the beginning my $res = join '', map( pack('u',$_)=~ /^.(\S*)/, ($$text =~ /(.{1,45})/gs)); $res =~ tr|` -_|AA-Za-z0-9+/|; # `# help emacs # fix padding at the end my $padding = (3 - length($$text) % 3) % 3; $res =~ s/.{$padding}$/'=' x $padding/e if $padding; # split into lines $res =~ s/(.{1,76})/$1\n/g; $res = "Content-Transfer-Encoding: base64\n\n$res"; $$text = $res; } 1; razor-agents-2.85/lib/Razor2/Signature/0000755000000000000000000000000010625104016014633 5ustar razor-agents-2.85/lib/Razor2/Signature/Ephemeral.pm0000644000000000000000000001127007630760276017116 0ustar #!/usr/bin/perl package Razor2::Signature::Ephemeral; use strict; use Digest::SHA1; use Data::Dumper; sub new { my ($class, %args) = @_; my $self = bless { seed => $args{seed} || 42, separator => encode_separator($args{separator}) || encode_separator("10"), }, $class; $self; } sub hexdigest { my ($self, $content) = @_; # Initialize PRNG with $seed srand($$self{seed}); my @content = split /$$self{separator}/, $content; # $content =~ s/$$self{separator}//g; -- We don't do this anyore # my $size = length($content); my $lines = scalar @content; debug("\nNumber of lines: $lines"); # Randomly choose relative locations and section sizes (in percent) my $sections = 6; my $ssize = 100/$sections; my @rel_lineno = map { rand($ssize) + ($_*$ssize) } 0 .. ($sections-1); my @lineno = map { int(($_ * $lines)/100) } @rel_lineno; debug("Relative Line Numbers (in percent): @rel_lineno"); debug("Absolute Line Numbers: @lineno"); my @rel_offset1 = map { rand(50) + ($_*50) } qw(0 1); my @rel_offset2 = map { rand(50) + ($_*50) } qw(0 1); debug("Relative Offsets for section 1: @rel_offset1"); debug("Relative Offsets for section 2: @rel_offset2"); my ($l1, $l2) = (0, 0); for ($lineno[1] .. $lineno[2]) { $l1 += length($content[$_]) if $content[$_]} for ($lineno[3] .. $lineno[4]) { $l2 += length($content[$_]) if $content[$_] } debug("Length of the first section: $l1 bytes"); debug("Length of the second section: $l2 bytes"); my @offset1 = map { int(($_ * $l1)/100) } @rel_offset1; my @offset2 = map { int(($_ * $l2)/100) } @rel_offset2; debug("Chunk start/end positions in Section 1: @offset1 (length: " . ($offset1[1] - $offset1[0]) .") "); debug("Chunk start/end positions in Section 2: @offset2 (length: " . ($offset2[1] - $offset2[0]) .") "); my $x = 0; my ($sc, $sl, $ec, $el) = (0,0,0,0); my $section1 = picksection( \@content, $lineno[1], $lineno[2], $offset1[0], $offset1[1] ); my $section2 = picksection( \@content, $lineno[3], $lineno[4], $offset2[0], $offset2[1] ); debug("Section 1: $section1"); debug("Section 2: $section2"); my $seclength = length($section1.$section2); debug("Total length of stuff that will be hashed: $seclength"); if ($section1 =~ /^\s+$/ && $section2 =~ /^\s+$/) { debug("Both sections were whitespace only!"); $section1 = ""; $section2 = ""; } my $digest; my $ctx = Digest::SHA1->new; if ($seclength > 128) { $ctx->add($section1); $ctx->add($section2); $digest = $ctx->hexdigest; } else { debug("Sections too small... reverting back to orginal content."); $ctx->add($content); $digest = $ctx->hexdigest; } debug("Computed e-hash is $digest"); return $digest; } sub picksection { my ($content, $sline, $eline, $soffset, $eoffset) = @_; my $x = 0; my ($sc, $sl, $ec, $el) = (0,0,0,0); for ($sline .. $eline) { next unless $content->[$_]; $x = $x + length($content->[$_]); if (($x > $soffset) && ($sc == 0)) { # we come here first time $sc = length($content->[$_]) - ($x - $soffset); # $x is greater than start $sl = $_; # offset } if ($x > $eoffset) { $ec = length($content->[$_]) - ($x - $eoffset); $el = $_; } last if $ec; } $sc = 0 if $sc < 0; $ec = 0 if $ec < 0; # FIX! not verified to work correctly. debug("Absolute chunk offsets: Line $sl charachter $sc to line $el character $ec"); my $section = ""; if ($sl == $el) { if ($content->[$sl]) { $section = substr ($content->[$sl], $sc, $ec - $sc + 1); } else { $section = ""; } } else { $section .= substr($content->[$sl], $sc); for ($sl+1 .. $el-1) { $section .= $content->[$_]; } $section .= substr($content->[$el], 0, $ec); } return $section; } sub encode_separator { my ($self, $separator) = @_; my $rv; unless (ref $self) { $separator = $self } my @chars = split/-/, $separator; push @chars, $separator unless scalar @chars; for (@chars) { $rv .= chr($_) } return $rv; } sub debug { my $message = shift; # print "debug: $message\n"; #open TMP, ">>/tmp/ehash"; #print TMP "$message\n"; #close TMP; } 1; razor-agents-2.85/lib/Razor2/Signature/Whiplash.pm0000644000000000000000000003622010620174054016757 0ustar #!/usr/bin/perl -sw ## ## Whiplash ## ## Author: Vipul Ved Prakash . ## $Id: Whiplash.pm,v 1.7 2007/05/08 22:22:36 rsoderberg Exp $ package Razor2::Signature::Whiplash; use Digest::SHA1; sub new { my ($class, %args) = @_; my %self = ( uri_terminators => "/><\"", length_error => 100, al_terminators => " /><\"\r\n", ); my @DPL = qw( .com .net .org .info .biz .edu .gov.ar .int.ar .net.ar .com.ar .mil.ar .ar .com.au .org.au .gov.au .org.au .id.au .oz.au .info.au .net.au .asn.au .csiro.au .telememo.au .conf.au edu.au .au .com.az .net.az .org.az .az .art.br .com.br .esp.br .etc.br .g12.br .gov.br .ind.br .inf.br .mil.br .net.br .org.br .pro.br .psi.br .rec.br .tmp.br .br .ab.ca .bc.ca .gc.ca .mb.ca .nf.ca .ns.ca .nt.ca .on.ca .pe.ca .qc.ca .sk.ca .yk.ca .ca .ac.cn .com.cn .edu.cn .gov.cn .net.cn .org.cn .bj.cn .sh.cn .tj.cn .cq.cn .he.cn .sx.cn .nm.cn .ln.cn .jl.cn .hl.cn .js.cn .zj.cn .ah.cn .hb.cn .hn.cn .gd.cn .gx.cn .hi.cn .sc.cn .gz.cn .yn.cn .xz.cn .sn.cn .gs.cn .qh.cn .nx.cn .xj.cn .tw.cn .hk.cn .mo.cn .cn .arts.co .com.co .edu.co .firm.co .gov.co .info.co .int.co .nom.co .mil.co .org.co .rec.co .store.co .web.co .co .ac.cr .co.cr .ed.cr .fi.cr .go.cr .or.cr .sa.cr .cr .com.cu .net.cu .org.cu .cu .ac.cy .com.cy .gov.cy .net.cy .org.cy .cy .cz .de .com.ec .k12.ec .edu.ec .fin.ec .med.ec .gov.ec .mil.ec .org.ec .net.ec .ec .com.eg .edu.eg .eun.eg .gov.eg .net.eg .org.eg .sci.eg .eg .ac.fj .com.fj .gov.fj .id.fj .org.fj .school.fj .fj .site.voila.fr .fr .com.ge .edu.ge .gov.ge .mil.ge .net.ge .org.ge .pvt.ge .ge .co.gg .org.gg .sch.gg .ac.gg .gov.gg .ltd.gg .ind.gg .net.gg .alderney.gg .guernsey.gg .sark.gg .gg .edu.gu .com.gu .mil.gu .gov.gu .net.gu .org.gu .gu .com.hk .edu.hk .gov.hk .idv.hk .net.hk .org.hk .hk .co.hu .org.hu .priv.hu .info.hu .tm.hu .nui.hu .hu .ac.id .co.id .go.id .mil.id .net.id .or.id .id .k12.il .org.il .ac.il .gov.il .muni.il .co.il .net.il .il .co.im .lkd.co.im .plc.co.im .net.im .gov.im .org.im .nic.im .ac.im .im .ernet.in .nic.in .ac.in .co.in .gov.in .net.in .res.in .in .com.jo .gov.jo .edu.jo .net.jo .jo .co.jp .ne.jp .or.jp .lg.jp .ne.jp .ad.jp .ac.jp .go.jp .gr.jp .jp .ac.kr .co.kr .go.kr .ne.kr .or.kr .re.kr .pe.kr .seoul.kr .kyonggi.kr .com.la .net.la .org.la .la .com.lb .org.lb .net.lb .gov.lb .mil.lb .lb .com.lc .edu.lc .gov.lc .net.lc .org.lc .lc .com.lv .edu.lv .gov.lv .org.lv .mil.lv .id.lv .net.lv .asn.lv .conf.lv .lv .com.ly .net.ly .org.ly .ly .edu.mm .com.mm .gov.mm .net.mm .org.mm .mm .com.mo .edu.mo .gov.mo .net.mo .org.mo .mo .com.mt .net.mt .org.mt .mt .com.mx .net.mx .org.mx .mx .com.my .org.my .gov.my .edu.my .net.my .my .com.na .org.na .net.na .na .com.nc .net.nc .org.nc .nc .ne .nf .ng .com.ni .ni .com.np .net.np .ort.np .np .co.nz .net.nz .govt.nz .ac.nz .nz .ac.pa .com.pa .net.pa .org.pa .edu.pa .gob.pa .sld.pa .pa .com.pe .net.pe .org.pe .pe .com.ph .net.ph .org.ph .mil.ph .ngo.ph .ph .com.pl .net.pl .org.pl .pl .com.py .net.py .org.py .edu.py .py .org.ru .net.ru .pp.ru .com.ru .ru .com.sg .net.sg .org.sg .edu.sg .gov.sg .sg .com.sh .edu.sh .gov.sh .net.sh .mil.sh .org.sh .sh .co.sv .sv .com.sy .net.sy .org.sy .sy .ac.th .co.th .go.th .net.th .or.th .in.th .th .com.tn .ind.tn .tourism.tn .fin.tn .net.tn .gov.tn .nat.tn .org.tn .info.tn .ens.tn .intl.tn .rnrt.tn .rnu.tn .rns.tn .edunet.tn .tn .bbs.tr .com.tr .edu.tr .gov.tr .k12.tr .mil.tr .net.tr .org.tr .tr .com.tw .net.tw .org.tw .gove.tw .tw .com.ua .net.ua .gov.ua .ua .ac.ug .co.ug .or.ug .go.ug .ug .ac.uk .co.uk .gov.uk .ltd.uk .me.uk .mod.uk .net.uk .nic.uk .nhs.uk .org.uk .plc.uk .police.uk .sch.uk .uk .ak.us .al.us .ar.us .az.us .sf.ca.us .ca.us .co.us .ct.us .dc.us .de.us .fed.us .fl.us .ga.us .hi.us .ia.us .id.us .il.us .in.us .isa.us .kids.us .ks.us .ky.us .la.us .ma.us .md.us .me.us .mi.us .mn.us .mo.us .ms.us .mt.us .nc.us .nd.us .ne.us .nh.us .nj.us .nm.us .nsn.us .nv.us .ny.us .oh.us .ok.us .or.us .pa.us .ri.us .sc.us .sd.us .tn.us .tx.us .ut.us .vt.us .va.us .wa.us .wi.us .wv.us .wy.us .us .com.uy .edu.uy .net.uy .org.uy .uy .com.ve .edu.ve .gov.ve .net.ve .co.ve .bib.ve .tec.ve .int.ve .org.ve .firm.ve .store.ve .web.ve .arts.ve .rec.ve .info.ve .nom.ve .mil.ve .ve .co.vi .net.vi .org.vi .vi .ac.yu .co.yu .edu.yu .org.yu .yu .ws .ac.za .alt.za .co.za .edu.za .gov.za .mil.za .net.za .ngo.za .nom.za .org.za .school.za .tm.za .web.za .za ); $self{dpl} = [@DPL]; return bless \%self, $class; } sub whiplash { my ($self, $text) = @_; # Wrap all the text in case the URL is broken up on multiple lines. # $text =~ s/[\r\n]//g; return unless $text; my @hosts = $self->extract_hosts($text); unless (scalar @hosts) { # No hostnames were found in the text, # return undef; debug("No hosts found in the message."); return; } # We have one or more hosts. Generate one signature for each host. my $length = length($text); my $corrected_length = $length - ($length % $$self{length_error}); my @sigs; my %sig_meta; for my $host (@hosts) { # Compute a SHA1 of host and corrected length. The corrected length is # the value of length to the nearest multiple of ``length_error''. # Take the first 20 hex chars from SHA1 and call it the signature. my $sha1 = Digest::SHA1->new(); $sha1->add($host); $sig = substr $sha1->hexdigest, 0, 12; $sha1->add($corrected_length); $sig .= substr $sha1->hexdigest, 0, 4; push @sigs, $sig; $sig_meta{$sig} = [$host, $corrected_length]; debug("$sig ($host + $corrected_length)"); } return (\@sigs, \%sig_meta); } sub extract_hosts { my ($self, $text) = @_; # # Test Vectors: # # 1. http://www.nodg.com@www.geocities.com/nxcisdsfdfdsy/off # 2. http://www.ksleybiuh.com@213.171.60.74/getoff/ # 3. # 4. http://217.12.4.7/rmi/http://definethis.net/526/index.html # 5. http://magalygr8sex.free-host.com/h.html # 6. http://%3CVenkatrs%3E@218.80.74.102/thecard/4index.htm # 7. http://EBCDVKIGURGGCEOKXHINOCANVQOIDOXJWTWGPC@218.80.74.102/thecard/5in # 8. http://g.india2.bag.gs/remove_page.htm # 9. https://220.97.40.149 # 10. http://mjaked.biz/unsubscribe.ddd?leaving # 11. http://g5j99m8@it.rd.yahoo.com/bassi/*http://www.lekobas.com/c/index.php # 12. look great / feel great # 13. # 14. www.pillzthatwork.com # anything that starts with www. # # Decode Hex URI encoding (TV #6) (SPEC-REF: UNESCAPE) $text =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; # Decode Decimal URI encoding (TV #10) (SPEC-REF: UNESCAPE) $text =~ s/\&\#([0-9]{2,3})\;/chr($1)/eg; debug("host_tokens(): will attempt to extract host names"); my @hosts; my @autolinks = $text =~ m|\s+(www.[^$$self{al_terminators}]+)|ig; # Outlook with autolink these URLs push @hosts, @autolinks; # # We extract host portions from all HTTP/HTTPS URIs found on the text. # URIs are decoded if they are encoded, usernames (usually random) are # thrown away and all unique hosts are extracted. # if ($text =~ m|^.*?href\s*=\s*"?https?://?(.*)$|si) { $text = "a href = http://$1"; } elsif ($text =~ m|^.*?https?://?(.*)$|si) { $text = "http://$1"; } else { return; } while ($host = next_host($text)) { last unless $host; # Strip to the domain or IP my $canonical_domain; if ($host =~ /^[\d\.]+$/) { # This is an IP address, just use it. $canonical_domain = $host; } else { # See if it's a non country domain. If so, # we'll extract the hostname. (SPEC-REF: NORMALIZE) $canonical_domain = $self->canonify($host); } # Ensure the hostname is not already in the list and that it is # potentially a routable hostname: length > 1 and contains # atleast one "." unless (grep { /^\Q$canonical_domain\E$/ } @hosts) { if ((length($canonical_domain) > 1) and ($canonical_domain =~ /\./)) { push @hosts, $canonical_domain; } } last unless $text =~ m"http://(.*)$"; $text = $1; } return @hosts; } sub next_host { ($_) = @_; my ($host, $authority); # Algorithm: # 1. Find http:// # 2. Find [@">/?] is the host. # 5. If @ was not found, the whole thing is the host # my $inside_href = 0; if (/^a href/) { $inside_href = 1; s|^a href\s*=\s*||; } # Remove the protocol name s|^http://||i; # Find a terminator if (( $inside_href and m|(.*?)[>\"\/\?\<]|s) or (!$inside_href and m|(.*?)[>\"\/\?\<\n\r]|s)) { $_ = $1; } # Remove the authority section if the URL has one s/^[^@]*@//si; # The host name is everything after the last `=' s/\S+=//si; $host = $_; # The host part cannot contains whitespace or linefeeds. # Everything including and beyond these characters should be # throw away. $host =~ s/[\r\n\s].*$//s; # /> # Lowercase the hostname and remove ``='' chars (which can be part # of the hostname sometimes when deQP didn't work correctly. $host = lc($host); $host =~ s/=//g; $host =~ s/\s*$//g; # Throw away the TCP port spec $host =~ s/:.*$//; # Throw away ``.'' at the end $host =~ s/\.$//; return $host; } sub canonify { my ($self, $host) = @_; # Extract canonical domain name. See the section on # Domain Part List in the Whiplash spec for details on # how this works. for my $pattern (@{$$self{dpl}}) { if ($pattern =~ /^\./) { if ($host =~ /([^\.]+\Q$pattern\E)$/) { return $1; } } else { if ($host =~ /\Q$pattern\E$/) { return $pattern; } } } return $host; } sub debug { my $message = shift; # print "debug: $message\n"; } 1; razor-agents-2.85/lib/Razor2/String.pm0000644000000000000000000007465510253373047014530 0ustar # $Id: String.pm,v 1.48 2005/06/13 21:09:59 vipul Exp $ package Razor2::String; use Digest::SHA1 qw(sha1_hex); use URI::Escape; use Razor2::Preproc::enBase64; use Data::Dumper; #use MIME::Parser; require Exporter; use vars qw ( @ISA $VERSION @EXPORT ); @ISA = qw(Exporter); @EXPORT = qw( hmac_sha1 xor_key from_batched_query to_batched_query findsimilar debugobj makesis parsesis makesis_nue parsesis_nue hextobase64 base64tohex randstr round hex_dump prep_mail prehash printb64table hexbits2hash hmac2_sha1 fisher_yates_shuffle ); # Same as the alphabet from RFC 1521, except s:/:_: and s:+:-: my %b64table; BEGIN { # ASCII # 33-126 printable chars # 48-57 numbers # 65-90 uppercase alpha # 97-122 lowercase alpha foreach (0..25) { $b64table{$_} = chr($_ + 65); } foreach (26..51) { $b64table{$_} = chr($_ + 71); } foreach (52..61) { $b64table{$_} = chr($_ - 4 ); } $b64table{62} = "-"; $b64table{63} = "_"; } sub printb64table { foreach (0..63) { print "$_ = $b64table{$_}\n"; } } sub hmac_sha1 { my $text = shift; my $iv1 = shift; my $iv2 = shift; my ($b64, $hex) = hmac2_sha1($text, $iv1, $iv2); return $b64; } # taken in part from RFC 2104 # http://www.cs.ucsd.edu/users/mihir/papers/hmac.html sub hmac2_sha1 { my $text = shift; my $iv1 = shift; my $iv2 = shift; return unless $text && $iv1 && $iv2; die "no ref's allowed" if ref($text); my $ctx = Digest::SHA1->new; $ctx->add($iv2); $ctx->add($text); my $digest = $ctx->hexdigest; $ctx = Digest::SHA1->new; $ctx->add($iv1); $ctx->add($digest); $digest = $ctx->hexdigest; return (hextobase64($digest), $digest); } sub hmac3_sha1 { my $text = shift; my $iv1 = shift; my $iv2 = shift; return unless $text && $iv1 && $iv2; die "no ref's allowed" if ref($text); my $digest = $text; $digest = sha1_hex($iv1 . $digest); $digest = sha1_hex($iv2 . $digest); return (hextobase64($digest), $digest); } # part of RFC 2104 - see hmac_sha1() sub xor_key { my $key = shift; # key length should never be > 64 chars; # # dont need this ... see Bitwise String Operators # $enc .= '\0' x (64 - length($pass)); my $iv1 = "\x36" x 64 ^ $key; my $iv2 = "\x5C" x 64 ^ $key; return ($iv1, $iv2); } # converts a string where each char is a hex (4-bit) value # to a string where each char is a base64 (6-bit) value sub hextobase64 { my $hs = shift; my @b64s; my $i = 0; while ($i < length($hs)) { # process 3 hex char chunks at a time my $hex3 = substr $hs, $i, 3; $i += 3; my $bv = pack "h3", $hex3; my $cur = 0; foreach (0..5) { my $bt = vec($bv,$_,1); $cur += $bt; $cur *= 2; } push @b64s, $cur/2; $cur = 0; foreach (6..11) { my $bt = vec($bv,$_,1); $cur += $bt; $cur *= 2; } push @b64s, $cur/2; #foreach (0..15) { my $bt = vec($bv,$_,1); print "$_=$bt, cur=$cur\n"; } #print " -- hex=$hex3; @b64s\n"; } my $bs = ""; foreach (@b64s) { $bs .= $b64table{$_}; } # print "b64=$bs; hex=". base64tohex($bs) ."\n"; # Fixme - change encoding so 1 hex char ==> 1 b64 char # 64-char hex string ==> 44-char b64 string. truncate to 43. # 40-char hex string ==> 28-char b64 string. truncate to 27. # $bs = substr($bs, 0, 43) if (length $bs == 44) && (substr($bs, -1) eq '0'); # $bs = substr($bs, 0, 27) if (length $bs == 28) && (substr($bs, -1) eq '0'); return $bs; } # converts a string where each char is a base64 (6-bit) value # to a string where each char is a hex (4-bit) value sub base64tohex { my $bs = shift; my @b64s; my $hexstr; # convert string to list of numbers base 10 foreach my $chr (split '', $bs) { foreach (keys %b64table) { push @b64s, $_ if $b64table{$_} eq $chr; } } while (@b64s) { my $bv = ""; vec($bv,0,16) = 0; my $a = shift @b64s; foreach (0..5) {my $i=5-$_; my $bt=$a%2; vec($bv,$i,1) = $bt; $a = int($a/2); } $a = shift @b64s; foreach (6..11) {my $i=17-$_;my $bt=$a%2; vec($bv,$i,1) = $bt; $a = int($a/2); } $hexstr .= unpack "h3", $bv; } # print "hexstr=$hexstr; @b64s\n"; # # NOTE on padding # if we pad 4 0-bits, we need to know that there wasn't an actual 0 # on the input string (hexstr). # # since padding 4 0's is more common than having the last hex # be a 0, we could append a special char indicating last 4 0 bits # were not padding 0's. # # But, we will customize these functions for razor2's needs. # 64-char hex string ==> 43-char b64 string ==> 66-char hex. truncate. # 40-char hex string ==> 27-char b64 string ==> 42-char hex. truncate. # 15-char hex string ==> 10-char b64 string ==> 15-char hex. ok. # # 20-byte hex string is 40 chars # $hexstr = substr($hexstr, 0, 20) if (length $hexstr == 21) && (substr($hexstr, -1) eq '0'); # $hexstr = substr($hexstr, 0, 40) if (length $hexstr == 42) && (substr($hexstr, -2) eq '00'); # $hexstr = substr($hexstr, 0, 64) if (length $hexstr == 66) && (substr($hexstr, -2) eq '00'); $hexstr = substr($hexstr, 0, 40) if (length($hexstr) == 42); $hexstr = substr($hexstr, 0, 64) if (length($hexstr) == 66); return $hexstr; } # can be called 2 ways # - makesis(%hash) aka makesis( p => 0, cf => 95 ) # - makesis($hashref) aka makesis({p => 0, cf => 95}) sub makesis { my $first = shift; my $data; if (ref($first) eq 'HASH') { $data = $first; } else { $data = {$first, @_}; } my $sis = ''; foreach (sort keys %$data) { $sis .= "$_=" . (exists $data->{$_} ? uri_escape($data->{$_}) : '') . '&'; } # This is 10x faster than the equivalent regex version. return substr($sis, 0, length($sis)-1) . "\r\n"; } sub parsesis { my $query = $_[1] || {}; my $wantref = 1 if $_[1]; # Parse the query. $_[0] =~ s/\n$//; # SIS shouldn't have this! $_[0] =~ s/\r$//; # SIS shouldn't have this! my @pairs = split /\&/, $_[0]; for (@pairs) { my ($key, $value) = split /=/, $_; $query->{$key} = defined $value ? uri_unescape($value) : ''; } return $query if $wantref; return %$query; } # version of makesis that doesn't to uri escaping # for things we know don't require escaping # can be called 2 ways # - makesis(%hash) aka makesis( p => 0, cf => 95 ) # - makesis($hashref) aka makesis({p => 0, cf => 95}) sub makesis_nue { my $first = shift; my $data; if (ref($first) eq 'HASH') { $data = $first; } else { $data = {$first, @_}; } my $sis = ''; foreach (sort keys %$data) { $sis .= "$_="; $sis .= $data->{$_} if exists($data->{$_}); $sis .= '&'; } # This is 10x faster than the equivalent regex version. return substr($sis, 0, length($sis)-1) . "\r\n"; } sub parsesis_nue { my $query = $_[1] || {}; my $wantref = 1 if $_[1]; # Parse the query. $_[0] =~ s/\r\n$//; my @pairs = split /\&/, $_[0]; for (@pairs) { my ($key, $value) = split /=/, $_; $query->{$key} = $value; } return $query if $wantref; return %$query; } sub to_batched_query { my ($queries, $bql, $bqs, $novar) = @_; my @bqueries; # Breaks up queries into batches, where batches are limited to: # - at most $bql lines long --OR-- # - at most $bqs kb in size # if bqs or bql == 0 or undef, no limit. # # fixme - optimization for aggregator: # sort, so all checks are together, all reports together, etc. # problem is user will want to maintain array order # $queries is array ref of either: # strings - sis, ready to go # hash ref - need to create sis # my $q = ref($queries->[0]) eq 'HASH' ? makesis_batch($queries) : $queries; # for right now, we'll just assume hash ref return unless ref($queries->[0]) eq 'HASH'; my $last; my $line; my $linecnt = 0; my $batchmode = 0; foreach my $cur (@$queries) { # my $dobj = debugobj($cur); print "dbg-doing obj: $dobj\n"; # # handle cases where we submit email blob (message = * ) # if (exists $cur->{message}) { my $msg = $cur->{message}; delete $cur->{message}; $line = "-". makesis($cur); $cur->{message} = $msg; $line =~ s/\r\n$//s; $line .= "&message=*\r\n$msg\r\n.\r\n"; push @bqueries, $line; next; } unless ($last) { # # start beginning of new batch # $last = $cur; next; } unless ($batchmode) { # # line after beginning of new batch # if similar, start variable batchmode. # if not, start batchmode without variables # my ($both, $diff) = findsimilar($last, $cur); if ($diff && !$novar) { $batchmode = 2; $line = "-". makesis_nue($both); # fixme - we might want to uri_escape() # but everything should be alphanum or our uri-safe base64 $line .= join(",", map "$last->{$_}", @$diff) ."\r\n"; $line .= join(",", map "$cur->{$_}", @$diff) ."\r\n"; $last = $both; # last is now 'template' $linecnt = 2; } else { $batchmode = 1; $line = "-". makesis($last); $line .= makesis_nue($cur); $linecnt = 2; } next; } else { # # We're in batchmode. # end if batch maxed out (bqs or bql reached) # end if batchmode with variables and cur doesn't match # end batch # my ($both, $diff) = findsimilar($last, $cur) if ($batchmode == 2); if ( ($bqs && (length($line) > ($bqs*1024))) || ($bql && ($linecnt >= $bql)) || ($batchmode == 2 && !$diff) ) { $batchmode = 0; $line .= ".\r\n"; push @bqueries, $line; $last = $cur; } else { # # fixme - we might go passed bqs by a little bit. prolly ok. # if ($batchmode == 2) { $line .= join(",", map "$cur->{$_}", @$diff) ."\r\n"; } else { $line .= makesis_nue($cur); } $linecnt++; } } } if ($batchmode) { $line .= ".\r\n"; push @bqueries, $line; } elsif ($last) { $line = makesis($last); push @bqueries, $line; } return \@bqueries; } # compares keys in hash ref's a & b # # return # if both hashes have different keys # # return (1) # if both hashes have same keys and values, # # returns 2 refs # if both hashes have same keys but different values # - first is hash, copy of a & b where vals are same. # where vals are diff, keys are copied with val = '?' # - second is list contains keys where values are different sub findsimilar { my ($a, $b) = @_; my @diffvalues = (); my %samevalues = (); foreach (sort keys %$a) { return unless exists $b->{$_}; if ($b->{$_} eq $a->{$_}) { $samevalues{$_} = $a->{$_}; } else { $samevalues{$_} = "?"; push @diffvalues, $_; } } foreach (sort keys %$b) { return unless exists $a->{$_}; } # if too hashes are exactly the same, not sure. # treat as if they are totally different. return (1) unless scalar(@diffvalues) > 0; return (\%samevalues, \@diffvalues); } sub from_batched_query { my ($queries) = @_; my @queries; my ($fq, $rq) = $queries =~ m:^\-(.*?)\r\n(.*)$:sm; unless ($fq && $rq) { # allow from_batched_query to handle non-batches $fq = $queries; $rq = ""; } if ($fq =~ m:\?:) { my %template_query = (); my @seq = (); my @pairs = split /\&/, $fq; for (@pairs) { my ($key, $value) = split /=/, $_; if ($value eq "?") { push @seq, $key; } else { $template_query{$key} = $value ? uri_unescape($value) : ''; } } for (split /\r\n/, $rq) { my @values = split /,/, $_; my %foo = %template_query; @foo{@seq} = @values; push @queries, \%foo; } return undef unless @queries; } elsif ($fq =~ m:\*:) { my %query = parsesis($fq); for (keys %query) { if ($query{$_} eq "*") { $query{$_} = $rq; last; } } push @queries, \%query; } else { # Don't split $queries. Use $fq and $rq instead since # $fq is already normalized. my %q = parsesis($fq); push @queries, \%q; for (split /\r\n/, $rq) { my %q = parsesis($_); push @queries, \%q; } } return \@queries; } sub randstr { my $size = shift; my $alphanum = shift; my $str; $alphanum = 1 if !defined($alphanum); # ASCII # 33-126 printable chars # 48-57 numbers # 65-90 uppercase alpha # 97-122 lowercase alpha while ($size--) { if ($alphanum) { $str .= $b64table{ int(rand 64) }; } else { $str .= chr(int(rand 94) + 33); } } return $str; } sub escape_smtp_terminator { my ($textref) = @_; $$textref =~ s/\r\n\./\r\n\.\./gm } sub unescape_smtp_terminator { my ($textref) = @_; $$textref =~ s/\r\n\.\./\r\n\./gm; } sub hex_dump { my $string = shift; for (split //, $string) { print ord($_) . " "; } print "\n"; } sub hash2str { my $href = shift; my %hash = %$href; my ($str, $key); for $key ( keys %hash ) { my $tstr; if ( ref $hash{$key} eq 'ARRAY' ) { for ( @{ $hash{ $key }} ) { $tstr .= escape( $_ ) . "," } $str =~ s/,$//; } elsif ( !(ref $hash{$key}) ) { $tstr .= escape ( $hash{$key} ); } if ( $tstr ) { $str .= "$key:$tstr&" } } $str =~ s/&$//; return $str; } sub str2hash { my $str = shift; my %hash; my @pairs = split /(?, body 2B) \r\n # part 4 = p(, body 3c) \r\n # part 5 = p(header 3d, body 3d) \r\n # .\r\n # # Notes: # - Order of parts does not matter. # # - Each part is processed by prep_mail, p(), before report/check # # - Except for original Header everything but leaf nodes # are discarded. In the above example, # # Body 1, header 2A, header 2C - are discarded # # # Detailed Explanation: # # Header 1 says 'Content-Type: multipart' with boundary definition # Based on the Boundary, Body 1 is split into A, B, C. # # A is analyzed, has headers which also say 'Content-Type: multipart' # with a different boundary, and it is split into 3a, 3b. 2A is what # appears between header 2a and first boundary, so its ignored. # 3a and 3b both have header info, so they are sent thru prep_mail # and reported/checked # # is based on Header 1 to determine content # type. if unknown, dummy header is added, # and both are reported as a body part # # C is analyzed, has headers which also say 'Content-Type: multipart' # with a different boundary, and it is split into 3c, 3d. # # is based on header 2c to determine content # type. if unknown, dummy header is added, # and both are reported as a body part # # 3d has header info, so header+body are sent thru prep_mail # and reported/checked # # # # prep_mail() basically truncates msgs that are too big and/or # base64 encodes binaries or 8-bit msgs. # # Split mime splits up multi-part mime mails. # # returns array of parts, where each part is # headers\n\nbody # # headers will only contain X-Razor2 and Content- headers # # If not a mime mail, and the headers do not have any # Content-* headers, then the only headers will be X-Razor2 ones # (perhaps create Content-Type in da future?) # # body can be blank. nuked in prep_part # sub split_mime { my ($mailref, $ver, $recursive, $debug ) = @_; return unless ref($mailref); # mime-bodies must have header or initial blank lines. # my ($hdr, $body) = split /\n\r*\n/, $$mailref, 2; my $no_valid_mime_hdr = 0; unless ($body) { # no blank lines, definately no header, so no nested mimes print "split_mime: no blank lines\n" if $debug > 1; $no_valid_mime_hdr = 1; } # fixme - handle attachments? i.e. if header has this # Content-Disposition: attachment # than body is mail, we could recursively call ourselves # again with body (check body for hdrs first?) # Make sure $hdr is really a hdr # # Details: If mime part is not RFC compliant, it could just # be a body with blank lines. hdr could have just matched part # of the body. # # valid mime header is determined by existance of 'Content-Type' # If we're not recursive, we don't check orig_headers, we assume its ok. # not sure if this is the best way ... # if ($recursive && ($hdr !~ /^Content-Type:/i)) { $no_valid_mime_hdr = 1; print "uh-oh, bad mime-body len=". length($$mailref) .":\n$$mailref\n" if $debug; #print "split_mime: recur=($recursive)\n"; } if ($no_valid_mime_hdr) { # # create dummy header and return it # # $ver should be '1' or client name + version my $mimepart = "X-Razor2-Agent: $ver\n"; my $hrdlen = length($mimepart); # if it has initial blank line, hurray for rfc compliance if ($$mailref =~ /^\n/) { $mimepart .= $$mailref; } else { $mimepart .= "\n". $$mailref; } print "split_mime: returning total_len=". length($mimepart) ."; hdrs=". $hdrlen .", body=". length($$mailref) ."\n" if $debug; return (\$mimepart); } # # Now we split mailref into hdr and body # check hdr for nested mime (boundary) # my $orig_hdr = $hdr; $hdr =~ s/\n\s+//sg; # merge multi-line headers # nuke everything but X-Razor2 and Content-* headers my $trimmed_hdr = ""; foreach (split '\n',$hdr) { /^Content-/i and $trimmed_hdr .= "$_\n"; /^X-Razor2/i and $trimmed_hdr .= "$_\n"; } my $boundary = ""; if ($trimmed_hdr =~ /Content-Type: multipart.+boundary=("[^"]+"|\S+)/ig) { $boundary = $1; } if ($boundary eq "") { # # valid mime hdr, but no nested mime. # add razor hdr and return. # print "split_mime: valid_mime_hdr [len=". length($orig_hdr) ."], but no nested mime\n$orig_hdr\n" if $debug > 1; $trimmed_hdr = "X-Razor2-Agent: $ver\n" . $trimmed_hdr; my $mimepart = "$trimmed_hdr\n$body"; print "split_mime: returning total=". length($mimepart) ."; hdrs=". length($trimmed_hdr) .", body=". length($body) ."\n" if $debug; return (\$mimepart); } $boundary = $1 if $boundary =~ /^"(.*)"$/; # At this point, we know body has mime parts. # my @mimeparts; # # According to RFC 1341 # http://www.w3.org/Protocols/rfc1341/7_2_Multipart.html # # mimes are separated by \n--boundary\n # and are followed immediately by header, blank line, body; # or blank line and body. # # if no header in mime part, default content type for mime body is # based on header where 'Content-Type: multipart*' was defined, where # multipart/digest --> message/rfc822 # multipart/* --> text/plain # perhaps we should add a header if none present? # # if a body contains mimes, the 'preable', or stuff before # the first boundary, and the 'epilogue', the stuff after the # last boudary, are to be ignored. # # NOTE: We split up multiparts, but content-type's can also be # nested. i.e, a header of 'Content-Type: message' can have a body # of 'Content-Type: image' # $body =~ s/\n\Q--$boundary--\E.*$//sg; # trash last boundary and epilogue if ($body =~ /^\Q--$boundary\E\r*\n/) { # bug in some mails, make it RFC compliant # now our split will work correctly print "bad mime body [len=". length($body) ."], not doing \\n--boundary, fixed tho.\n" if $debug > 1; $body = "garbage\n$body"; } my @tmpparts; unless ($body =~ /\Q--$boundary\E/) { # Sometimes there's a boundary in the headers # but none in email. In such cases, we'll # treat the entire body as a part. push @tmpparts, "garbage"; push @tmpparts, $body; } else { @tmpparts = split /\n\Q--$boundary\E\r*\n/, $body; } shift @tmpparts; # trash everything up to the first boundary; foreach (@tmpparts) { # perhaps we should add a header based on default content-type? unless (/\S/s) { print "skipping body part containing only whitespace [len=". length($_) ."]\n" if $debug; next; } print "boundary: ". $recursive . "$boundary\n" if $debug > 1; push @mimeparts, split_mime(\$_, $ver, " ". $recursive, $debug); } print "Saweeet!!! Boundary (". scalar(@mimeparts) ."): $boundary\n" if defined($boundary) && ($debug > 1); return @mimeparts; } # mailref is not modified by this sub # sub prep_part { my ($mailref, $maxheader, $maxbody) = @_; #print "[". length($$mailref) ."] maxsize=$maxheader + $maxbody\n"; my ($hdr, $body) = split /\n\r*\n/, $$mailref, 2; $hdr .= "\n"; # put newline back on last header line unless ($body) { # # fixme - this should not happen. # if it does, split_mime needs work # # print "prep_part got F**KED-up mimepart [len=". length($$mailref) ."]\n$$mailref\n"; return; # body is empty } # fixme - are these the best chars to check for binary? my $is_binary = ($hdr =~ /^Content-Type-Encoding: 8-bit/) || ($body =~ /([\x00-\x1f|\x7f-\xff])/ and $1 !~ /[\r\n\t]/); my $enBase64 = new Razor2::Preproc::enBase64; $is_binary = $enBase64->isit($mailref); $enBase64->doit(\$body) if $is_binary; $body =~ s/\r+\n/\n/sg; # outlook sometimes does \r\r\n $hdr =~ s/\r+\n/\n/sg; if ((my $len = length($body)) > $maxbody) { $body = substr $body, 0, $maxbody; substr($body, -2) = "==" if $is_binary; $hdr = "X-Razor2-Origlen-Body: $len\n" . $hdr; #print "maxbody=$maxbody body went from $len to ". length($body) ."\n"; } if ((my $len = length($hdr)) > $maxheader) { $hdr = "X-Razor2-Origlen-Header: $len\n" . $hdr; if (length($hdr) > $maxheader) { $hdr = substr $hdr, 0, $maxheader; $hdr =~ s/([^\n]+)$//s; # remove last, incomplete line } # print "maxhdr=$maxheader header went from $len to ". length($hdr) ."\n"; } my $dude = "$hdr\n$body"; return $mailref if $dude eq $$mailref; # this happens majority of the time return \$dude; } # NOTE: Important function! # *must* be kept in sync with server and all clients # same holds true for prep_part() # # This is the preprocessing done on a mail before sent over network # sub prep_mail { my ($mailref, $report_headers, $maxheader, $maxbody, $maxorighdr, $versionstring, $debug) = @_; return unless ref($mailref); print " prep_mail: orig=". length($$mailref) ."\n" if ($debug > 1); my ($orig_hdr) = split /\n\r*\n/, $$mailref, 2; $orig_hdr .= "\n"; # put newline back on last header line my $ver = $versionstring || 1; my @mimeparts = split_mime($mailref, $ver, 0, $debug); my @mimeparts_prep; foreach (@mimeparts) { push @mimeparts_prep, prep_part($_, $maxheader, $maxbody); } unless ($report_headers) { my $hdr = "X-Razor2-Headers-Suppressed: 1\n"; foreach (split '\n',$orig_hdr) { /^Content-/i and $hdr .= "$_\n"; /^X-Razor2/i and $hdr .= "$_\n"; } $orig_hdr = $hdr; } if ((my $len = length($orig_hdr)) > $maxorighdr) { $hdr = "X-Razor2-Origlen-Header: $len\n" . $orig_hdr; if (length($hdr) > $maxorighdr) { $hdr = substr $hdr, 0, $maxorighdr; $hdr =~ s/([^\n]+)$//s; # remove last, incomplete line } #print "max=$maxorighdr orig_header went from $len to ". length($hdr) ."\n"; $orig_hdr = $hdr; } if ($debug > 1) { print "**** prep_mail done: headers=". length($orig_hdr); foreach (0..$#mimeparts_prep) { print "\n**** mail $_ [". length(${$mimeparts_prep[$_]}) ."] ". substr(${$mimeparts_prep[$_]} ,0,40); } print "\n\n"; } return (\$orig_hdr, @mimeparts_prep); } # from MIME::Parser #my $parser = new MIME::Parser; #my $entity = $parser->parse($body); # foreach (dump_entity($entity)) sub dump_entity { my $ent = shift; my @parts = $ent->parts; if (@parts) { # multipart... map { dump_entity($_) } @parts; } else { # single part... return ( $ent->body ); # return text blob print " Part: ", $ent->bodyhandle->path, " (", scalar($ent->head->mime_type), ")\n"; } } # input: hex string ("2D") # output: hash ref or array containg bits that are set # 2D == (1, 3, 4, 6) sub hexbits2hash { my $hex = shift; my %h; for (0..31) { if (hex($hex) & (2**31)>>(31-$_)) { $h{$_+1} = 1 } } return wantarray ? (sort keys %h) : \%h; } # input: hash ref, array ref, or array containg bits that are set # output: hex string ("2D") # 2D == (4, 8, 32) sub hash2hexbits { my @bits = @_; @bits = @{$bits[0]} if ref($bits[0]) eq 'ARRAY'; @bits = (sort keys %{$bits[0]}) if ref($bits[0]) eq 'HASH'; my @all; my $i = 1; foreach (sort {$a <=> $b} @bits) { while (1) { push @all, 1 if $_ == $i; last if $_ == $i; push @all, 0; $i++; } } my $bs = join '', reverse @all; # fixme needs testing my $hex = (unpack "H*", pack "B*", join '', reverse @all); return $hex } # for debugging - dumps a obj to a string sub debugobj { my ($obj, $prefix, $maxwidth) = @_; $maxwidth ||= 70; return if (defined($prefix) && length($prefix) > $maxwidth); my $line = ""; $prefix .= " "x4; if (my $r = ref($obj)) { if ($r eq 'HASH') { $line = "$r - $obj,". scalar(keys %$obj) ." keys\n"; foreach (sort keys %$obj) { $line .= "$prefix$_ => ". debugobj($obj->{$_}, $prefix); } $line .= $prefix ."[empty]\n" unless (keys %$obj); } elsif ($r eq 'ARRAY') { $line = "$r - $obj,". scalar(@$obj) ." items\n"; foreach (@$obj) { $line .= $prefix . debugobj($_, $prefix); } $line .= $prefix ."[empty]\n" unless (@$obj); } elsif ($r eq 'REF') { $line = "$r - $obj\n"; $line .= $prefix . debugobj($$obj, $prefix); } elsif ($r eq 'SCALAR') { $line = "$r - $obj\n"; $line .= $prefix . debugobj($$obj, $prefix); } } else { if (defined $obj) { $line = $1 if substr($obj, 0, $maxwidth-length($prefix)) =~ /^([^\n]+)/; $line = "[length=". length($obj) ."] ". $line if (length($line) ne length($obj)); } else { $line = "[empty]"; } $line .= "\n"; } return $line; } sub clean_body { my ($self, $bodyref) = @_; my $hasheaders = 1; if ($self->{preprocs}->{deBase64}->isit($bodyref)) { $self->{preprocs}->{deBase64}->doit($bodyref); $hasheaders = 0; } if ($self->{preprocs}->{deQP}->isit($bodyref)) { $self->{preprocs}->{deQP}->doit($bodyref); $hasheaders = 0; } if ($self->{preprocs}->{deHTML}->isit($bodyref)) { $self->{preprocs}->{deHTML}->doit($bodyref); } if ($hasheaders) { $$bodyref =~ s/^.*?\n\n//s; } } sub round { my $float = shift; return sprintf("%.0f", $float); } sub fisher_yates_shuffle { my $deck = shift; # $deck is a reference to an array my $i = @$deck; while ($i--) { my $j = int rand ($i+1); @$deck[$i,$j] = @$deck[$j,$i]; } } 1; razor-agents-2.85/lib/Razor2/Syslog.pm0000644000000000000000000000732110237753430014524 0ustar package Razor2::Syslog; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); use IO::Socket; use IO::File; use Data::Dumper; require Exporter; @ISA = qw(Exporter AutoLoader); # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. @EXPORT = qw( ); $VERSION = '0.03'; # Preloaded methods go here. my %syslog_priorities=( emerg => 0, alert => 1, crit => 2, err => 3, warning => 4, notice => 5, info => 6, debug => 7 ); my %syslog_facilities=( kern => 0, user => 1, mail => 2, daemon => 3, auth => 4, syslog => 5, lpr => 6, news => 7, uucp => 8, cron => 9, authpriv=> 10, ftp => 11, local0 => 16, local1 => 17, local2 => 18, local3 => 19, local4 => 20, local5 => 21, local6 => 22, ); sub new { my $class = shift; my $name = $0; if($name =~ /.+\/(.+)/){ $name = $1; } my $self = { Name => $name, Facility => 'local5', Priority => 'err', SyslogPort => 514, SyslogHost => '127.0.0.1'}; bless $self,$class; my %par = @_; foreach (keys %par){ $self->{$_}=$par{$_}; } my $sock=new IO::Socket::INET(PeerAddr => $$self{SyslogHost}, PeerPort => $$self{SyslogPort}, Proto => 'udp'); die "Socket could not be created : $!\n" unless $sock; $self->{sock} = $sock; return $self; } sub send { my $self = shift; my $msg=shift; my %par = @_; my %local=%$self; foreach (keys %par){ $local{$_}=$par{$_}; } my $pid=$$; my $facility_i=$syslog_facilities{$local{Facility}}; my $priority_i=$syslog_priorities{$local{Priority}}; if(!defined $facility_i){ $facility_i=21; } if(!defined $priority_i){ $priority_i=4; } my $d=(($facility_i<<3)|($priority_i)); my $message = "<$d>$local{Name}\[$pid\]: $msg"; my $sock = $self->{sock}; # Send the message to the socket directly. $sock->send($message); # Flush the socket, to ensure that messages don't arrive combined into one packet. $sock->flush; } # Autoload methods go after =cut, and are processed by the autosplit program. 1; __END__ # Below is the stub of documentation for your module. You better edit it! =head1 NAME Razor2::Syslog -- Syslog support for Razor2 =head1 SYNOPSIS use Razor2::Syslog; my $s=new Razor2::Syslog(Facility=>'local4',Priority=>'debug'); $s->send('see this in syslog',Priority=>'info'); =head1 DESCRIPTION This module has been derived from Net::Syslog. Some optimizations were made to Net::Syslog, in particular support for keeping a socket open. What follows is the documentation for Net::Syslog, which completely applies to this module. Net::Syslog implements the intra-host syslog forwarding protocol. It is not intended to replace the Sys::Syslog or Unix::Syslog modules, but instead to provide a method of using syslog when a local syslogd is unavailable or when you don't want to write syslog messages to the local syslog. The new call sets up default values, any of which can be overridden in the send call. Keys (listed with default values) are: Name Facility local5 Priority err SyslogPort 514 SyslogHost 127.0.0.1 Valid Facilities are: kern, user, mail, daemon, auth, syslog, lpr, news, uucp, cron, authpriv, ftp, local0, local1, local2, local3, local4, local5, local6 Valid Priorities are: emerg, alert, crit, err, warning, notice, info, debug =head1 AUTHOR Les Howard, les@lesandchris.com Vipul Ved Prakash, mail@vipul.net =head1 SEE ALSO syslog(3), Sys::Syslog(3), syslogd(8), Unix::Syslog(3), IO::Socket, perl(1) =cut