#!/usr/bin/perl
# $File: //depot/ebx/ebx $ $Author: autrijus $
# $Revision: #44 $ $Change: 1243 $ $DateTime: 2001/06/20 05:47:11 $

$VERSION  = '0.83';
$REVISION = "rev$1\[\@$2\]" 
    if ('$Revision: #44 $ $Change: 1243 $' =~ /(\d+)[^\d]+(\d+)/);

=head1 NAME

ebx - Elixir BBS Exchange Suite

=head1 SYNOPSIS

    % ebx sync [-lgdfh] [-m <maxmsg>] [-o [logfile]] ] 
               [-u <user>] [<boards>...]
    % ebx <set|del|list>pass [-r] [-l] [-d] [-u <user>]
    % ebx setboard [<boards>...]

=head1 DESCRIPTION

This script synchronizes your local BBS's storage via the BBSCOM 
settings configured within.

=head1 COMMANDS

    sync		perform synchronization

    setpass		add login/password pairs
    delpass		delete login/password pairs
    listpass		list current keyring

    setboard		set up boards for mirroring

=head1 OPTIONS

    -d			enable debugging messages
    -f			enable per-site forking
    -g			skip passring check, use guest for all sites
    -l			enable per-site locking
    -S			force sending of duplicate articles
    -F			force fetching of duplicate articles
    -R			refresh message id, do nothing else
    -P			perserve remote user id and headers
    -m <maxmsg>		set maximal number of message to keep track
    -o [logfile]	output to log stdout instead of log files
    -u <user>		specify the owner of gpg keyring
    <synclist>...	process specified boards or source

=head1 ENVIRONMENT

The following environment variables are understood by ebx:

=over

=item EBX_BACKEND

The local BBS's backend. Defaults to MELIX.

=item EBX_BBSROOT

The local BBS's location. Defaults to /home/melix or /home/bbs.

=item EBX_USER

The owner to C<.ebx.keyring>, the private keyring used to store 
encrypted ebx passwords. Defaults to USER.

=item EBX_HOME

The home directory of EBX_USER, defaults to HOME.

=back

=cut

use strict;
use warnings;
use Term::ReadKey;

BEGIN { ReadMode('noecho') }
END   { ReadMode('restore') }

use File::Spec;
use IO::Handle;
use MIME::Base64;
use Compress::Zlib;
use Getopt::Std;
use Storable qw/nfreeze thaw/;

use OurNet::BBS '1.54';
use OurNet::BBSApp::Sync;

$|++;

my %args;
my $action = shift(@ARGV) if 
    @ARGV and substr($ARGV[0], 0, 1) ne '-';

getopts('m:o:u:dfglhSFRP', \%args);

$action ||= shift(@ARGV) || '';

if ($args{h}) {
    if ($^O eq 'MSWin32') {
	my $exec = $0;
	$exec =~ s/\.exe$//i;
        system("perldoc $exec");
	exit;
    }
    else {
	ReadMode('restore') and exec('perldoc', $0);
    }
}


my $bbs      = init_bbs();
my $logfh    = IO::Handle->new();
my $tmp_path = File::Spec->tmpdir();
my $maxmsg   = $args{m} || 128;
my $user     = $args{u} || $ENV{EBX_USER} || $ENV{USER} || 
    (($^O eq 'MSWin32') ? $ENV{USERNAME} : getpwent());
my $passphrase;

$OurNet::BBS::DEBUG = $OurNet::BBS::DEBUG = 1 if $args{d};

my @actions  = qw/sync setpass delpass listpass setboard/;

if (index(" @actions ", " $action ") > -1) {
    no strict 'refs'; &{$action};
}
else {
    my $actions = join('|', @actions);

    die << ".";

Elixir BBS Exchange Suite v$main::VERSION-$main::REVISION

Usage: $0 <$actions> [options]
Type '$0 -h' to see available options.

Copyright 2001 by Chia-Liang Kao <clkao\@clkao.org>,
                  Autrijus Tang <autrijus\@autrijus.org>.

This program is free software; you can redistribute it and/or 
modify it under the same terms as Perl itself.

See <http://www.perl.com/perl/misc/Artistic.html>.

.
}

exit;

