#!/usr/bin/perl

use strict;
use warnings;

use Getopt::Long;
use File::Spec::Functions;
use File::Copy;
use File::Path qw(make_path remove_tree);
use Cwd 'abs_path';
use Archive::Zip qw(:ERROR_CODES);

my $vers = '0.0.0.2';

abs_path($0) =~ /^(.*?)[\\\/]([^\\\/]+)$/;
my ( $curpath, $programfile ) = ( $1, $2 );

my ( %globals, $inbound, $uuedir, $needhelp, $logfile, $reportfile, $quiet );

sub usage()
{
    print <<US;
    
    This program is designed to extract uue from packets in protected inbound,
    including zipped echo bundls.

    $programfile [options]
    Options:
        -h,--help		this text
        -l,--log		log file name. Optional.
        -o,--out        where to place decoded files. Default current path.
        -i,--in         where to find incoming mail, i.e. youre protected
                        inbound.
        -r,--report     Report file name. Optional.
        -q,--quiet      Quiet mode. No logs on the screen.
US
exit;
}

sub writelog($)
{
    my ( $str ) = @_;
    my ($sec,$min,$hour,$mday,$month,$year) = (localtime)[0...5];
    my $timestamp = sprintf("%04d-%02d-%02d %02d:%02d:%02d ",
                            $year+1900, $month+1, $mday, $hour, $min, $sec);
    $str =~ s/\n/\n$timestamp/g;
    if ( defined( $logfile ) ) {
        if ( open( my $FLOG, '>>', $logfile ) ) {
            print( $FLOG "$timestamp$str\n" );
            close( $FLOG );
        } else {
            print( STDERR "Can't open logfile $logfile. ($!)\n" );
        }
    }
    print( "$timestamp$str\n" ) unless $quiet;
}

sub mktree($)
{
	my ( $msgbasefile ) = @_;
	my ( $err );
		make_path( $msgbasefile, { mode => 0755, error => \$err } ) unless -d $msgbasefile;
		if ( $err && @$err ) {
			for my $diag ( @$err ){
				my ($file, $message) = %$diag;
				if ($file eq '') {
					writelog( "General error: $message");
				} else {
            		writelog( "Problem making $file: $message");
        		}
    		}
			return 0 ;
		}
	return 1;
}


sub prety_size($)
{
	my ( $fs ) = @_;
	return 0 unless defined $fs;
	if ( $fs >= 1048576 ) {
		return sprintf( "%.3f Mb", $fs/1048576 );
	}elsif ($fs >= 1024) {
		return  sprintf( "%.3f kb", $fs/1024 );
	} else {
		return  sprintf( "%d b", $fs );
	}
}

my ( %grandtotals, $grandtotalfiles, $grandtotalsize );

