apps: initial scan.pl

Reads a binkley-style inbound directory and handles both
ARCmail (ZIP only) and *.PKT files, other files are ignored.

Mails are imported in the message base, successfully handled
files are deleted.

diff --git a/apps/scan.pl b/apps/scan.pl
new file mode 100755 (executable)
index 0000000..b4f1a65
--- /dev/null
+++ b/apps/scan.pl
@@ -0,0 +1,136 @@
+#!/usr/bin/perl -w
+use strict;
+use v5.012;
+
+use File::Temp qw/tempdir/;
+use Data::Dumper;
+
+use lib '../modules';
+use CONFIG;
+use FIDOMAIL;
+use MSGBASE;
+
+# global structures
+my %handles;
+my %counter;
+
+# function declarations
+sub dispatch($);       # handles inbound-like directory
+sub handle_mail($);    # handles single mail
+
+sub main()
+{
+       if(!$ARGV[0]) {
+               say "Usage: $0 <inbound>";
+               say "\tinbound: path to binkley-style inbound";
+               return(1);
+       }
+
+       my $fails = dispatch($ARGV[0]);
+       say "Finished with $fails errors.";
+
+       # close areas
+       foreach(keys %handles) {
+               MSGBASE::area_close($handles{$_});
+       }
+
+       # print statistics
+       my $total=0;
+       foreach(sort keys %counter) {
+               say "\t$_:\t$counter{$_}";
+               $total += $counter{$_};
+       }
+       say "Total: $total";
+
+       return(0);
+}
+
+sub dispatch($)
+{
+       my ($dirname) = @_;
+       my $fail = 0;
+
+       opendir(my $dh, $dirname) or die("Can't open $dirname: $!");
+       while(my $file = readdir $dh) {
+               next if($file =~ /^\.{1,2}$/);
+
+               if($file =~ /^[0-9a-f]{8}\.(mo|tu|we|th|fr|sa|su)[0-9a-z]$/i) {
+               # ARCMAIL bundle - assume ZIP
+                       # -> create temp dir, unzip, dispatch, delete file
+                       say "[ZIP] $dirname/$file";
+                       my $tempdir = File::Temp->newdir();
+                       my $ret = system(
+                               "unzip",                # ZIP
+                               "-d$tempdir",           # extract to tempdir
+                               "-Coj",                 # overwrite, no path
+                               "-qq",                  # very quiet
+                               "$dirname/$file",       # zipfile
+                       );
+                       $ret >>= 8;
+                       if($ret != 0) {
+                               warn("Error unpacking $dirname/$file!\n");
+                               $fail++;
+                               next;
+                       }
+
+                       $ret = dispatch($tempdir);
+                       if($ret == 0) {
+                               # file successfully handled -> remove
+                               unlink("$dirname/$file");
+                       } else {
+                               say "[ZIP] $dirname/$file failed";
+                               $fail += $ret;
+                       }
+
+               } elsif($file =~ /[0-9a-f]{8}\.PKT/i) {
+               # PACKED MESSAGES
+                       say "[PKT] $dirname/$file";
+                       my $messages =
+                               FIDOMAIL::read_packet_file("$dirname/$file");
+
+                       if(!$messages) {
+                               $fail++;
+                               next;
+                       }
+
+                       foreach(@$messages) {
+                               my $mail = FIDOMAIL::read_message($_);
+                               if(!$mail || !handle_mail($mail)) {
+                                       $fail++;
+                                       next;
+                               }
+                       }
+
+                       unlink("$dirname/$file");
+               } else {
+                       say "[???] $dirname/$file ignored";
+               }
+       }
+       closedir($dh);
+
+       return($fail);
+}
+
+sub handle_mail($)
+{
+       my ($mail) = @_;
+
+       if(!$mail->{area}) {
+               # NETMAIL
+               # (TODO) check special destinations
+               $mail->{area} = $CONFIG::config{netmail};
+       }
+
+       $handles{$mail->{area}} = MSGBASE::area_open($mail->{area})
+               unless($handles{$mail->{area}});
+       $counter{$mail->{area}} = 0 unless(defined $counter{$mail->{area}});
+       if(MSGBASE::mail_add($handles{$mail->{area}}, $mail)) {
+               $counter{$mail->{area}}++;
+       }
+
+       return(1);
+}
+
+
+main();
+