#!/usr/bin/perl
#
# FileServ v0.2r1
# 
# File transfer over IRC pluging for XChat
# this file is released under the GPL
# By Chocolate with a Zed
#

use strict;
use warnings;
no warnings 'uninitialized';

IRC::register('fileserv', "0.2", "", "");
IRC::add_command_handler("fload", "FileServ::load");
IRC::add_command_handler("fload_base64", "FileServ::load_base64");
IRC::add_command_handler("fqueue", "FileServ::queue");
IRC::add_command_handler("fsend", "FileServ::send");
IRC::add_command_handler("fget", "FileServ::get");
IRC::add_command_handler("fresume", "FileServ::resume");
IRC::add_command_handler("fblocks", "FileServ::blocks");
IRC::add_command_handler("fmissing", "FileServ::missing");
IRC::add_command_handler("fsending", "FileServ::sending");
IRC::add_command_handler("fsave", "FileServ::save");
IRC::add_command_handler("fsave_base64", "FileServ::save_base64");
IRC::add_command_handler("fclear", "FileServ::clear");
IRC::add_message_handler("PRIVMSG", "FileServ::privmsg");

package FileServ;

our $bold      = "\002";
our $reg       = "\003";
our $black     = "\0030";
our $darkblue  = "\0032";
our $darkgreen = "\0033";
our $red       = "\0034";
our $darkred   = "\0035";
our $magenta   = "\0036";
our $orange    = "\0037";
our $yellow    = "\0038";
our $green     = "\0039";
our $cyan1     = "\00310";
our $cyan2     = "\00311";
our $blue      = "\00312";
our $lightmag  = "\00313";
our $gray      = "\00314";
our $lightgray = "\00315";
our $crlf      = "\015\012";

our $noprintblock = 0;
our $send_delay = 5000;
our $block_size = 256; # after base64 encodeing

sub encode_base64 {
    local $_ = join '', map(
        pack('u', $_) =~ /^.(\S*)/,
        ($_[0] =~ /(.{1,45})/gs)
    );
    tr#` -_#AA-Za-z0-9+/#; # `# help emacs
    #my $pad = ((3 - length() % 3) % 3);
    my $pad = length() % 4;
    $_  =~ s/.{$pad}$/'=' x $pad/e if $pad;
    return $_;
}

sub decode_base64 {
    local $_ = $_[0];
    #tr#a-zA-Z0-9+/##cd;
    s#=+$##;
    tr#A-Za-z0-9+/# -_#;
    $_ = join '', map(
        unpack("u", chr(32 + length($_) * 3/4) . $_),
        $_ =~ /(.{1,60})/gs
    );
    return $_;
}

our @sendq;
our %fqueue;
our %pending;
our %sending;
our %recving;
our %complete_s;
our %complete_r;