sub uu_decode($;$$)
{
	my ( $marea, $uuedir, $overwrite ) = @_;
	my ( $uudecoded_data, @uuelines, $decdir, $ofile,
		$filesize, $totalsize, $encoded_data, $resfilename );

	if ( defined( $uuedir ) ){
		if ($uuedir =~ /(.*)[\\\/]$/){
			$uuedir = $1;
		}
	}
	my ($i, $d) = (0, $uuedir);
	while ( -e $uuedir && !-d $uuedir) {
		$uuedir = sprintf( "$d\.%04x", $i);
		$i++;
		if ($i >= 65535) { # maximum files for FA32 file system.
			print STDERR "So may files \"$uuedir\".\n";
			return 1;
		}
	}
	mktree( $uuedir ) if !-e $uuedir;
    # директория, в которой складывать разююки.
	$i = 1;
	$totalsize = 0;
	my $files = 0;
	$decdir = catfile( $uuedir, uc($marea) );
	while ( $globals{msgtext} =~ /[\r\n]*begin \d+\s+([^\r\n]+)[\r\n]+([^ ]*?[\r\n]+)end[\r\n]+/i ){
	    @uuelines = split(/\r\n?/,$2);
		$resfilename = $1;
		$resfilename = $1 if $resfilename =~ /[\\\/]([^\\\/]+)$/;
		mktree( $decdir ) if !-e $decdir;
	    $ofile = catfile( $decdir,  $resfilename );
	    $globals{msgtext} =~ s/[\r\n]*begin \d+\s+([^\r\n?]+)[\r\n]+[^ ]*?[\r\n]+end[\r\n]+/\r\n/i;
	    next if !$overwrite && -e $ofile;
	    if (open(F, ">$ofile")){
		binmode(F);
		foreach my $val ( @uuelines ){
		    $uudecoded_data = unpack("u", $val);
		    print(F $uudecoded_data) if defined $uudecoded_data;
		}
		close(F);
		$filesize = -s $ofile;
		$totalsize += $filesize;
        $grandtotals{$marea} .= " $1 (" .
								sprintf( "% 11s", prety_size( $filesize )) .
								" )\n";
		$grandtotalfiles++;
		$grandtotalsize += $filesize;
		writelog( sprintf( " $1 \( % 11s \) from $marea.", prety_size( $filesize ) ) );
		undef @uuelines;
		$#uuelines = -1;
		undef $uudecoded_data;
		$i = 0;
		$files++;
	    } else {
		print STDERR "Can't open \"$ofile\"\: $!\.\n";
		writelog("Can't open \"$ofile\"\: $!\.");
	    }
	}

	my $b64fn;
	while ( $globals{msgtext} =~ /\r\n?Content\-type\: [^\r\n]+\; name\=\"([^\r\n]+)\"\r\n?Content\-transfer\-encoding\: base64\r\n?[\r\n]*([A-Z0-9\+\/\=\r\n]+)/i ){
	    $b64fn = $1;
	    $encoded_data = $2;
		$b64fn = $1 if $b64fn =~ /[\\\/]([^\\\/]+)$/;
	    $ofile = catfile( $decdir, $b64fn );
		mktree( $decdir ) if !-e $decdir;
	    $globals{msgtext} =~ s/\r\n?Content\-type\: [^\r\n]+\; name\=\"[^\r\n]+\"\r\n?Content\-transfer\-encoding\: base64\r\n?[\r\n]*[A-Z0-9\+\/\=\r\n]+/\r\n/i;
	    next if !$overwrite && -e $ofile;
	    print "Base64 found.\n";
	    $encoded_data =~ s/[\r\n]//g;
	    if (open(F, ">$ofile")){
		binmode(F);
		print(F decode_base64($encoded_data));
		close(F);
		$filesize = -s $ofile;
		$totalsize += $filesize;
		writelog( sprintf( " $b64fn \( % 11s \) from $marea.", prety_size( $filesize ) ) );
		$i = 0;
		$files++;
		undef $encoded_data;
	    } else {
		print STDERR "Can't open \"$ofile\"\: $!\.\n";
		writelog("Can't open \"$ofile\"\: $!\.");
	    }
	}
	writelog( "----------------------------------------------------------\n".
          sprintf( " Total decoded $files files, \(% 12s \)\.\n",
					prety_size( $totalsize ) ) ) if $files > 0;

return $i;
}