# ===================================================================
# The BOARD command family section
# ===================================================================

sub setboard {
    die "usage: $0 setboard [<boards>...]\n" unless @ARGV;

    foreach my $board (@ARGV) {
	# XXX: is the function below desirable?
	if (0 and exists $bbs->{boards}{$board}) {
	    my $inp = input("board exists. continue? [y/N/c(lear)]: ");
	    next if $inp =~ /[Nn]/;
	    if ($inp =~ /[Cc]/) {
		my $artgrp = $bbs->{boards}{$board}{articles};
		foreach my $key (keys(%{$artgrp})) {
		    delete $artgrp->{$key};
		};
		print "board <$board> cleared.\n";
	    }
	}

	modify_board(
	    $board,
	    get_addr(
		input("enter backend for $board [BBSAgent]: ") || 'BBSAgent',
		input("enter remote site: "),
	    ),
	    input("enter remote board [$board]: ") || $board,
	    input("enter local title [$board]: ") || $board,
	    (input("do you want postback? [Y/n]: ") !~ /[Nn]/),
	    input("sync after which article? [0]: "),
	);
    }

    print "boards(s) successfully set.\n";
}


sub get_addr {
    my ($backend, $site) = @_;
    return (@_, $site) unless $backend eq 'BBSAgent';

    foreach my $path (@INC) {
        foreach my $bbsfile (
	    "$path/OurNet/BBSAgent/$site",
	    "$path/OurNet/BBSAgent/$site.bbs",
	    "$path/$site", "$path/$site.bbs",
	) {
	    open _, $bbsfile or next; scalar <_>;
	    my $port = scalar <_>; chomp($port);
	    $port =~ s/:23$//;
	    return (@_, $port);
	}
    }

    die "cannot find bbsfile for $site\n";
}

