#!/usr/pkg/bin/perl
#
# $Id: ftninrecomb.pl,v 4.5 1998/09/23 19:23:15 mj Exp $
#
# Recombine split mail and news messages.
#
 
require 5.000;

my $PROGRAM = "ftninrecomb";
 
#use strict;
use vars qw($opt_v $opt_c);
use Getopt::Std;
use FileHandle;

##############################################################################
#
# $Id: config.pl,v 4.4 2001/01/04 20:03:42 mj Exp $
#
# Perl functions to read FIDOGATE config file,
# included by <INCLUDE config.pl> when running subst.pl
#

my %CONFIG;

# specials for DosDrive and Zone
my %CONFIG_dosdrive;
my %CONFIG_zone;



my %CONFIG_default =
    (
##Automatically generated by subst.pl, DO NOT EDIT!!!##
	"uuinbound", "/var/spool/bt/uuin",
	"tick_hold", "%B/tick",
	"history", "%V/history",
	"routing", "%C/routing",
	"seq_news", "%V/seq/news",
	"bindir", "/usr/pkg/lib/fidogate/bin",
	"seq_pkt", "%V/seq/pkt",
	"seq_toss", "%V/seq/toss",
	"newsspooldir", "/var/news/spool/articles",
	"charsetmap", "%L/charset.bin",
	"pinbound", "/var/spool/bt/pin",
	"areas", "%C/areas",
	"toss_toss", "%S/toss/toss",
	"hosts", "%C/hosts",
	"newsvardir", "/var/news",
	"newsetcdir", "/var/news/etc",
	"btbasedir", "/var/spool/bt",
	"configdir", "/usr/pkg/etc/fidogate",
	"logdir", "/var/log/fido",
	"logfile", "%G/log",
	"outrfc_news", "%S/outrfc/news",
	"aliases", "%C/aliases",
	"seq_msgid", "%V/seq/msgid",
	"ftpinbound", "/var/spool/bt/ftpin",
	"inbound", "/var/spool/bt/in",
	"ifmaildir", "/usr/pkg/sbin",
	"seq_split", "%V/seq/split",
	"outpkt_mail", "%S/outpkt/mail",
	"seq_pack", "%V/seq/pack",
	"toss_route", "%S/toss/route",
	"libdir", "/usr/pkg/lib/fidogate",
	"outpkt", "%S/outpkt",
	"lock_history", "history",
	"vardir", "/var/spool/fido",
	"config_ffx", "%C/fidogate.conf",
	"seq_tick", "%V/seq/tick",
	"toss_bad", "%S/toss/bad",
	"toss_pack", "%S/toss/pack",
	"seq_ff", "%V/seq/ff",
	"acl", "%C/acl",
	"newslibdir", "/usr/pkg/inn/lib",
	"spooldir", "/var/spool/fido",
	"config_main", "%C/fidogate.conf",
	"outpkt_news", "%S/outpkt/news",
	"config_gate", "%C/fidogate.conf",
	"outrfc_mail", "%S/outrfc/mail",
	"packing", "%C/packing",
	"lockdir", "/var/spool/fido/lock",
	"seq_mail", "%V/seq/mail",
	"passwd", "%C/passwd",
     );
my %CONFIG_abbrev =
    (
##Automatically generated by subst.pl, DO NOT EDIT!!!##
	"U", "uuinbound",
	"V", "vardir",
	"N", "bindir",
	"P", "pinbound",
	"S", "spooldir",
	"K", "lockdir",
	"G", "logdir",
	"L", "libdir",
	"B", "btbasedir",
	"I", "inbound",
	"C", "configdir",
     );