sub readPKT($)
{
	my ( $pktfilename ) = @_;
	my ( $PKTF, $badname, $pkthdr, $oldcr, $pktver, $version, $attr,
		$cost, $hdr, $dateTime, $ToName, $FromName, $Subj, $area, $msgid_addr,
		$origAddr, $destAddr, $pktfrom, $pktto, $msgbase, $MBhandle,
		$fidomsgid, $netmfilename );

	unless ( open( $PKTF, '<', $pktfilename ) ){
		print(STDERR "Can't open $pktfilename. ($!).\n");
		writelog("Can't open $pktfilename. ($!).");
		return 0;
	}
	if ( read( $PKTF, $pkthdr, 0x3a ) != 0x3a ) {
	    close( $PKTF );
	    writelog("Broken packet - invalid header size.");
	    return 0;
	}
	my ($origNode,$destNode,$year,$month,$day,$hour,$minute,
		$seconds,$baud,$type,$origNet,$destNet,
	     # Follows Type2+ packet fields...
		$ProductCode,$RevMaj,$Password,$QMOrigZone,$QMDestZone,
		$AuxNet,$CapValidate,$PCodeHi,$RevMin,$Cap,$origZone,
		$destZone,$origPoint,$destPoint,$appdata) =
			unpack('S2S3S3 S2S2 C2A8S2S2 C2SS4I',$pkthdr);
	( $pktfrom, $pktto ) = ( "$origZone:$origNet/$origNode.$origPoint", "$destZone:$destNet/$destNode.$destPoint" );
	$globals{pktfrom} = $pktfrom;
	writelog("   from $pktfrom to $pktto");
#--- read msg ---
	undef $globals{msgtext};
	$oldcr = $/;
	while( read( $PKTF, $version, 2 ) == 2 &&
								( $pktver = unpack( 'S', $version ) ) == 2 ) {
		
		if( read( $PKTF, $hdr, 12 ) != 12 ) {
			close( $PKTF );
			writelog("Broken packet - invalid message header.");
			return 0;
		}

		( $origNode, $destNode, $origNet, $destNet, $attr, $cost ) =
															unpack( 'S6', $hdr );
		$/="\0";
		$dateTime=<$PKTF>;
		chop $dateTime;
		$ToName=<$PKTF>;
		chop $ToName;
		$FromName=<$PKTF>;
		chop $FromName;
		$Subj=<$PKTF>;
		chop $Subj;
		$globals{msgtext}=<$PKTF>;
		chop $globals{msgtext};
		$/=$oldcr;

		if(length($dateTime)>19||length($ToName)>35||
			length($FromName)>35||length($Subj)>71) {
			writelog( "Warning: Bad field(s) length (too long)!" );
		}
		$globals{msgtext} .= "\r" unless( $globals{msgtext} =~ /\r$/s );
		undef $area;
		if( $globals{msgtext} =~ /^AREA:\s*(\S+)\r\n?/m ) {
			$area = uc( $1 );
			undef $area if($area eq 'NETMAIL');
		}
		if( defined( $area ) ) {
			uu_decode( $area, $uuedir, 1 );
		} else {
			# is NETMAIL
			uu_decode( 'NetMail', $uuedir, 1 );
		}

	}
# --- end of read msg ---
	writelog('Warning! Unexpected end of PKT.') unless $pktver == 0;
    close( $PKTF );
	unlink $pktfilename;
	undef $globals{msgtext};
	return 1;
}

sub copyPKT ( $ )
{
	my ( $pktdir ) = ( @_ );

    my ( @pkts, $PKTD, $pktfname );
	writelog( "Copying PKT to work dir." );
    if ( opendir( $PKTD, $pktdir ) ){
		while( readdir( $PKTD ) ){
	    	if ( $_ =~ /\.pkt/i ){
				$pktfname = $_;
				copy( catfile( $pktdir, $pktfname ), $globals{tmppktdir} );
				writelog("$pktfname copyed to $globals{tmppktdir}");
	    	}
		}
		close( $PKTD );
    } else {
		writelog("Can't open $pktdir. ($!).");
    }
	writelog( "Copying PKT to work dir done." );
}

sub readpktdir($)
{
	my ( $pktdir ) = @_;
    my $pktlist = '';
    my ( @pkts, $PKTD, $pktfname );
    print "Reading PKT dir.\n";
    if ( opendir( $PKTD, $pktdir ) ){
		while( readdir( $PKTD ) ){
	    	if ( $_ =~ /\.pkt/i ){
				print " $_\n";
				$pktlist .= " $_";
	    	}
		}
		close( $PKTD );
    } else {
		writelog("Can't open $pktdir. ($!).");
    }

    foreach my $pkt ( sort split( ' ', $pktlist ) ) {
		writelog("Reading $pkt");
		$pktfname = catfile( $pktdir, $pkt );
		readPKT( $pktfname );
    }
	print "Reading PKT dir done.\n";
}