sub load {
    # /fload <name> <path/file>
    my ($name, $file) = split " ", $_[0], 2;
    my ($channel, $server) = (IRC::get_info(2), IRC::get_info(3));
    unless($name) {
        return(1);
    }
    local $/; # slurp the file in all at once
    open my $fh, "<", $file or do {
        IRC::print_with_channel("${darkblue}-FileServ-${reg}\tError opening '$file': $!", $channel, $server);
        return(1);
    };
    binmode $fh; # many thanks to hobbs for this!

    my ($txt, @txt);
    $txt = <$fh>;
    $txt = encode_base64($txt);
    @txt = $txt =~ /(.{1,$block_size})/gs;
    $fqueue{$name} = [$file, \@txt, 0];
    $fqueue{$name}[2] = [0 .. $#{$fqueue{$name}[1]}];
    IRC::print_with_channel("${darkblue}-FileServ-${reg}\tLoaded $name from $file (" . ($#{$fqueue{$name}[1]} + 1) . " blocks x " . $block_size . " base64 chars)", $channel, $server);
    return(1);
}

sub load_base64 {
    # /fload_base64 <name> <path/file>
    my ($name, $file) = split " ", $_[0], 2;
    my ($channel, $server) = (IRC::get_info(2), IRC::get_info(3));
    unless($name) {
        return(1);
    }
    open my $fh, "<", $file or do {
        IRC::print_with_channel("${darkblue}-FileServ-${reg}\tError opening '$file': $!", $channel, $server);
        return(1);
    };
    my @txt;
    until (eof($fh)) {
        push @txt, <$fh>;
    }
    chomp(@txt);
    $fqueue{$name} = [$file, \@txt, []];
    for (0 .. $#{$fqueue{$name}[1]}) {
        next if defined($fqueue{$name}[1][$_]);
        $fqueue{$name}[1][$_] = "";
        push @{$fqueue{$name}[2]}, $_;
    }
    IRC::print_with_channel("${darkblue}-FileServ-${reg}\tLoaded $name from $file (base64 dump reload)", $channel, $server);
    return(1);
}

sub queue {
    # /fqueue <name> <path/file>
    my ($name, $file) = split " ", $_[0], 2;
    my ($channel, $server) = (IRC::get_info(2), IRC::get_info(3));
    unless($name) {
        IRC::print_with_channel("${darkblue}-FileServ-${reg}\tPending files", $channel, $server);
        for (keys %pending) {
            IRC::print_with_channel("$_ => $fqueue{$_}[0]", $channel, $server);
        }
        return(1);
    }
    load(@_) unless ($fqueue{$name}[1]);
    $pending{$name} = 1;
    IRC::print_with_channel("${darkblue}-FileServ-${reg}\tQueueing $name ($file)", $channel, $server);
    IRC::send_raw("PRIVMSG " . $channel . " :file queue $name "
        . $#{$fqueue{$name}[1]} . " " . $block_size . $crlf . $crlf);
    return(1);
}

sub send {
    # /fsend <name>
    my ($name) = $_[0];
    my ($file) = $fqueue{$name}[0];
    my ($channel, $server) = (IRC::get_info(2), IRC::get_info(3));
    unless($name) {
        IRC::print_with_channel("${darkblue}-FileServ-${reg}\tSending files", $channel, $server);
        for (sort keys %sending) {
            IRC::print_with_channel("$_ => $fqueue{$_}[0]", $channel, $server);
        }
        IRC::print_with_channel("${darkblue}-FileServ-${reg}\tSendQ", $channel, $server);
        for (@sendq) {
            IRC::print_with_channel("$_ => $fqueue{$_}[0]", $channel, $server);
        }
        return(1);
    }
    $pending{$name} = 0;
    $sending{$name} = 1;
    IRC::print_with_channel("${darkblue}-FileServ-${reg}\tSending $name ($file)", $channel, $server);
    IRC::send_raw("PRIVMSG " . $channel . " :file send $name" . $crlf);
    IRC::add_timeout_handler($send_delay, "FileServ::sendblock") unless scalar(@sendq);
    push @sendq, [$name, $channel, $server];
    return(1);
}

sub sendblock {
    my ($name, $channel, $server) = @{$sendq[0]};
    my $blocknum = shift @{$fqueue{$name}[2]};
    my $block = $fqueue{$name}[1][$blocknum];
    if (defined($blocknum)) {
        IRC::send_raw("PRIVMSG " . $channel . " :file block $name $blocknum $block" . $crlf);
        IRC::print_with_channel("${darkblue}-FileServ-${reg}\t${gray}block $blocknum of $name via ${channel}${reg}", $server, $server) unless $noprintblock;
        IRC::add_timeout_handler($send_delay, "FileServ::sendblock");
    } else {
        IRC::send_raw("PRIVMSG " . $channel . " :file over $name" . $crlf);
        IRC::print_with_channel("${darkblue}-FileServ-${reg}\t$name finished", $channel, $server);
        shift @sendq;
        if (scalar(@sendq)) {
            $name = $sendq[0];
            IRC::print_with_channel("${darkblue}-FileServ-${reg}\t$name starting", $channel, $server);
            IRC::add_timeout_handler($send_delay, "FileServ::sendblock");
        }
    }
    return(1);
}

sub get {
    # /fget <name>
    # $file is used for nick of sender
    my ($name) = $_[0];
    my ($file) = $fqueue{$name}[0];
    my ($channel, $server) = (IRC::get_info(2), IRC::get_info(3));
    unless($name) {
        IRC::print_with_channel("${darkblue}-FileServ-${reg}\tRecv'ing files", $channel, $server);
        for (keys %recving) {
            IRC::print_with_channel("$_ => $fqueue{$_}[0]", $channel, $server);
        }
        return(1);
    }
    $recving{$name} = 1;
    IRC::print_with_channel("${darkblue}-FileServ-${reg}\tGetting $name ($file)", $channel, $server);
    IRC::send_raw("PRIVMSG " . $channel . " :file ready $name" . $crlf);
    return(1);
}

sub resume {
    # /fresume <name>
    # $file is used for nick of sender
    my ($name, @cmds) = split " ", $_[0];
    my ($file) = $fqueue{$name}[0];
    my ($channel, $server) = (IRC::get_info(2), IRC::get_info(3));
    unless($name) {
        # print out 
        return(1);
    }
    my @blocks;
    my ($sub, @range);
    for (@cmds) {
        $sub = 0;
        @range = ();
        /^(\d+)\-(\d+)$/ and @range = $1 .. $2;
        /^(\d+)$/ and @range = $1;
        for (@range) {
            $blocks[$_] = $_;
        }
    }
    $fqueue{$name}[2] = [];
    for (0 .. $#blocks) {
        push(@{$fqueue{$name}[2]}, $_) if $blocks[$_];
    }
    IRC::print_with_channel("${darkblue}-FileServ-${reg}\tBlocks @{$fqueue{$name}[2]} from $name ($file)", $channel, $server);
    $pending{$name} = 0;
    $sending{$name} = 1;
    IRC::print_with_channel("${darkblue}-FileServ-${reg}\tSending $name ($file)", $channel, $server);
    IRC::send_raw("PRIVMSG " . $channel . " :file send $name" . $crlf);
    IRC::print_with_channel("${darkblue}-FileServ-${reg}\tSending blocks @blocks from $name ($file)", $channel, $server);
    IRC::send_raw("PRIVMSG " . $channel . " :file sending $name @blocks" . $crlf);
    IRC::add_timeout_handler($send_delay, "FileServ::sendblock") unless scalar(@sendq);
    push @sendq, [$name, $channel, $server];
    return(1);
}

sub blocks {
    # /fblocks <name>
    # $file is used for nick of sender
    my ($name, @cmds) = split " ", $_[0];
    my ($file) = $fqueue{$name}[0];
    my ($channel, $server) = (IRC::get_info(2), IRC::get_info(3));
    unless($name) {
        # print out 
        return(1);
    }
    my @blocks;
    for (@{$fqueue{$name}[2]}) {
        $blocks[$_] = $_;
    }
    my ($sub, @range);
    for (@cmds) {
        $sub = 0;
        @range = ();
        /^!/ and $sub = 1;
        /^=/ and $sub = 2;
        /^[!=]?(\d+)\-(\d+)$/ and @range = $1 .. $2;
        /^[!=]?(\d+)$/ and @range = $1;
        if ($sub == 2) {
            my $min = $range[0];
            my $max = $range[-1];
            @range = (0 .. $min, $max .. $#{$fqueue{$name}[1]});
        }
        for (@range) {
            $blocks[$_] = $_ unless $sub;
            delete $blocks[$_] if $sub;
        }
    }
    $fqueue{$name}[2] = [];
    for (0 .. $#blocks) {
        push(@{$fqueue{$name}[2]}, $_) if $blocks[$_];
    }
    IRC::print_with_channel("${darkblue}-FileServ-${reg}\tBlocks @{$fqueue{$name}[2]} from $name ($file)", $channel, $server);
    return(1);
}

sub missing {
    # /fmissing <name>
    # $file is used for nick of sender
    my ($name) = $_[0];
    my ($file) = $fqueue{$name}[0];
    my ($channel, $server) = (IRC::get_info(2), IRC::get_info(3));
    unless($name) {
        return(1);
    }
    my @blocks;
    for (0 .. $#{$fqueue{$name}[1]}) {
        push @blocks, $_ unless $fqueue{$name}[1][$_];
    }
    if (@blocks) {
        IRC::print_with_channel("${darkblue}-FileServ-${reg}\tBlocks @blocks missing from $name ($file)", $channel, $server);
        IRC::send_raw("PRIVMSG " . $channel . " :file missing $name @blocks" . $crlf);
    } else {
        IRC::print_with_channel("${darkblue}-FileServ-${reg}\tNo blocks missing from $name ($file)", $channel, $server);
    }
    return(1);
}

sub sending {
    # /fsending <name>
    # $file is used for nick of sender
    my ($name) = $_[0];
    my ($file) = $fqueue{$name}[0];
    my ($channel, $server) = (IRC::get_info(2), IRC::get_info(3));
    unless($name) {
        return(1);
    }
    my @blocks;
    for (@{$fqueue{$name}[2]}) {
        push @blocks, $_ if $fqueue{$name}[1][$_];
    }
    if (@blocks) {
        IRC::print_with_channel("${darkblue}-FileServ-${reg}\tSending blocks @blocks from $name ($file)", $channel, $server);
        IRC::send_raw("PRIVMSG " . $channel . " :file sending $name @blocks" . $crlf);
    } else {
        IRC::print_with_channel("${darkblue}-FileServ-${reg}\tNot sending any blocks from $name ($file)", $channel, $server);
    }
    return(1);
}

sub save {
    # /fsave <name> <path/file>
    my ($name, $file) = split " ", $_[0], 2;
    my ($channel, $server) = (IRC::get_info(2), IRC::get_info(3));
    unless($name) {
        IRC::print_with_channel("${darkblue}-FileServ-${reg}\tComplete recv'ed files", $channel, $server);
        for (keys %complete_r) {
            IRC::print_with_channel("$_ => $fqueue{$_}[0]", $channel, $server);
        }
        return(1);
    }
    open my $fh, ">", $file or do {
        IRC::print_with_channel("${darkblue}-FileServ-${reg}\tError opening '$file': $!", $channel, $server);
        return(1);
    };
    binmode $fh;
    for (0 .. $#{$fqueue{$name}[1]}) {
        print $fh decode_base64($fqueue{$name}[1][$_]);
    }
    IRC::print_with_channel("${darkblue}-FileServ-${reg}\tSaved $name ($file)", $channel, $server);
    return(1);
}

sub save_base64 {
    # /fsave_base64 <name> <path/file>
    my ($name, $file) = split " ", $_[0], 2;
    my ($channel, $server) = (IRC::get_info(2), IRC::get_info(3));
    unless($name) {
        IRC::print_with_channel("${darkblue}-FileServ-${reg}\tComplete recv'ed files", $channel, $server);
        for (keys %complete_r) {
            IRC::print_with_channel("$_ => $fqueue{$_}[0]", $channel, $server);
        }
        return(1);
    }
    open my $fh, ">", $file or do {
        IRC::print_with_channel("${darkblue}-FileServ-${reg}\tError opening '$file': $!", $channel, $server);
        return(1);
    };
    for (@{$fqueue{$name}[1]}) {
        print $fh $_, "\n";
    }
    IRC::print_with_channel("${darkblue}-FileServ-${reg}\tSaved $name ($file)", $channel, $server);
    return(1);
}

sub clear {
    # /fclear <name>
    my ($name) = $_[0];
    my ($channel, $server) = (IRC::get_info(2), IRC::get_info(3));
    unless($name) {
        IRC::print_with_channel("${darkblue}-FileServ-${reg}\tAll files", $channel, $server);
        for (keys %fqueue) {
            IRC::print_with_channel("$_ => $fqueue{$_}[0]", $channel, $server);
        }
        return(1);
    }
    delete $fqueue{$name};
    delete $pending{$name};
    delete $sending{$name};
    delete $recving{$name};
    delete $complete_s{$name};
    delete $complete_r{$name};
    for (0 .. $#sendq) {
        next unless $sendq[$_][0] eq $name;
        delete $sendq[$_];
    }
    IRC::print_with_channel("${darkblue}-FileServ-${reg}\tCleared $name", $channel, $server);
    return(1);
}

sub privmsg {
    # message handler
    my $txt = shift @_;
    my ($channel, $server) = (IRC::get_info(2), IRC::get_info(3));
    my ($nick, $to, $cmd, $name);
    ($nick, $to, $cmd, $name, $txt) = $txt =~ /^:(\S+?)!\S+ PRIVMSG (\S+) :file (\S+) (\S+)(?: (.*))?/;
    if ($to eq IRC::get_info(1)) {
        $channel = $nick;
    }
    "queue" eq $cmd and do {
            unless ($fqueue{$name}) {
                my ($blocknum, $blocksize) = split " ", $txt;
                $fqueue{$name}[0] = $nick;
                $fqueue{$name}[2] = [];
                for (0 .. $blocknum) {
                    next if defined($fqueue{$name}[1][$_]);
                    $fqueue{$name}[1][$_] = "";
                    push @{$fqueue{$name}[2]}, $_;
                }
                IRC::print_with_channel("${darkblue}-FileServ-${reg}\t$name from $nick available ${gray}via ${to}${reg}"
                    . " (" . ($blocknum + 1) . " blocks x $blocksize base64 chars)", $channel, $server);
                return(1);
            }
        };
    "ready" eq $cmd and do {
            if ($pending{$name}) {
                IRC::print_with_channel("${darkblue}-FileServ-${reg}\t$nick ready for $name ${gray}via ${to}${reg}", $channel, $server);
                return(1);
            }
        };
    "missing" eq $cmd and do {
            if ($pending{$name}) {
                my @blocks = split " ", $txt;
                IRC::print_with_channel("${darkblue}-FileServ-${reg}\t$nick is missing @blocks from $name ${gray}via ${to}${reg}", $channel, $server);
                return(1);
            }
        };
    "sending" eq $cmd and do {
            if ($fqueue{$name} and $nick eq $fqueue{$name}[0]) {
                my @blocks = split " ", $txt;
                IRC::print_with_channel("${darkblue}-FileServ-${reg}\t$name from $nick is going to send blocks @blocks ${gray}via ${to}${reg}", $channel, $server);
                return(1);
            }
        };
    "send" eq $cmd and do {
            if ($fqueue{$name} and $nick eq $fqueue{$name}[0]) {
                $recving{$name} = 1;
                IRC::print_with_channel("${darkblue}-FileServ-${reg}\t$name from $nick starting ${gray}via ${to}${reg}", $channel, $server);
                return(1);
            }
        };
    "over" eq $cmd and do {
            if ($recving{$name} and $nick eq $fqueue{$name}[0]) {
                $complete_r{$name} = 1;
                $recving{$name} = 0;
                IRC::print_with_channel("${darkblue}-FileServ-${reg}\t$name from $nick finished ${gray}via ${to}${reg}", $channel, $server);
                return(1);
            }
        };
    "block" eq $cmd and do {
            if ($recving{$name} and $nick eq $fqueue{$name}[0]) {
                my ($blocknum, $block) = split " ", $txt, 3;
                $fqueue{$name}[1][$blocknum] = $block;
                delete $fqueue{$name}[2][$blocknum];
                IRC::print_with_channel("${darkblue}-FileServ-${reg}\t${gray}block $blocknum of $name from $nick via ${to}${reg}", $server, $server) unless $noprintblock;
                return(1);
            }
        };
    return(0);
}

IRC::print_with_channel("${darkblue}-FileServ-${reg}\tloaded", IRC::get_info(3), IRC::get_info(3));
