#!/usr/bin/perl -w

# client for stream exchange of the FEX service
#
# Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
#
# Copyright: GNU General Public License

use Getopt::Std;
use Socket;
use IO::Handle;
use IO::Socket::INET;
use Digest::MD5 qw(md5_hex);  # encypted ID / SID 

$0 =~ s:.*/::;
$| = 1;

$bs = 1024; # blocksize

$fexhome = $ENV{FEXHOME} || $ENV{HOME}.'/.fex';

if ($0 eq 'sexsend') {
  $usage = "usage: ... | $0 [-vtdF] [SEX-URL/]recipient [stream]\n".
           "options:  -v           verbose mode\n".
           "          -t           text mode\n".
           "          -d           do not check recipient for mutt alias\n".
           "          -F           start with fill character (1 kB '#')\n".
           "special: recipient may be \"public\"\n",
}

if ($0 eq 'sexget') {
  $usage = "usage: $0 [-v] [-u [SEX-URL/]user:ID] [stream]\n".
           "options: -v           verbose mode\n".
           "         -u user:ID   use this user & ID (ID may be \"public\")\n";
}

$user = $id = '';
$idf = "$fexhome/id" unless $idf;

if ($ENV{FEXID}) {
  ($fexcgi,$user,$id) = split(/\s+/,$ENV{FEXID});
} else {
  if (open F,$idf) {
    chomp($fexcgi = <F>) or die "$0: no FEX-URL in $idf\n";
    chomp($user = <F>)   or die "$0: no FROM in $idf\n";
    chomp($id = <F>)     or die "$0: no ID in $idf\n";
    close F;
    despace($fexcgi,$user,$id);
    unless ($fexcgi =~ /^[_:=\w\-\.\/\@\%]+$/) {
      die "$0: illegal FEX-URL \"$fexcgi\" in $idf\n";
    }
    unless ($user =~ /^[_:=\w\-\.\/\@\%\+]+$/) {
      die "$0: illegal FROM \"$user\" in $idf\n";
    }
  }
}

$opt_h = $opt_v = $opt_d = $opt_F = 0;
$opt_t = $opt_u = '';

getopts('hvtdFu:') or die $usage;

die $usage if $opt_h;
$opt_t = '&type=TEXT' if $opt_t;

if ($opt_u) {
  $fexcgi = $1 if $opt_u =~ s:(.+)/::;
  ($user,$id) = split(':',$opt_u);
  die $usage unless $id;
} elsif (@ARGV and $ARGV[0] =~ s:(.+)/::) {
  $fexcgi = $1;
}

unless ($fexcgi) {
  die "$0: no SEX URL found, use \"$0 URL/USER\" or \"fexsend -I\"\n";
}

unless (-d $fexhome) {
  mkdir $fexhome,0700 or die "$0: cannot create FEXHOME $fexhome - $!\n";
}