sub CONFIG_read {
    my($file) = @_;
    my($key, $arg);
    local *C;

    $file = CONFIG_expand($file);

    open(C,"$file") || die "config.pl: can't open config file $file\n";
    while(<C>) {
	chop;
	next if( /^\s*\#/ );	# comments
	next if( /^\s*$/  );	# empty
	s/\s*$//;		# remove trailing white space
	s/^\s*//;		# remove leading white space
	($key,$arg) = split(' ', $_, 2);
	$key =~ tr/A-Z/a-z/;
	if($key eq "include") {
	    CONFIG_read($arg);
	    next;
	}
	if($key eq "dosdrive") {
	    my ($d, $path) = split(' ', $arg);
	    $CONFIG_dosdrive{lc($d)} = $path;
	    next;
	}
	if($key eq "zone") {
	    my ($z, $rest) = split(' ', $arg, 2);
	    $CONFIG_zone{$z} = $rest;
	    next;
	}
	$CONFIG{$key} = $arg if(!$CONFIG{$key});
    }
    close(C);
}


sub CONFIG_get1 {
    my($key) = @_;
    my($ukey);

    $ukey = $key;
    $ukey =~ tr/a-z/A-Z/;
    return $ENV{"FIDOGATE_$ukey"} if($ENV{"FIDOGATE_$ukey"});

    return $CONFIG{$key} if($CONFIG{$key});
    return $CONFIG_default{$key};
}


sub CONFIG_get {
    my($key) = @_;
    my($ret);
    my($exp);

    $key =~ tr/A-Z/a-z/;
    return CONFIG_expand( CONFIG_get1($key) );
}


sub CONFIG_expand {
    my($v) = @_;
    my($exp);

    if($v =~ /^%([A-Z])/) {
	$exp = CONFIG_get1($CONFIG_abbrev{$1});
	$v =~ s/^%./$exp/;
    }

    return $v;
}


sub CONFIG_debug {    
    my($key);

    for $key (keys %CONFIG) {
	print "$key = $CONFIG{$key} -> ", CONFIG_get($key), "\n";
    }
}

##############################################################################

getopts('vc:');

# read config
my $CONFIG = $opt_c ? $opt_c : "%C/fidogate.conf";
CONFIG_read($CONFIG);

# options
my $options = "";

my $libdir   = CONFIG_get("LIBDIR");
my $maildir  = CONFIG_get("OUTRFC_MAIL");
my $newsdir  = CONFIG_get("OUTRFC_NEWS");
my $newsseq  = "seq.news";



#
# main program:
#

unsplit_mail();
split_newsfiles();
unsplit_news();

##################
#                #
#  Subroutines:  #
#                #
##################

#
# Unsplit mails:
#

sub unsplit_mail {
    #
    # generate databases of mails:
    #        (Splitline $; Part $; Parts) -> Filename
    #
    print "Reading mail file\n" if($opt_v);
    
    undef %msglist;
    opendir (DIR, "$maildir") || die "Couldn't open Dir $maildir\n";
    @messages = grep (/\.msg$/, readdir (DIR));
    closedir (DIR);

    MESSAGE:			
    for $f (@messages) {
	$msgfile = "$maildir/$f";

	print "Processing $msgfile\n" if ($opt_v);

	#
	# open message
	#
	if (!open(MESSAGE, $msgfile)) {
	    print STDERR "Can't open $msgfile -- continuing...\n";
	    next MESSAGE;
	}

	#
	# search "X-SPLIT:"
	#
	while (($_=<MESSAGE>) && (!/^X-SPLIT:/)) {
	}
	
	if (!/^X-SPLIT:/) {
	    #
	    # Messages was not splitted.
	    #
	    next MESSAGE;
	}
	
	# e.g.:
	# X-SPLIT: 30 Mar 90 11:12:34 @494/4       123   02/03 +++++++++++
	# (GIGO is broken, thus only 10 +)
	/^X-SPLIT: (.*) (\d\d)\/(\d\d) \+{10,}/;
	$id = ($1.$;.$2.$;.$3);
	
	print "ID: $id\n" if($opt_v);

	#
	# $id has now the format Splitline $; AktPart $; Parts
	#

	if ($msglist{$id}) {
	    #
	    # message is already in the database :-(
	    #
	    print "$msgfile seems to be a dupe. renaming to $msgfile.dupe\n";
	    rename ($msgfile, "$msgfile.dupe");
	}				
	else {			
	    #
	    # insert message to database
	    #
	    $msglist{$id} = $msgfile;
	}
    }

    #
    # Now walk through all mails and concatenate the parts
    #
    print "Processing split mails\n" if($opt_v);

    MAIL:
    foreach $aktmail (sort keys(%msglist)) {
	print "Processing mail file $msglist{$aktmail}\n" if($opt_v);

	# 
        # walk through the complete database.
	# 
	if (! -f $msglist{$aktmail}) {
	    next MAIL;
	}

	($splitid,$part,$parts) = split(/$;/,$aktmail);

	#
	# Test completeness of current message
	#
	$complete = 1;
	for ($p=1; $p <= $parts; $p++) { 
	    $part = sprintf ("%02d",$p);
	    if (! $msglist{$splitid.$;.$part.$;.$parts}) {
		$complete = 0;
		print "missing: $splitid  $part / $parts\n";
	    }
	}
	
	#
	# Now the unsplit
	#
	
	if ($complete) {
	    #
	    # All parts of the message exists.
	    #
	    print "Message $splitid complete, recombining\n" if($opt_v);

	    #
	    # process first message
	    #
	    $sp = $msglist{$splitid.$;.'01'.$;.$parts};
	    $nsp = $sp;
	    $usp = $sp.'.unsplit'; 

	    print "Part 01/$parts: $sp\n" if($opt_v);

	    open (SPLIT, "< $sp") || die "Couldn't open $sp\n";
	    open (UNSPLIT, "> $usp") || die "Couldn't open $usp\n"; 
	    
	    $linesline=0;	# the line in @all, where "Lines:" is found
	    undef @all;		# clean @all
	    
	    while (($_ = <SPLIT>) && (! /^$/) && (! /^Lines:/)) {
		push (@all,$_);
		$linesline++;
	    }
	    if (/^Lines: (\d+)$/) {
		$lines = $1;
	    }
	    push (@all, $_);
	    
	    while (($_ = <SPLIT>) && (! /^$/) && (! /^X-SPLIT:/)) {
		push (@all,$_);
	    }
	    if (!/^X-SPLIT:/) {
		#
		# delete "X-SPLIT:"-line:
		#
		push (@all,$_);
	    }

	    push (@all,<SPLIT>);
	    
	    close $SPLIT;
	    unlink $sp || die "Couldn't unlink $sp\n";
	    
	    #
	    # process the rest
	    #
	    for ($p=2; $p <= $parts; $p++) {
		$part = sprintf ("%02d",$p);
		$sp = $msglist{$splitid.$;.$part.$;.$parts};

		print "Part $part/$parts: $sp\n" if($opt_v);

		open (SPLIT, "< $sp") || die "Couldn't open $sp\n";
		while (($_ = <SPLIT>) && (! /^$/)) {
		    if (/^Lines: (\d+)$/) {
			$lines += $1;
		    }
		}
		push (@all,<SPLIT>);
		close $SPLIT;
		unlink $sp || die "Couldn't unlink $sp\n";
	    }
	    
	    @all[$linesline]="Lines: $lines\n";	# set "Lines:" to correct value
	    
	    #
	    # Output the recombined mail to file
	    #
	    foreach $line (@all) {
		print UNSPLIT $line;
	    }
	    close $UNSPLIT;
	    rename ($usp,$nsp) || die "Can't rename $usp -> $nsp\n";
	}
	else {
	    #
	    # cannot unsplit message because of missing parts.
	    #
	    print "Message <$msgid> incomplete!\n";
	}
    }
}    # end sub unsplit_mail




#
# split newsfiles:
#

sub split_newsfiles {
    opendir (DIR, "$newsdir") || die "Couldn't open Dir $maildir\n";
    @messages = grep (/\.msg$/, readdir (DIR));
    closedir (DIR);

    for $f (@messages) {
	$inname = "$newsdir/$f";
	&split_newsfile($inname);
    }	
}    # end sub split_newsfiles


sub split_newsfile {
    my ($inname) = @_;

    $nosplitname = sprintf ("$newsdir/%08ld.msg", &sequencer);
    open (NOSPLIT, "> $nosplitname") || die "Can't write $nosplitname\n";

    undef $rnews;

    open(IN, $inname) || die "Can't read $inname\n";
    while (<IN>) {
	$bytes = $_;
	chop $bytes;
	$bytes =~ s/^\#\! rnews (\d+)$/$1/;
	read (IN, $message, $bytes);
	# search "^X-SPLIT: " in the Header(!) :
	# X-SPLIT: 30 Mar 90 11:12:34 @494/4       123   02/03 +++++++++++
	if ($message =~ 
	    /\nX-SPLIT: [^\n\@]+\@\d+\/\d+[ \t]+\d+[ \t]+\d\d\/\d\d \+{11}/)
	{
	    #
	    # "X-SPLIT" found:
	    #
	    $message =~ /(.*)\n\n(.*)/;
	    $splitline = $1;
	    if (! $splitline =~ /X-SPLIT: /) {
		#
		# "X-SPLIT" not in Header!
		#
		print NOSPLIT "\#! rnews $bytes\n";
		print NOSPLIT $message;
	    } else {
		#
		# "X-SPLIT" found in Header
		#
		$outname = sprintf ("$newsdir/%08ld.msg.split", &sequencer);
		open (OUT, "> $outname") || die "Can't write $outname\n";
		print OUT "\#! rnews $bytes\n";
		print OUT $message;
		close OUT;
	    }
	} else {		
	    #
	    # Unsplitted Message
	    #
	    print NOSPLIT "\#! rnews $bytes\n";
	    print NOSPLIT $message;
	}
    }	
    close NOSPLIT;

    unlink $inname || die "Couldn't unlink $inname\n";} 
# end sub split_newsfile




#
# Unsplit news:
#

sub unsplit_news {

    #
    # generate databases of news:
    #        (Splitline $; Part $; Parts) -> Filename
    #
    
    undef %msglist;
    opendir (DIR, "$newsdir") || die "Couldn't open Dir $newsdir\n";
    @messages = grep (/\.msg\.split$/, readdir (DIR));
    closedir (DIR);



    NMESSAGE:			
    for $f (@messages) {
	$msgfile = "$newsdir/$f";

	#
	# open message
	#
	if (!open(MESSAGE, $msgfile)) {
	    print STDERR "Can't open $msgfile -- continuing...\n";
	    next NMESSAGE;
	}

	#
	# search "X-SPLIT:"
	#
	while (($_=<MESSAGE>) && (!/^X-SPLIT:/)) {
	}

	# e.g.:
	# X-SPLIT: 30 Mar 90 11:12:34 @494/4       123   02/03 +++++++++++
	#
	/^X-SPLIT: (.*) (\d\d)\/(\d\d) \+{11}/;
	$id = ($1.$;.$2.$;.$3);
	
	#print "id: $id\n";

	#
	# $id has now the format Splitline $; AktPart $; Parts
	#

	if ($msglist{$id}) {
	    #
	    # message is already in the database :-(
	    #
	    print "$msgfile seems to be a dupe. renaming to $msgfile.dupe\n";
	    rename ($msgfile, "$msgfile.dupe");
	}				
	else {			
	    #
	    # insert message to database
	    #
	    $msglist{$id} = $msgfile;
	}
    }

    #
    # Now walk through all news and concatenate the parts
    #
    
    NEWS:
    foreach $aktmail (sort keys(%msglist)) {
	# 
        # walk through the complete database.
	# 
	if (! -f $msglist{$aktmail}) {
	    next NEWS;
	}

	($splitid,$part,$parts) = split(/$;/,$aktmail);

	#
	# Test completeness actual message
	#
	$complete = 1;
	for ($p=1; $p <= $parts; $p++) { 
	    $part = sprintf ("%02d",$p);
	    if (! $msglist{$splitid.$;.$part.$;.$parts}) {
		$complete = 0;
		print "missing: $splitid  $part / $parts\n";
	    }
	}
	
	#
	# Now the unsplit
	#
	
	if ($complete) {
	    #
	    # All parts of the message exists.
	    #

	    #
	    # process first message
	    #
	    $sp = $msglist{$splitid.$;.'01'.$;.$parts};
	    $usp = $sp; 
	    $usp =~ s/\.split$//;
	    open (SPLIT, "< $sp") || die "Couldn't open $sp\n";
	    open (UNSPLIT, "> $usp") || die "Couldn't open $usp\n"; 
	    
	    $linesline=0;	# the line in @all, where "Lines:" is found
	    undef @all;		# clean @all
	    
	    while (($_ = <SPLIT>) && (! /^$/) && (! /^Lines:/)) {
		push (@all,$_);
		$linesline++;
	    }
	    if (/^Lines: (\d+)$/) {
		$lines = $1;
	    }
	    push (@all, $_);
	    while (($_ = <SPLIT>) && (! /^$/) && (! /^X-SPLIT:/)) {
		push (@all,$_);
	    }
	    if (!/^X-SPLIT:/) {	
		#
		# delete "X-SPLIT:"-line:
		#
		push (@all,$_);
	    }

	    push (@all,<SPLIT>);
	    
	    close $SPLIT;
	    unlink $sp || die "Couldn't unlink $sp\n";
	    
	    #
	    # process the rest
	    #
	    for ($p=2; $p <= $parts; $p++) {
		$part = sprintf ("%02d",$p);
		$sp = $msglist{$splitid.$;.$part.$;.$parts};
		open (SPLIT, "< $sp") || die "Couldn't open $sp\n";
		while (($_ = <SPLIT>) && (! /^$/)) {
		    if (/^Lines: (\d+)$/) {
			$lines += $1;
		    }
		}
		push (@all,<SPLIT>);
		close $SPLIT;
		unlink $sp || die "Couldn't unlink $sp\n";
	    }
	    
	    #$lines -= $p;
	    @all[$linesline]="Lines: $lines\n";	# set "Lines:" to correct value

	    $size = 0;
	    foreach $line (@all) {
		$size += length($line);
	    }
	    $size -= length($all[0]);
	    $all[0] =~ s/\#\! rnews \d+/\#\! rnews $size/;

	    #
	    # Output the unsplitted mail to file
	    #
	    foreach $line (@all) {
		print UNSPLIT $line;
	    }
	    close $UNSPLIT;
	}
	else {
	    #
	    # cannot unsplit message because of missing parts.
	    #
	    print "message <$msgid> incomplete!\n";
	}
    }
}    # end sub unsplit_news



# ----- Get number from seq.news ---------------------------------------------

sub sequencer {
    $nseq = `$libdir/ftnseq $options $newsseq`;
    die "Can't access $newsseq\n" if($nseq eq "ERROR" || $nseq eq "");

    return $nseq;
}