sub modify_board {
    my ($lbrd, $back, $site, $addr, $rbrd, $ltit, $pbac, $rsen) = @_;

    $pbac = $pbac ? 0 : '';
    $rsen ||= 0;

    $bbs->{boards}{$lbrd} = {
	title => (index($ltit, 2, 1) eq ' ' ? $ltit : "   $ltit"),
	bm    => "# $site",
    };

    my $brd = $bbs->{boards}{$lbrd};
    my $arv = $brd->{archives};

    (($#{$arv} > 0) ? $arv->[1] : $arv->{''}) = {
	header => {
	    From    => "SYSOP (EBX v$main::VERSION-$main::REVISION)",
	    Subject => '#',
	    Board   => $lbrd,
	    Date    => (scalar localtime),
	},
	body        => << ".",
# remote: $addr
# backend: $back
# source: $site
# board: $rbrd
# rseen: $rsen
# lseen: $pbac
# lmsgid: 
__XMSGID__
.
    };
}

# ===================================================================
# The PASS command family section
# ===================================================================

# create login/pass pair
sub setpass {
    my ($passring, $keyring) = get_keyring();
    die "usage: $0 setpass [<sites>...]\n" unless @ARGV;

    foreach my $site (@ARGV) {
	my $login = input("enter login name for <$site>: ");
	my $pass  = input("enter password for <$login\@$site>: ", 1);

	$keyring->{$site} = "$login:$pass";
    }

    $passring->save_keyring($keyring);
    print "password(s) successfully set.\n";
}

# list all login/pass pairs
sub listpass {
    my $keyring = get_keyring();

    print "passring list for $user:\n";

    while (my ($site, $info) = each(%$keyring)) {
	$info =~ s/:.*$//;
	printf "%-18s %s\n", "[$site]", $info;
    }
}

# delete login/pass pair
sub delpass {
    my ($passring, $keyring) = get_keyring();
    die "usage: $0 delpass [<sites>...]\n" unless @ARGV;

    foreach my $site (@ARGV) {
	unless (exists $keyring->{$site}) {
	    warn "site $site does not exist\n";
	    next;
	}

	delete $keyring->{$site};
    }

    $passring->save_keyring($keyring);
    print "password(s) successfully deleted.\n";
}

# ===================================================================
# The SYNC command family section
# ===================================================================

# perform synchronization.
sub sync {
    my %remote  = sync_init();
    my $keyring = get_keyring() unless $args{g};

    foreach my $entry (keys(%remote)) {
	$logfh->fdopen(
	    ($args{o} ? make_logfile($entry) : fileno(STDOUT)), 'w'
	) unless (($logfh->fileno || -1) == fileno(STDOUT));

	next if ($args{f} and fork());

	my $lockfile = make_lockfile($entry) or next;

	$logfh->print("synchronizing $entry\n");

	my ($backend, $rhost) = split('::', $entry, 2);
	my @rhost = $rhost;

	if ($backend eq 'OurNet') {
	    @rhost = split(':', $rhost[0]);
	    push @rhost, '' unless $rhost[1];
	    push @rhost, $user;
	}

	my $rbbs = eval { OurNet::BBS->new(
	    $backend, @rhost, get_login($keyring, $rhost, $backend)
	) };
	
	if ($@) {
	    print $@;
	    exit if $args{f};
	    next;
	}

	foreach my $site (@{$remote{$entry}}) {
	    sync_start($rbbs, $site, $entry)
	    # and sync_start($rbbs, $site, $entry); # XXX broken
	}

	unlink($lockfile) if -e $lockfile;
	exit if $args{f};
    }

    return unless $args{f};
    while (wait() != -1) { };
}

# starts synchronization.
sub sync_start {
    my ($rbbs, $site, $entry) = @_;
    my $restart;
    my $param  = $site->{param};
    my $lbrdag = $site->{lbrdag};
    my $rbrd   = eval { $rbbs->{boards} };

    if (!$rbrd or $@) { $logfh->print("cannot login ($@)"); return; }

    $logfh->print("=> ${entry}::$site->{param}{board}\n");

    $rbrd = eval { $rbrd->{$param->{board}} };

    if ($@) { $logfh->print("cannot access board ($@)"); return; }

    my $sync = OurNet::BBSApp::Sync->new({
	artgrp     => $lbrdag, 
	rartgrp    => $rbrd->{articles}, 
	param      => $param, 
	backend    => $param->{backend},
	logfh      => $logfh,
	force_send => $args{S},
	force_fetch=> $args{F},
	force_none => $args{R},
	clobber	   => !(defined($args{P})),
    });

    $sync->do_fetch();
    $restart = $sync->do_send() unless ($args{g});

    update_config($site->{config}, $site->{param});

    $lbrdag->purge();
    $rbrd->purge();

    return $restart;
}

# initialize synchronization
sub sync_init {
    my %remote;
    my %synclist = map { $_ => 1 } @ARGV;
    my $boards = $bbs->{boards};
       
    print "scheduled for sync:";

    foreach my $name (sort { uc($a) cmp uc($b) } keys(%$boards)) {
	my $brd = $boards->{$name};
	my $arv = $brd->{archives};
	    
	while (my (undef, $art) = each(%{$brd->{archives}})) {
	    next if ref($art) =~ /Group/;
	    next unless $art->{title} =~ m/^\#/;

	    my %param = %{read_config($art)};

	    next if %synclist and !$synclist{$name} 
		and !$synclist{'@'.($param{source} || '')};

	    next unless $param{source} and $param{board} 
		and (length($param{rseen}) or length($param{lseen}));

	    print " $name";
	    
	    $param{backend} ||= 'BBSAgent';

	    my $key = "$param{backend}::$param{source}";

	    push @{$remote{$key}}, {
		lbrdag => $brd->{articles},
		param  => \%param,
		config => $art,
	    };
	}

	$boards->purge();
    }

    die " ...nothing scheduled for sync, stopping.\n" unless (%remote);

    print "\n";
    return %remote;
}

# ===================================================================
# Utility functions
# ===================================================================

# get login name from keyring.
sub get_login {
    my ($keyring, $rhost, $backend) = @_;

    if (exists $keyring->{$rhost}) {
	my ($login, $pass) = split(/:/, $keyring->{$rhost}, 2);
	$pass ||= $passphrase if $backend eq 'OurNet';
	return ($login, $pass);
    }
    elsif ($backend eq 'BBSAgent') {
	print "no login info in keyring found for $rhost: using guest\n"
	    unless $args{g};

        return 'guest';
    } elsif ($backend eq 'OurNet') {
	return ($user, $passphrase);
    }
}


sub get_keyring {
    require OurNet::BBSApp::PassRing;

    my $passring = OurNet::BBSApp::PassRing->new(
	($ENV{EBX_HOME} || $ENV{HOME} || '.').'/.ebx.keyring', $user
    );

    my $keyring;

    for (1..3) {
	$passphrase = input("enter passphrase for $user: ", 1);
	$keyring = eval {$passring->get_keyring($passphrase)};
	warn "can't get keyring; check passphrase and try again ($@).\n" if $@;
	last unless $@;
    }

    die "failed too many times, giving up.\n" if $@;

    return wantarray ? ($passring, $keyring) : $keyring;
}

sub read_config {
    my $art    = shift;
    my $xmsgid = 0;
    my $msgid  = '';
    my %param;

    foreach my $line (split("\n", ($art->{body} || ''))) {
	if ($xmsgid == 1) {
	    $msgid .= $line;
	}
	elsif ($line eq '__XMSGID__') {
	    $xmsgid = 1;
	}
	elsif ($line =~ m/^\# (\w+):\s*(.*)$/) {
	    $param{$1} = $2;
	}
    }

    $param{msgids} = thaw(uncompress(decode_base64($msgid))) if $msgid;

    return \%param;
}

sub update_config {
    my ($art, $param) = @_;

    $param->{msgids} = [@{$param->{msgids}}[-(($maxmsg) * 2) .. -1]] 
	if $#{$param->{msgids}} > ($maxmsg) * 2;

    my $newmsg = encode_base64(compress(nfreeze($param->{msgids})));
    my @lines  = grep {!m/^# /} split("\n", $art->{body});
    my $body   = join("\n", ((map {
	"# $_: ".(defined $param->{$_} ? $param->{$_} : '')
    } qw/remote backend source board rseen lseen lmsgid/), @lines));

    $body =~ s/__X?MSGID__[\x00-\xff]*$/__XMSGID__\012$newmsg/;
    $art->{body} = $body;
	
    $logfh->print("[BoardSync] $param->{board}: configuration updated.\n");
}

sub make_lockfile {
    my $lockfile = "ebx-$_[0].lock";
    $lockfile =~ s{/|::}{-}g;

    return $lockfile unless $args{l};

    open LOCK, ">$tmp_path/$lockfile" or return;
    print LOCK $$;
    close LOCK;

    return $lockfile;
}

sub make_logfile {
    my $entry   = shift;
    my $logfile = $args{o} || "$tmp_path/sync.$entry.log";

    chmod 0666, $logfile;
    open LOG, ">$logfile" or die "cannot write logfile: $!";

    return fileno(LOG);
}

sub input {
    my ($prompt, $silent) = @_;

    ReadMode($silent ? 'noecho' : 'normal');

    print $prompt;
    my $input = <STDIN>;
    chomp $input;
    print "\n" if $silent;

    return $input;
}

sub init_bbs {
    my ($bbs, $backend, $bbsroot);

    $backend = $ENV{EBX_BACKEND} || 'MELIX'; 
    $bbsroot = $ENV{EBX_BBSROOT} || (
	($^O eq 'MSWin32')
	    ? 'c:\program files\melix\home\melix'
	    : (-d '/home/melix' ? '/home/melix' : '/home/bbs')
    ) || '.';
    
    $bbs = eval { OurNet::BBS->new($backend, $bbsroot, 2997, 350) };
    
    if ($@) {
	$bbs = OurNet::BBS->new($backend, $bbsroot);
	warn "warning: tying up shared memory (2997, 350) failed.\n";
    }

    return $bbs;
}

1;

__END__

=head1 AUTHORS

Chia-Liang Kao E<lt>clkao@clkao.org>,
Autrijus Tang E<lt>autrijus@autrijus.org>

=head1 COPYRIGHT

Copyright 2001 by Chia-Liang Kao E<lt>clkao@clkao.org>,
		  Autrijus Tang E<lt>autrijus@autrijus.org>.

This program is free software; you can redistribute it and/or 
modify it under the same terms as Perl itself.

See L<http://www.perl.com/perl/misc/Artistic.html>

=cut