sub readbandles($)
{
	my ( $pktdir ) = @_;
    my $pktlist = '';
    my ( $pkt, @pkts, $PKTD, $zip, @fnames, $fname, $bname, $status );

	writelog( "Rading $pktdir" );
    if ( opendir( $PKTD, $pktdir ) ){
		while( readdir( $PKTD ) ){
	    	if ( $_ =~ /^[A-F0-9]{8}\.(su|mo|tu|we|th|fr|sa)[0-9a-z]$/i ){
				print( "$_\n" );
				$pkt = $_;
				$bname = catfile( $pktdir, $pkt );
				$zip = Archive::Zip->new();
				if ( -s $bname == 0 ) {
					writelog( "Deleting zero sized \'$pkt\'." );
					writelog( "Error! Can't delete \'$pkt\'." ) unless unlink $bname;
					next;
				}
				$status  = $zip->read( $bname );
				if ( $status != AZ_OK ) {
					writelog( "Read of $pkt failed.");
					next;
				}
				@fnames = $zip->memberNames();
				foreach $fname ( @fnames ) {
					$zip->extractMemberWithoutPaths( $fname, catfile( $globals{tmppktdir}, $fname ) );
				}
				readpktdir( $globals{tmppktdir} );
	    	}
		}
		close( $PKTD );
    } else {
		writelog("Can't open $pktdir. ($!).");
    }

}

sub appendfile($$)
{
	my ( $filename, $buff ) = @_;
	my ( $HANDLE );

	if ( open ( $HANDLE, '>>', $filename ) ) {
	    print( $HANDLE $buff );
	    close( $HANDLE );
	} else {
	    writelog( "Can't open $filename ($!)." );
	}
}


sub report()
{
    return unless defined $grandtotalsize;

    my ($sec,$min,$hour,$mday,$month,$year) = (localtime)[0...5];
    appendfile( $reportfile, sprintf("\n\n--- %04d-%02d-%02d %02d:%02d:%02d ------------\n\n",
                            $year+1900, $month+1, $mday, $hour, $min, $sec) );

	foreach my $marea ( sort %grandtotals ) {
            appendfile( $reportfile, "Echoarea: $marea\n$grandtotals{$marea}\n" )
				if defined $grandtotals{$marea};
			# print STDERR "$marea\n$grandtotals{$marea}\n";
	}
		appendfile( $reportfile, 
					"-------------------------------------------------------------------------\n" .
					"Total files: $grandtotalfiles, total size: " .
					prety_size( $grandtotalsize ) . "\n" );
}

# -- MAIN ---->

  my $options = join( ' ', @ARGV );

  GetOptions (
            "out=s"       => \$uuedir,
			"in=s"        => \$inbound,
			"report=s"    => \$reportfile,
			"quiet"       => \$quiet,
            "help"        => \$needhelp,
            "log=s"       => \$logfile
	    )or die("Error in command line arguments\n");
  
  if ( defined( $needhelp ) || !defined( $inbound ) ) {
    usage();
  }

  $grandtotalfiles = 0;
  $uuedir = catfile( $curpath, 'UUE' ) unless defined $uuedir;
  $globals{tmppktdir} = catfile( $inbound, 'pktdir.tmp' );
  mktree( $globals{tmppktdir} ) unless -e $globals{tmppktdir};

  writelog( "[$$] $programfile (v.$vers) $options" );

  copyPKT( $inbound );

  readpktdir( $globals{tmppktdir} );

  readbandles( $inbound );

  report() if $reportfile;