$fexcgi =~ s(^http://)()i;
$fexcgi =~ s(/fup.*)();
$server = $fexcgi;

if ($server =~ /:(\d+)/) { $port = $1 } 
else                     { $port = 80 }    

$server =~ s([:/].*)();

warn "connect $server:$port\n" if $opt_v;

## set up tcp/ip connection
# $iaddr = gethostbyname($server) 
#          or die "$0: cannot find ip-address for $server $!\n";
# socket(SH,PF_INET,SOCK_STREAM,getprotobyname('tcp')) or die "$0: socket $!\n";
# connect(SH,sockaddr_in($port,$iaddr)) or die "$0: connect $!\n";
if ($port == 443) {
  eval "use IO::Socket::SSL";
  $SH = IO::Socket::SSL->new(                                                  
    PeerAddr => $server,                                                       
    PeerPort => $port,                                                         
    Proto    => 'tcp',                                                         
  );                                                                           
} else {                                                                       
  $SH = IO::Socket::INET->new(
    PeerAddr => $server,
    PeerPort => $port,
    Proto    => 'tcp',                                                         
  );                                                                           
}                                                                              
die "cannot connect $server:$port - $!\n" unless $SH;                          
print "TCPCONNECT to $server:$port\n" if $opt_v;

autoflush $SH 1;

$stream = $mode = '';

if ($0 eq 'sexget') {
  $stream = "&stream=" . shift if @ARGV;
  if ($id eq 'public') {
    $cid = 'public';
  } else {
    $cid = query_sid($server,$port,$id);
  }
  request("GET /sex?user=$user&ID=$cid$stream HTTP/1.0");
  if ($H{'CONTENT-TYPE'}||'' =~ /text/i) {
    print while <$SH>;
  } else {
    print while read $SH,$_,$bs;
  }
#  if ($opt_t) {
#    while (sysread STDIN,$c,1) {
#      print $c;
#      $line .= $c;
#      if ($c eq "\n") {
#        print $line;
#        $line = '';
#      }
#    }
  exit;
}

if ($0 eq 'sexsend') {
  $SIG{PIPE} = \&sigpipehandler;
  if (@ARGV) {
    $to = shift;
    $stream = "&stream=" . shift if @ARGV;
    if ($to eq 'public') {
      die "$0: need user/ID when sending to public, set it with fexsend -I\n" unless $user and $id;
      print "http://$server:$port/sex?user=$user&ID=public$stream\n";
      $cid = query_sid($server,$port,$id);
      $mode = "&ID=$cid&mode=public";
    } else {
      $user = checkalias($to) unless $opt_d;
    }
  } else {
    die $usage;
  }
  request("POST /sex?user=$user$mode$opt_t$stream HTTP/1.0");
  print $SH '#'x1023,"\n" if $opt_F;
  
  $t0 = time;
  if ($opt_t) {
    while (<STDIN>) {
      print {$SH} $_;
      print if $opt_v;
      $B += length;
    }
  } else {
    while ($b = read STDIN,$_,$bs) {
      print {$SH} $_;
      print if $opt_v;
      $B += $b;
    }
  }
  $tt = (time-$t0)||1;

  if ($opt_v) {
    if ($B>2097152) {
      printf "transfered: %d MB in %d s with %d kB/s\n",
             int($B/1048576),$tt,int($B/1024/$tt);
    } elsif($B>2048) {
      printf "transfered: %d kB in %d s with %d kB/s\n",
             int($B/1024),$tt,int($B/1024/$tt);
    } else {
      printf "transfered: %d B in %d s with %d kB/s\n",
             $B,$tt,int($B/1024/$tt);
    }
  }
}

exit;

sub request {
  my $req = shift;
  my $error = '';
  
  $req .= "\r\n";
  warn "==> $req" if $opt_v;
  print {$SH} $req;
  print {$SH} "\r\n";
  $_ = <$SH>;
  unless (defined $_) {
    die "$0: server has closed the connection\n";
  }
  if (/^HTTP\/[\d\.]+ 200/) {
    warn "<== $_" if $opt_v;
  } else {
    if ($opt_v) {
      warn "<== $_";
      $error = $_;
    } else {
      s:^HTTP/[ \d\.]+::;
      s/\r//;
      die "$0: server response: $_";
    }
  }
  while (<$SH>) {
    last if /^\s*$/;
    $H{uc($1)} = $2 if /(.+):\s*(.+)/;
    warn "<== $_" if $opt_v;
  }
  exit 1 if $error;
}

# check for (mutt) alias
sub checkalias {
  my $to = shift;
  if ($to !~ /@/ and open F,$ENV{HOME}.'/.mutt/aliases') {
    while (<F>) {
      next if /,/;
      if (/^alias $to\s/i) {
        chomp;
        s/\s*#.*//;
        s/\s+$//;
        s/.*\s+//;
        s/<//;
        s/>//;
        $to = $_;
        warn "$0: found alias, using address $to\n";
        die unless $to;
        last;
      }
    }
    close F;
  }
  return $to;
}

sub despace {
  foreach (@_) {
    s/^\s+//;
    s/\s+$//;
  }
}

sub query_sid {
  my ($server,$port,$id) = @_;
  my $req;
  local $_;
  
  $req = "GET SID HTTP/1.1";
  print "==> $req\n" if $opt_v;
  print {$SH} "$req\r\n\r\n";
  $_ = <$SH>;
  s/\r//;
  unless (defined $_ and /\w/) { 
    print "\n" if $opt_v;
    die "$0: no response from server\n";
  }
  if (/^HTTP.* 201 (.+)/) {
    print "<== $_" if $opt_v;
    $id = 'MD5H:'.md5_hex($id.$1);
    while (<$SH>) { 
      s/\r//;
      last if /^\n/;
      print "<== $_" if $opt_v;
    }
  } else {
    die "$0: $server does not support session ID\n";
  }
  return $id;
}

sub sigpipehandler { 
  local $_ = '';
  $SIG{ALRM} = sub { };
  alarm(1);
  @_ = <$SH>;
  if (@_  and $_[0] =~ /^HTTP.* \d+ (.*)/) {
    if ($opt_v) {
      die "\n$0: server error: @_\n";
    } else {
      die "\n$0: server error: $1\n";
    }
  } else {
    die "\n$0: got SIGPIPE (fex server died?)\n";
  }
}
