1#!/usr/local/bin/perl -sw
2##
3## Razor2::Client::Agent -- UI routines for razor agents.
4##
5## Copyright (c) 2002, Vipul Ved Prakash.  All rights reserved.
6## This code is free software; you can redistribute it and/or modify
7## it under the same terms as Perl itself.
8##
9## $Id: Agent.pm,v 1.98 2006/10/18 06:15:08 rsoderberg Exp $
10
11package Razor2::Client::Agent;
12
13use lib qw(lib);
14use strict;
15use Getopt::Long;
16use IO::File;
17
18use Razor2::String qw(fisher_yates_shuffle);
19
20use base qw(Razor2::Client::Core);
21use base qw(Razor2::Client::Config);
22use base qw(Razor2::Logger);
23use base qw(Razor2::String);
24use Razor2::Preproc::Manager;
25use Data::Dumper;
26use vars qw( $VERSION $PROTOCOL );
27
28
29$PROTOCOL = $Razor2::Client::Version::PROTOCOL;
30$VERSION  = $Razor2::Client::Version::VERSION;
31
32
33
34sub new {
35    my ($class, $breed) = @_;
36
37    # For Taint Friendliness
38    delete $ENV{PATH};
39    delete $ENV{BASH_ENV};
40
41    my @valid_program_names = qw(
42            razor-check
43            razor-report
44            razor-revoke
45            razor-admin
46    );
47
48    my $ok = 0;
49    foreach (@valid_program_names) { $breed =~ /$_$/ and $ok = $_; }
50    unless ($ok) {
51        if ($breed =~ /razor-client$/) {
52            # We no longer create symlinks, but for backwards compatibility
53            # return success.
54            exit 0;
55        }
56        die "Invalid program name, must be one of: @valid_program_names\n";
57    }
58
59    $ok =~ /razor-(.*)$/;
60    my %me = (
61            name_version => "Razor-Agents v$VERSION",  # used in register
62            breed        => $1,
63            preproc      => new Razor2::Preproc::Manager (no_deHTMLcomment => 1),
64            preproc_vr8  => new Razor2::Preproc::Manager (no_deHTML => 1),
65            global_razorhome => '/usr/local/etc',
66    );
67
68
69    return bless \%me, $class;
70}
71
72sub do_conf {
73    my $self = shift;
74
75    # parse config-related cmd-line args
76    #
77
78    # identity is parsed later after razorhome is fully resolved
79
80    if ($self->{opt}->{config}) {
81        if ($self->{opt}->{create_conf}) {
82            $self->{razorconf} = $self->{opt}->{config};
83        } elsif (-r $self->{opt}->{config}) {
84            $self->{razorconf} = $self->{opt}->{config};
85        } else {
86            return $self->error("Can't read conf file: $self->{opt}->{config}")
87        }
88    }
89    if ($self->{opt}->{razorhome}) {
90        if (-d $self->{opt}->{razorhome}) {
91            $self->{razorhome} = $self->{opt}->{razorhome};
92        } else {
93            return $self->error("Can't read: $self->{opt}->{razorhome}")
94                unless $self->{opt}->{create_conf};
95        }
96        # once razorhome is successfully overridden, override the global razorhome as well.
97        $self->{global_razorhome} = $self->{razorhome};
98    }
99    return unless $self->read_conf();
100
101    if ($self->{opt}->{create_conf}) {
102        $self->{force_discovery} = 1;
103        $self->{force_bootstrap_discovery} = 1;
104        $self->log(8," -create will force complete discovery");
105    }
106    if ($self->{opt}->{force_discovery}) {
107        $self->{force_discovery} = 1;
108        $self->{force_bootstrap_discovery} = 1;
109        $self->log(8," -discover will force complete discovery");
110    }
111    if ($self->{opt}->{debug} && !$self->{opt}->{debuglevel}) {
112        $self->{conf}->{debuglevel} ||= 9;
113        $self->{conf}->{debuglevel} = 9 if $self->{conf}->{debuglevel} < 9;
114    }
115
116
117    #
118    # Note: we start logging before we process '-create' ,
119    # so logfile will not go into a newly created razorhome
120    #
121    #my $logto = $self->{opt}->{debug} ? "stdout" : "file:$self->{conf}->{logfile}";
122    my $logto;
123    if ($self->{opt}->{debug}) {
124        $logto = 'stdout';
125    } elsif ($self->{conf}->{logfile} eq 'syslog') {
126        $logto = 'syslog';
127    } elsif ($self->{conf}->{logfile} eq 'sys-syslog') {
128        $logto = 'sys-syslog';
129    } else {
130        $logto = "file:$self->{conf}->{logfile}";
131    }
132    if (exists $self->{conf}->{logfile}) {
133        my $debuglevel = exists $self->{conf}->{debuglevel} ? $self->{conf}->{debuglevel} : 9;
134        my $logger = new Razor2::Logger (
135                        LogDebugLevel => $debuglevel,
136                        LogTo         => $logto,
137                        LogPrefix     => $self->{breed},
138                        LogTimestamp  => 1,
139                        DontDie       => 1,
140                        Log2FileDir   => defined($self->{conf}->{tmp_dir}) ? $self->{conf}->{tmp_dir} : "/tmp",
141                     );
142        $self->{logref} = ref($logger) ? $logger : 0;
143        # log error strings at loglevel 11.  Pick a high number 'cuz
144        # if its really an error, it will be in errstr for caller
145        $self->{logerrors} = 11;
146    }
147    $self->logobj(15,"cmd-line options", $self->{opt});
148    $self->{preproc}->{rm}->{log} = $self->{logref};
149
150    # creates razorhome, and sets $self->{razorhome} if successful
151    return $self->errprefix("Could not create 'razorhome'") unless $self->create_home_conf();
152    $self->compute_identity;
153
154    $self->log(5,"computed razorhome=$self->{razorhome}, conf=$self->{razorconf}, ident=$self->{identity}");
155    return 1;
156}
157
158# if a debug log statement requires extra work, check this call before doing it.
159sub logll {
160    my ($self, $loglevel) = @_;
161    return unless $self->{logref};
162    return 1 if ($self->{logref}->{LogDebugLevel} >= $loglevel);
163    return;
164}
165
166sub create_home_conf {
167    my $self = shift;
168
169    unless ($self->{opt}->{create_conf}) {
170        #
171        # if the global razorhome exists, don't create anything
172        # without '-create' option
173        #
174        return 1 if (-d $self->{global_razorhome});
175
176        #
177        # if there is not global razorhome,
178        # try to create razorhome one anyway.
179        # if it fails, thats ok.
180        #
181        $self->create_home($self->{razorhome_computed});
182        $self->errstrrst;  # nuke error string
183        return 1;
184    }
185
186    #
187    # user passed in 'create' option, so create.
188    #
189    my $rhome = $self->{opt}->{razorhome}
190              ? $self->{opt}->{razorhome}
191              : $self->{razorhome_computed};
192
193    if ($rhome) {
194
195        if (-d $rhome) {
196            $self->log(6,"Not creating razorhome $rhome, already exists");
197        } else {
198            return unless $self->create_home($rhome);
199        }
200    }
201
202
203    if ($self->{opt}->{config}) {
204
205        # if create and conf specified, exit if write is not successful
206        #
207        $self->{razorconf} = $self->{opt}->{config};
208        return $self->write_conf();
209
210    } else {
211
212        # else just try and create, if fail ok.
213        #
214        $self->compute_razorconf();
215        $self->{razorconf} ||= $self->{computed_razorconf};
216        $self->write_conf();
217        $self->errstrrst;  # nuke error string
218    }
219    return 1;
220}
221
222# wrapper for log
223sub log {
224    my $self = shift;
225    my $level = shift;
226    my $msg = shift;
227
228    if ($self->{logref}) {
229        return  $self->{logref}->log($level, $msg);
230    } elsif ($self->{opt}->{debug}) {
231        print " Razor-Log: $msg\n" if $self->{opt}->{debug};
232    }
233}
234sub log2file {
235    my $self = shift;
236    return unless $self->{logref};
237    return        $self->{logref}->log2file(@_);
238}
239
240sub doit {
241    my $self = shift;
242    my $args = shift;
243    my $r;
244
245    $self->log(2," $self->{name_version} starting razor-$self->{breed} $self->{args}");
246#    $self->log(9,"uname -a: ". `uname -a`) if $self->logll(9);
247
248    $r = $self->checkit($args)    if $self->{breed} eq 'check';
249    $r = $self->adminit($args)    if $self->{breed} eq 'admin';
250    $r = $self->reportit($args)   if $self->{breed} eq 'report';
251    $r = $self->reportit($args)   if $self->{breed} eq 'revoke';
252
253    # return exit code
254    # 0, 1 => ok
255    #  > 1 => error  (caller should prolly print $self->errstr)
256    #
257    if ($r > 1) {
258        my $msg = $self->errstr;
259        $self->log(1,"razor-$self->{breed} error: ". $msg);
260    } else {
261        $self->log(8,"razor-$self->{breed} finished successfully.");
262    }
263    return $r;
264}
265
266
267sub _help {
268    my ($self,$breed) = @_;
269
270    chomp(my $all = <<EOFALL);
271            -h  Print this usage message.
272            -v  Print version number and exit
273            -d  Turn on debugging.  Logs to stdout.
274            -s  Simulate Only.  Does not connect to server.
275    -conf=file  Use this config file instead of <razorhome>/razor.conf
276     -home=dir  Use this as razorhome
277   -ident=file  Use this identity file instead of <razorhome>/identity
278           -rs  Use this razor server instead of reading .lst
279EOFALL
280    chomp(my $sigs = <<EOFSIGS);
281            -H  Compute and print signature.
282   -S |  --sig  Accept a signatures to check on the command line
283        -e eng  Engine used to compute sig, integer
284      -ep4 val  String value required when engine == 4
285EOFSIGS
286
287    chomp(my $mbox = <<EOFMBOX);
288   -M | --mbox  Accept a mailbox name on the command line (default)
289                If no filename, mbox, or signatures, input read from stdin.
290EOFMBOX
291
292    my %b;
293    $b{check} = <<EOFCHECK;
294
295razor-check [options] [ filename | -M mbox | -S signatures | < filename ]
296$all
297$sigs
298$mbox
299
300See razor-check(1) manpage for details.
301
302EOFCHECK
303
304    $b{report} = <<EOFREPORT;
305
306razor-report [options] [ filename | -M mbox | -S signatures -e engine]
307$all
308$sigs
309$mbox
310       -i file  Use identity from this file
311            -f  Stay in foreground.
312            -a  Authenticate only.  Exit 0 if authenticated, 1 if not
313                Stays in foreground.
314
315See razor-report(1) manpage for details.
316
317EOFREPORT
318
319    $b{admin} = <<EOFREGISTER;
320
321razor-admin [options] [ -register | -create | -discover ]
322$all
323       -create  Create razorhome, does discover, does not register
324     -discover  Discover Razor servers: write .lst files
325     -register  Register a new identity
326    -user name  Request 'name' when registering (requires -register)
327    -pass pass  Request 'password' when registering (requires -register)
328            -l  Make new identity the the default identity.
329                Used only when registering.
330
331See razor-admin(1) manpage for details.
332
333EOFREGISTER
334
335    $b{revoke} = <<EOFREVOKE;
336
337razor-revoke [options] filename
338$all
339$mbox
340       -i file  Use identity from this file
341            -f  Stay in foreground.
342            -a  Authenticate only.  exit 0 if authenticated, 1 if not
343                Stays in foreground.
344
345See razor-revoke(1) manpage for details.
346
347EOFREVOKE
348
349    my $future = <<EOFFUTURE;
350EOFFUTURE
351
352    return $b{$self->{breed}};
353}
354
355
356# maybe this should be in Client::Config
357#
358sub read_options {
359    my ($self, $agent) = @_;
360    $self->{args} = join ' ', @ARGV;
361    Getopt::Long::Configure ("no_ignore_case");
362    my %opt;
363    #
364    # These options override what is loaded in config file
365    # the names on the right should match keys in config file
366    #
367    my $ret = GetOptions(
368        's'   => \$opt{simulate},
369        'd'   => \$opt{debug},
370  'verbose'   => \$opt{debug},
371        'v'   => \$opt{version},
372        'h'   => \$opt{usage},
373     'help'   => \$opt{usage},
374        'H'   => \$opt{printhash},
375      'C=s'   => \$opt{printcleaned},
376    'sig=s'   => \$opt{sig},
377      'S=s'   => \$opt{sig},
378      'e=s'   => \$opt{sigengine},
379    'ep4=s'   => \$opt{sigep4},
380     'mbox'   => \$opt{mbox},
381        'M'   => \$opt{mbox},
382        'n'   => \$opt{negative},
383   'conf=s'   => \$opt{config},
384 'config=s'   => \$opt{config},
385   'home=s'   => \$opt{razorhome},
386        'f'   => \$opt{foreground},
387     'noml'   => \$opt{noml},
388   'user=s'   => \$opt{user},
389      'u=s'   => \$opt{user},
390   'pass=s'   => \$opt{pass},
391        'a'   => \$opt{authen_only},
392     'rs=s'   => \$opt{server},
393 'server=s'   => \$opt{server},
394        'r'   => \$opt{register},
395 'register'   => \$opt{register},
396        'l'   => \$opt{symlink},
397      'i=s'   => \$opt{identity},
398  'ident=s'   => \$opt{identity},
399   'create'   => \$opt{create_conf},
400'logfile=s'   => \$opt{logfile},
401 'discover'   => \$opt{force_discovery},
402     'dl=s'   => \$opt{debuglevel},
403'debuglevel=s' => \$opt{debuglevel},
404'whitelist=s' => \$opt{whitelist},
405     'lm=s'   => \$opt{logic_method},
406     'le=s'   => \$opt{logic_engines},
407    );
408
409    if ($ret == 0) {
410        $self->error("failed to parse command line options.\n");
411        return;
412    }
413
414    # remove elements not set in the cmd-line
415    foreach (keys %opt) { delete $opt{$_} unless defined $opt{$_}; }
416
417    if ($opt{usage}) {
418        $self->error($self->_help);
419        return;
420    } elsif ($opt{mbox} && $opt{sig}) {
421        $self->error("--mbox and --sig are mutually exclusive.\n");
422        return;
423    } elsif ($opt{sig} && !$opt{sigengine}) {
424        $self->error("--sig requires -e (engine used to generate sig)\n");
425        return;
426        #
427        # fixme - require ep4 if -e 4 is used ?
428        #
429    } elsif ($opt{version}) {
430        $self->error("Razor Agents $VERSION, protocol version $PROTOCOL");
431        return;
432    }
433    $self->{opt} = \%opt;
434    return 1;
435}
436
437
438
439# returns 0 if match (spam)
440# returns 1 if no match (legit)
441# returns 2 if error
442sub checkit {
443
444    my $self = shift;
445    my $args = shift;
446
447    # check for spam.
448    # input can be one of
449    #   file - single mail
450    #   mbox - many  mail
451    #   sig  - 1 or more sigs
452    #   or a filehandle provided via args
453
454    my $objects;
455    if ($self->{conf}->{sig}) {
456        my @sigs;
457        #
458        # cmd-line sigs
459        #
460        # prepare 1 mail object per sig
461        #
462        foreach my $sig (split ',', $self->{conf}->{sig}) {
463            $sig =~ s/^\s*//;  $sig =~ s/\s*$//;
464            my $hr = {
465                eng => $self->{conf}->{sigengine},
466                sig => $sig,
467            };
468            $hr->{ep4} = "7542-10";
469            $hr->{ep4} = $self->{conf}->{sigep4} if $self->{conf}->{sigep4};
470            push @sigs, $hr;
471        }
472        $self->log (5,"received ". (scalar @sigs) ." valid cmd-line sigs.");
473        $objects = $self->prepare_objects(\@sigs) or return 2;
474    } else {
475
476        my $mails = $self->parse_mbox($args) or return 2;
477
478        $objects  = $self->prepare_objects($mails) or return 2;
479
480        #
481        # if mail is whitelisted, its not spam.
482        # flag it so it we don't check it against server
483        #
484        foreach my $obj (@$objects) {
485            if ($self->local_check($obj)) {
486                $obj->{skipme} = 1;
487                $obj->{spam} = 0;
488            } else {
489                next;
490            }
491        }
492
493    }
494
495    # compute_sigs needs server info like ep4, so get_server_info first
496    $self->get_server_info()                            or return 2;
497    my $printable_sigs = $self->compute_sigs($objects)  or return 2;
498
499    if ($self->{opt}->{printhash}) {
500        my $i = 0;
501        foreach (@$printable_sigs) {
502            if ($self->{opt}->{sigengine}) {
503                next unless (/ e$self->{opt}->{sigengine}: /);
504            }
505            print "$_\n";
506            $i++;
507        }
508        $self->log (4, "Done. Printed $i sig(s) for ". scalar(@$objects) ." mail(s)");
509    }
510    if ($self->{opt}->{printcleaned}) {
511        my $totalp = 0;
512        my $totalc = 0;
513        foreach my $obj (@$objects) {
514            my $n = 0;
515            mkdir("$self->{opt}->{printcleaned}/cleaned");
516            foreach ($obj->{headers}, @{$obj->{bodyparts_cleaned}}) {
517                my $fn = "$self->{opt}->{printcleaned}/cleaned/mail$obj->{id}.". $n++;
518                $self->write_file($fn, $_);
519                $totalc++;
520            }
521            $n = 0;
522            mkdir("$self->{opt}->{printcleaned}/uncleaned");
523            foreach ($obj->{headers}, @{$obj->{bodyparts}}) {
524                my $fn = "$self->{opt}->{printcleaned}/uncleaned/mail$obj->{id}.". $n++;
525                $self->write_file($fn, $_);
526                $totalp++;
527            }
528        }
529        $self->log (4, "Done. $totalp uncleaned, $totalc cleaned mails saved in $self->{opt}->{printcleaned}");
530        print "Done. $totalp uncleaned, $totalc cleaned mails saved in $self->{opt}->{printcleaned}\n";
531        return 1;
532
533    }
534
535    return 1 if $self->{opt}->{printhash};
536
537    # only check good objects
538    my @goodones;                 # this should be optimized!
539    foreach my $obj (@$objects) {
540        next if $obj->{skipme};
541        push @goodones, $obj;
542    }
543    unless (scalar @goodones) {
544        $self->log (4,"Done.  No valid mail or signatures to check.");
545        return 1;
546    }
547
548    if ($self->{conf}->{simulate}) {
549        $self->log (4, "Done. (simulate only)");
550        return 1;
551    }
552
553    #
554    # Connect to catalogue server
555    #
556    $self->{s}->{list} = $self->{s}->{catalogue};
557    $self->nextserver();
558    $self->connect()          or return 2;
559
560    #
561    # Check against server
562    #
563    $self->check (\@goodones) or return 2;
564    $self->disconnect()       or return 2;
565
566
567    #
568    # print out responses and exit
569    #
570    my $only1check = (scalar(@$objects) == 1) ? 1 : 0;
571    my $has_spam = 0;
572    foreach my $obj (@$objects) {
573
574        $obj->{spam} = 0 if $obj->{skipme};
575        $obj->{spam} = 0 unless defined $obj->{spam};
576
577        if ($obj->{spam} > 0) {
578            return 0 if $only1check;
579            $has_spam = 1;
580            print $obj->{id} ."\n";
581            next;
582
583        } elsif ($obj->{spam} == 0) {
584            return 1 if $only1check;
585            print "-". $obj->{id} ."\n" if $self->{conf}->{negative};
586            next;
587
588        } else {
589            # error
590            #
591            $self->logobj(1,"bad 'spam' in checkit", $obj);
592            return 2 if $only1check;
593            print "-". $obj->{id} ."\n" if $self->{conf}->{negative};
594            next;
595        }
596    }
597    return 0 if $has_spam;
598    return 1;
599}
600
601
602
603# returns 0 if success
604# returns 2 if error
605sub adminit {
606    my $self = shift;
607
608    my $done_something = 0;
609
610    if ($self->{opt}->{create_conf}) {
611        $done_something++;
612        # $self->create_home_conf() is always checked
613    }
614
615    if (  $self->{opt}->{force_discovery} ||
616          $self->{opt}->{create_conf}) {
617        $done_something++;
618        # get_server_info() calls nextserver() which calls discovery()
619        $self->get_server_info()    or return 2;
620    }
621
622    if ($self->{opt}->{register}) {
623        $done_something++;
624        my $r = $self->registerit();
625        return $r if $r;
626    }
627
628    unless ($done_something) {
629        $self->error("An option needs to be specified,  -h for help.");
630        return 2;
631    }
632
633    return 0;
634}
635
636# returns 0 if success
637# returns 2 if error
638sub registerit {
639    my($self, $auto) = @_;
640
641    unless ($self->{razorhome} || $self->{opt}->{identity}) {
642        $self->errprefix("Unable to register without a valid razorhome or identity");
643        return 2;
644    }
645
646    my $ident;
647
648    if (exists $self->{opt}->{user}
649        && ($ident = $self->get_ident)
650        && $ident->{user} eq $self->{opt}->{user} ) {
651        $self->error("You are already registered as user=$ident->{user} in $self->{razorhome}");
652        return 2;
653    }
654    if ($self->{conf}->{simulate}) {
655        $self->log(5,"Done - simulate only.");
656        return 0;
657    }
658
659    if ($self->{opt}->{create_conf}) {
660        $self->log(3, "Register create successful.");
661        return 0;
662    }
663
664    if ($auto) {
665        $self->log(3, "Write test underway");
666        my($ident) = {
667            user    =>  'writetest',
668            pass    =>  'writetest',
669        };
670        my($fn);
671        unless ($fn = $self->save_ident($ident)) {
672            $self->log(3, "Unable to write identity to home");
673            return 2;
674        }
675        unlink($fn) or return 2;
676        $self->log(3, "Write test completed");
677    }
678
679    $self->get_server_info()    or return 2;
680    $self->connect()            or return 2;
681
682    $self->log(3, "Attempting to register.");
683    # attempt to register the user/pass
684    $ident = $self->register_identity($self->{opt}->{user}, $self->{opt}->{pass});
685
686    $self->disconnect()     or return 2;
687
688    unless (ref $ident) {
689        $self->log(3, "Failed to register identity.");
690        return 2;
691    }
692
693    if (my $fn = $self->save_ident($ident)) {
694        my $msg = "Register successful.  Identity stored in $fn";
695        $self->log(3, $msg);
696        print "$msg\n";
697        return 0;
698    } else {
699        $self->log(3, "Register failed.");
700        return 2;
701    }
702}
703
704#
705# handles report and revoke
706#
707# returns 0 if success
708# returns 2 if error
709sub reportit {
710
711    my ($self, $args) = @_;
712
713    my $ident = $self->get_ident;
714    unless ($ident) {
715        $self->log(3, "Razor2 identity not found.  Attempting to register automatically.");
716        if ($self->registerit("auto")) {
717            $self->log(3, "Automatic registration failed.");
718            $self->errprefix("Bootstrap Error: Your Razor2 identity was not found.\n   " .
719                             "  If you haven't registered, please do so:\n" .
720                             "     \"razor-admin -register -user=[name/email_address] -pass=[password]\".\n".
721                             "     (Further information can be found in the razor-admin(1) manpage)\n" .
722                             "  If you did register, please ensure your identity symlink (or file) is in order.\n");
723            return 2;
724        }
725        $ident = $self->get_ident;
726        unless ($ident) {
727            $self->log(3, "Unable to load automatically registered identity.");
728            $self->errprefix("Bootstrap Error: Your Razor2 identity was not found.\n   " .
729                             "  If you haven't registered, please do so:\n" .
730                             "     \"razor-admin -register -user=[name/email_address] -pass=[password]\".\n".
731                             "     (Further information can be found in the razor-admin(1) manpage)\n" .
732                             "  If you did register, please ensure your identity symlink (or file) is in order.\n");
733            return 2;
734        }
735    }
736
737    if (!$self->{opt}{foreground} &&
738        (@ARGV < 1 || $ARGV[0] eq "-" || $ARGV[0] eq "")) {
739        if (-t STDIN) {
740            $self->error("Unable to read from a TTY using STDIN while forked. \n" .
741                         "Doing so leads to undefined behaviour in certain shells.");
742            return 2;
743        }
744    }
745
746    # background myself
747    unless ($self->{opt}->{foreground}) {
748        chdir '/';
749        fork && return 0;
750        POSIX::setsid;
751        # close 0, 1, 2;
752    }
753
754    if ($self->{opt}->{authen_only}) {
755        $self->authenticate($ident) or return;
756        $self->log(5,"Done - authenticate only.");
757        return 0 if $self->{authenticated};
758        return 2;
759    }
760
761    my $mails   = $self->parse_mbox($args) or return 2;
762
763    my $objects = $self->prepare_objects($mails) or return 2;
764
765
766    # compute_sigs needs server info like ep4, so get_server_info first
767    $self->get_server_info()                            or return 2;
768
769    my $printable_sigs = $self->compute_sigs($objects)  or return 2;
770
771    if ($self->{opt}->{printhash}) {
772        foreach (@$printable_sigs) {
773            if ($self->{opt}->{sigengine}) {
774                next unless (/ e$self->{opt}->{sigengine}: /);
775            }
776            print "$_\n";
777        }
778        exit 0;
779    }
780
781    if ( $self->{conf}->{simulate}) {
782        $self->log (4, "Done. (simulate only)");
783        exit 0;
784    }
785    unless (scalar @$objects) {
786        $self->log (4,"Done.  No valid mail or signatures to check.");
787        exit 1;
788    }
789
790    $self->{s}->{list} = $self->{s}->{nomination};
791    $self->nextserver();
792    $self->connect()            or return 2;
793    $self->authenticate($ident) or return 2;
794    $self->report($objects)     or return 2;
795    $self->disconnect()         or return 2;
796
797
798    if ($self->{opt}->{foreground}) {
799        foreach my $obj (@$objects) {
800            # my $line = debugobj($obj->{r});
801            # $line =~ /(\S+=\S+)/s;  # could be res=0|1, err=xxx
802            # print "$obj->{id}: $1\n";
803            #print "$obj->{id}\n" if $obj->{r}->{res} == '1';
804        }
805    }
806    return 0;
807}
808
809
810sub parse_mbox {
811    my ($self, $args) = @_;
812
813    my @mails;
814    my @message;
815    my $passed_fh = 0;
816    my $aref;
817
818    # There are different kinds of mbox formats, we just split on simplest case.
819    # djb defines mbox, mboxrd, mboxcl, mboxcl2
820    # http://www.qmail.org/qmail-manual-html/man5/mbox.html
821    #
822    # non-mbox support added, thanx to Aaron Hopkins <aaron@die.net>
823
824    if (exists $$args{"fh"}) {
825        @ARGV = ();
826        push @ARGV, $$args{'fh'};
827        $passed_fh = 1;
828    } elsif (exists $$args{"aref"}) {
829       $aref = $$args{"aref"};
830    } elsif (!scalar @ARGV) {
831        push @ARGV, "-"
832    }
833
834    if ($$args{'aref'}) {
835        my @foo = (\join'', @{$$args{'aref'}});
836        return \@foo;
837    }
838
839    foreach my $file (@ARGV) {
840        my $fh = new IO::File;
841        my @message = ();
842        if (ref $file) {
843            $fh = $file
844        } else {
845            open $fh, "<$file" or return $self->error("Can't open $file: $!");
846        }
847
848        my $line = <$fh>;
849        next unless $line;
850
851        if ($line =~ /^From /) {
852            $self->log(8,"reading  mbox formatted mail from ".
853                ($file eq '-' ? "<stdin>" : $file));
854            while (1) {
855                push @message, $line;
856                $line = <$fh>;
857                if (!defined($line) || $line =~ /^From /) {
858                    push @mails, \join ('', @message);
859                    @message = ();
860                    last unless defined $line;
861                }
862            }
863        } else {
864            $self->log(8,"reading straight RFC822 mail from ".
865                ($file eq '-' ? "<stdin>" : $file));
866            push @mails, \join ('', map {s/^(>*From )/>$1/; $_} $line, <$fh>);
867        }
868        close $fh unless $passed_fh;
869    }
870
871    my $cnt = scalar @mails;
872    $self->log (6, "read $cnt mail". ($cnt>1 ? 's' : '') );
873
874    return \@mails;
875}
876
877
878
879sub raise_error {
880    my ($self, $errstr) = @_;;
881    my $str;
882    if (ref $self) {
883        $str = $self->errstr;
884    }
885    $str = $errstr if $errstr;
886    my ($code) = $str =~ /Razor Error (\d+):/;
887    $code = 255 unless $code;
888    print "FATAL: $str";
889    exit $code;
890}
891
892# returns 1 if mail should be skipped
893#
894sub local_check {
895    my ($self, $obj) = @_;
896    my ($headers, $body) = split /\n\r*\n/, ${$obj->{orig_mail}}, 2;
897
898    $headers =~ s/\n\s+//sg;  # merge multi-line headers
899
900    if ($self->{conf}->{ignorelist}) {
901        if ($headers =~ /\n((X-)?List-Id[^\n]+)/i) {
902            my $listid = $1;
903            my ($line1) = substr(${$obj->{orig_mail}}, 0, 50) =~ /^([^\n]+)/;
904            $self->log (5,"Mailing List post; mail ". $obj->{id} ." not spam.");
905           #$self->log (5,"Mailing List post; mail ". $obj->{id} ." not spam.\n  $line1\n  $listid");
906            return 1;
907        }
908    }
909    return 0 if $self->{no_whitelist};
910    if (-s $self->{conf}->{whitelist}) {
911        $self->read_whitelist;
912        foreach my $sh (keys %{$self->{whitelist}}) {
913            if ($sh ne 'sha1') {
914                while ($headers =~ /^$sh:\s+(.*)$/img) {
915                    last unless $1;
916                    my $fc = $1;
917                    $self->log (13,"whitelist checking headers for match $sh: $fc");
918                    foreach my $address (@{$self->{whitelist}->{$sh}}) {
919                        if ($fc =~ /$address/i) {
920                            $self->log (3,"ignoring mail $obj->{id}, whitelisted by rule: $sh: $address");
921                            return 1;
922                        }
923                    }
924                }
925            }
926        }
927        $self->log (12,"Whitelist rules did not match mail $obj->{id}");
928    } elsif ($self->{conf}->{whitelist}) {
929        $self->log (6,"skipping whitelist file (empty?): $self->{conf}->{whitelist}");
930        $self->{no_whitelist} = 1;
931    }
932    return 0;
933}
934
935
936
937sub read_whitelist {
938    my ($self) = @_;
939    return if $self->{whitelist};
940
941    my %whitelist;
942    my $lines = $self->read_file($self->{conf}->{whitelist},0,1);
943    for (@$lines) {
944        s/^\s*//;
945        next if /^#/;
946        chomp;
947        my ($type, $value) = split /\s+/, $_, 2;
948        $type =~ y/A-Z/a-z/ if $type;
949        push @{$whitelist{$type}}, $value if ($type && $value);
950    }
951    $self->{whitelist} = \%whitelist;
952    $self->log (8,"loaded ". scalar(keys %whitelist) ." different types of whitelist");
953    #$self->logobj (15,"loaded whitelist:", \%whitelist);
954    return 1;
955}
956
957
958sub logerr {
959    my ($self,$msg) = @_;
960    $msg = $self->errstr unless $msg;
961    $self->log(1,"$self->{breed} error: ". $msg);
962    return;
963}
964
965
966
967# see nextserver() for explanation of how data is stored
968#
969sub get_server_info {
970    my $self = shift;
971
972    unless (exists $self->{s}) { $self->{s} = {}; }
973
974    if ($self->{opt}->{server}) {  # cmd-line
975        $self->{s}->{list} = [$self->{opt}->{server}];
976        $self->log(8,"Using cmd-line server ($self->{opt}->{server}), skipping .lst files");
977    } else {
978        $self->readservers;
979    }
980    $self->loadservercache;
981    #$self->logobj(6,"find_closest_server server info (before nextserver)", $self->{s});
982    $self->{loaded_servers} = 1;
983    return $self->nextserver;  # this will connect and get state info if not cached
984}
985
986
987# see nextserver() for explanation of how data is stored
988#
989sub readservers {
990    my $self = shift;
991
992    unless (exists $self->{s}) { $self->{s} = {}; }
993
994    # read .lst files
995    foreach my $lf (qw(discovery nomination catalogue)) {
996
997        my $h = $self->read_file($self->{conf}->{"listfile_$lf"},0,1) or next;
998        $self->{s}->{$lf} = [];
999        foreach (@$h) {
1000            push @{$self->{s}->{$lf}}, $1
1001                if /^(([^\.\s]+\.)+[^\.\s]+(:\S+)?)/;
1002        }
1003        if (defined($self->{s}->{$lf}) && ref($self->{s}->{$lf})) {
1004            $self->log(11,"Read ". scalar(@{$self->{s}->{$lf}}) ." from server listfile: ".
1005                $self->{conf}->{"listfile_$lf"});
1006        }
1007    }
1008    foreach my $lf (qw(discovery nomination catalogue)) {
1009        next unless defined($self->{s}->{$lf});
1010        next unless ref($self->{s}->{$lf});
1011        next unless @{$self->{s}->{$lf}} > 1;
1012        fisher_yates_shuffle($self->{s}->{$lf});
1013    }
1014    if ($self->{breed} =~ /^check/) {
1015        $self->{s}->{list} = $self->{s}->{catalogue};
1016        $self->{s}->{listfile} = $self->{conf}->{listfile_catalogue}; # for discovery()
1017    } else {
1018        $self->{s}->{list} = $self->{s}->{nomination};
1019        $self->{s}->{listfile} = $self->{conf}->{listfile_nomination}; # for discovery()
1020    }
1021}
1022
1023sub loadservercache {
1024    my $self = shift;
1025
1026    #
1027    # Read in server-specific config, using defaults for stuff not found
1028    #
1029    # NOTE: this reads all server.*.conf files in razor home, not just those in .lst
1030    #
1031
1032    # load defaults for .lst servers
1033    foreach (qw(nomination catalogue)) {
1034        next unless $self->{s}->{$_};
1035        foreach my $server (@{$self->{s}->{$_}}) {
1036            next if $self->{s}->{allconfs}->{$server};  # avoid repeats
1037            $self->{s}->{allconfs}->{$server} = $self->default_server_conf();
1038            $self->log(9,"Assigning defaults to $server");
1039        }
1040    }
1041    my @fns;
1042    my $sep = '\.';
1043    $sep = '_' if $^O eq 'VMS';
1044    if (opendir D,$self->{razorhome}) {
1045        @fns = map {s/_/./g; "$self->{razorhome}/$_";} grep /^server$sep[\S]+\.conf$/, readdir D;
1046        @fns = map { /^(\S+)$/, $1 } @fns; # untaint
1047        closedir D;
1048    }
1049    foreach (@fns) {
1050        /server\.(.+)\.conf$/ and my $sn = $1;
1051        next unless $sn;
1052        $self->{s}->{allconfs}->{$sn} = $self->read_file($_, $self->{s}->{allconfs}->{$sn} );
1053        if ($self->{s}->{allconfs}->{$sn}) {
1054            #$self->log(8,"Loaded server specific conf info for $sn");
1055        } else {
1056            $self->log(5,"loadservercache skipping $_");
1057        }
1058    }
1059
1060    return $self;
1061}
1062
1063
1064sub writeservers {
1065    my $self = shift;
1066
1067    unless ($self->{razorhome}) {
1068        $self->log(5,"no razorhome, not caching server info to disk");
1069        return;
1070    }
1071
1072    foreach (@{$self->{s}->{modified_lst}}) {
1073        my $fn = $self->{conf}->{"listfile_$_"};
1074        $self->write_file($fn, $self->{s}->{$_}, 0, 0, 1)
1075            || $self->log(5,"writeservers skipping .lst file: $fn");
1076    }
1077    $self->log(11,"No bootstrap_discovery (DNS) recently, not recording .lst files")
1078        unless scalar (@{$self->{s}->{modified_lst}});
1079    $self->{s}->{modified_lst} = [];
1080
1081    foreach (@{$self->{s}->{modified}}) {
1082        my $fn = "$self->{razorhome}/server.$_.conf";
1083        my $header = "#\n# Autogenerated by $self->{name_version}, ". localtime() ."\n";
1084        $self->write_file($fn, $self->{s}->{allconfs}->{$_}, 0, $header)
1085            || $self->debug("writeservers skipping $fn");
1086    }
1087    $self->{s}->{modified} = [];
1088    $self->errstrrst;  # nuke error string if write errors
1089    return $self;
1090}
1091
1092
10931;
1094