bin/sexsend

   1 #!/usr/bin/perl -w
   2
   3 # client for stream exchange of the FEX service
   4 #
   5 # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
   6 #
   7 # Perl Artistic Licence
   8
   9 # sexsend / sexget / sexxx
  10
  11 use Getopt::Std;
  12 use Socket;
  13 use IO::Handle;
  14 use IO::Socket::INET;
  15 use Digest::MD5 qw(md5_hex);  # encypted ID / SID
  16
  17 use constant k => 2**10;
  18 use constant M => 2**20;
  19
  20 eval 'use Net::INET6Glue::INET_is_INET6';
  21
  22 our $version = 20150826;
  23
  24 my %SSL = (SSL_version => 'TLSv1');
  25 my $sigpipe;
  26
  27 if (-f ($_ = '/etc/fex/config.pl')) {
  28   eval { require } or warn $@;
  29 }
  30
  31 $0 =~ s:.*/::;
  32 $| = 1;
  33
  34 # sexsend is default
  35 $usage =
  36   "usage: ... | $0 [options] [SEX-URL/]recipient [stream]\n".
  37   "options: -v           verbose mode\n".
  38   "         -g           show transfer rate\n".
  39   "         -V           show version\n".
  40   "         -t timeout   timeout in s (waiting for recipient)\n".
  41   "special: recipient may be \"public\" or \"anonymous\" or \".\"\n".
  42   "see also: sexget, sexxx\n".
  43   "example: tail -f /var/log/syslog | $0 fex.flupp.org/admin log\n";
  44
  45 if ($0 eq 'sexget' or $0 eq 'fuckme') {
  46   $usage =
  47     "usage: $0 [options] [[SEX-URL/]user:ID] [stream]\n".
  48     "options: -v           verbose mode\n".
  49     "         -g           show transfer rate\n".
  50     "         -V           show version\n".
  51     "arguments: user:ID    use this user & ID\n".
  52     "                      (ID may be \"public\" or user:ID may be \"anonymous\")\n".
  53     "           stream     name of the stream\n".
  54     "see also: sexsend, sexxx\n".
  55     "example: $0 log | grep kernel\n";
  56 }
  57
  58 if ($0 eq 'sexxx') {
  59   $usage =
  60     "usage: $0 [-v] [-g] [-c] [-u [SEX-URL/]user] [-s stream] [files...]\n".
  61     "usage: $0 [-v] [-g]      [-u [SEX-URL/]user] [-s stream] | ...\n".
  62     "options: -v               verbose mode\n".
  63     "         -g               show transfer rate\n".
  64     "         -q               quiet mode\n".
  65     "         -c               compress files\n".
  66     "         -u SEX-URL/user  SEX-URL and user (default: use FEXID/FEXXX)\n".
  67     "         -s stream        stream name (default: xx)\n".
  68     "see also: sexsend, sexget\n".
  69     "examples: $0 -s config /etc /usr/local/etc\n".
  70     "          $0 > backup.tar\n";
  71 }
  72
  73 $fexhome = $ENV{FEXHOME} || $ENV{HOME}.'/.fex';
  74 $user = $id = '';
  75 $type = $timeout = $stream = $mode = '';
  76 $idf = "$fexhome/id";
  77 $bs = $ENV{BS} || 2**16; # I/O blocksize
  78
  79 # server URL, user and auth-ID
  80 if ($FEXID = $ENV{FEXID}) {
  81   $FEXID = decode_b64($FEXID) if $FEXID !~ /\s/;
  82   ($fexcgi,$user,$id) = split(/\s+/,$FEXID);
  83 } else {
  84   if (open $idf,$idf) {
  85     chomp($fexcgi = <$idf>) or die "$0: no FEX-URL in $idf\n";
  86     chomp($user = <$idf>)   or die "$0: no FROM in $idf\n";
  87     chomp($id = <$idf>)     or die "$0: no ID in $idf\n";
  88     close $idf;
  89     despace($fexcgi,$user,$id);
  90     unless ($fexcgi =~ /^[_:=\w\-\.\/\@\%]+$/) {
  91       die "$0: illegal FEX-URL \"$fexcgi\" in $idf\n";
  92     }
  93     unless ($user =~ /^[_:=\w\-\.\/\@\%\+]+$/) {
  94       die "$0: illegal FROM \"$user\" in $idf\n";
  95     }
  96   }
  97 }
  98
  99 $opt_h = $opt_v = $opt_V = $opt_q = 0;
 100 $opt_u = $opt_s = $opt_c = $opt_t = '';
 101
 102 $_ = "$fexhome/config.pl"; require if -f;
 103
 104 if ($0 eq 'sexxx') {
 105
 106   # xx server URL, user and auth-ID
 107   if ($FEXXX = $ENV{FEXXX}) {
 108     $FEXXX = decode_b64($FEXXX) if $FEXXX !~ /\s/;
 109     ($fexcgi,$user,$id) = split(/\s+/,$FEXXX);
 110   } elsif (open $idf,$idf) {
 111     while (<$idf>) {
 112       if (/^\[xx\]/) {
 113         chomp($fexcgi = <$idf>) or die "$0: no xx FEX-URL in $idf\n";
 114         chomp($user = <$idf>)   or die "$0: no xx FROM in $idf\n";
 115         chomp($id = <$idf>)     or die "$0: no xx ID in $idf\n";
 116         last;
 117       }
 118     }
 119     close $idf;
 120   }
 121
 122   getopts('hgvcu:s:') or die $usage;
 123   die $usage if $opt_h;
 124   die $usage unless -t;
 125
 126   if ($opt_c) {
 127     $opt_c = 'z';
 128     $type = '&type=GZIP';
 129   }
 130
 131   if ($opt_u) {
 132     $fexcgi = $1 if $opt_u =~ s:(.+)/::;
 133     $user = $opt_u;
 134   }
 135
 136   unless ($fexcgi) {
 137     die "$0: no xx user found, use \"$0 -u SEX-URL/user\"\n";
 138   }
 139
 140   unless ($user) {
 141     die "$0: no xx user found, use \"$0 -u user\"\n";
 142   }
 143
 144 } elsif ($0 eq 'sexget' or $0 eq 'fuckme') {
 145   getopts('hgvVdu:') or die $usage;
 146   die $usage if $opt_h;
 147
 148
 149   if ($opt_V) {
 150     print "Version: $version\n";
 151     exit unless @ARGV;
 152   }
 153
 154   if (not $opt_u and @ARGV and $ARGV[0] =~ m{^anonymous|/|:}) {
 155     $opt_u = shift @ARGV;
 156   }
 157
 158   if ($opt_u) {
 159     $fexcgi = $1 if $opt_u =~ s:(.+)/::;
 160     ($user,$id) = split(':',$opt_u);
 161     if ($user =~ /^anonymous/) {
 162       $anonymous = $user;
 163     } elsif (not $id) {
 164       die $usage;
 165     }
 166   }
 167
 168   unless ($fexcgi) {
 169     die "$0: no SEX URL found, use \"$0 -u SEX-URL/recipient\" or \"fexsend -I\"\n";
 170   }
 171
 172   unless ($user) {
 173     die "$0: no recipient found, use \"$0 -u SEX-URL/recipient\" or \"fexsend -I\"\n";
 174   }
 175
 176 } else { # sexsend
 177
 178   $opt_g = 1;
 179   getopts('hguvqVTt:') or die $usage;
 180   die $usage if $opt_h;
 181
 182   if ($opt_V) {
 183     print "Version: $version\n";
 184     exit unless @ARGV;
 185   }
 186
 187   if ($opt_t and $opt_t =~ /^\d+$/) {
 188     $timeout = "&timeout=$opt_t";
 189   }
 190
 191   my $save_user = $user;
 192   $user = shift or die $usage;
 193   $fexcgi = $1 if $user =~ s:(.+)/::;
 194
 195   if ($user =~ /^anonymous/) {
 196     die "$0: need SEX-URL with anonymous SEX\n" unless $fexcgi;
 197     $mode = 'anonymous';
 198   } elsif ($user eq 'public') {
 199     unless ($id) {
 200       die "$0: public SEX not possible without FEXID, set it with \"fexsend -I\"\n";
 201     }
 202     $mode = $user;
 203     $user = $save_user;
 204   } elsif ($user eq '.') {
 205     open $idf,$idf or die "$0: no $idf\n";
 206     $_ = <$idf>;
 207     $user = <$idf>||'';
 208     chomp $user;
 209   } else {
 210     unless ($fexcgi) {
 211       die "$0: no SEX URL found, use \"$0 SEX-URL/recipient\" or \"fexsend -I\"\n";
 212     }
 213   }
 214
 215 }
 216
 217 &get_ssl_env;
 218
 219 $fexcgi =~ s(^http://)()i;
 220 $fexcgi =~ s(/fup.*)();
 221 $server = $fexcgi;
 222
 223 if    ($server =~ s(^https://)()i) { $port = 443 }
 224 elsif ($server =~ /:(\d+)/)        { $port = $1 }
 225 else                               { $port = 80 }
 226
 227 $server =~ s([:/].*)();
 228
 229 ## set up tcp/ip connection
 230 # $iaddr = gethostbyname($server)
 231 #          or die "$0: cannot find ip-address for $server $!\n";
 232 # socket(SH,PF_INET,SOCK_STREAM,getprotobyname('tcp')) or die "$0: socket $!\n";
 233 # connect(SH,sockaddr_in($port,$iaddr)) or die "$0: connect $!\n";
 234 # warn "connecting $server:$port user=$user\n";
 235 if ($port == 443) {
 236   if ($opt_v and %SSL) {
 237     foreach my $v (keys %SSL) {
 238       printf "%s => %s\n",$v,$SSL{$v};
 239     }
 240   }
 241   eval "use IO::Socket::SSL";
 242   die "$0: cannot load IO::Socket::SSL\n" if $@;
 243   $SH = IO::Socket::SSL->new(
 244     PeerAddr => $server,
 245     PeerPort => $port,
 246     Proto    => 'tcp',
 247     %SSL
 248   );
 249 } else {
 250   $SH = IO::Socket::INET->new(
 251     PeerAddr => $server,
 252     PeerPort => $port,
 253     Proto    => 'tcp',
 254   );
 255 }
 256
 257 die "cannot connect $server:$port - $!\n" unless $SH;
 258 warn "TCPCONNECT to $server:$port\n" if $opt_v;
 259
 260 # autoflush $SH 1;
 261 autoflush STDERR;
 262
 263 $SIG{PIPE} = \&sigpipehandler;
 264
 265 if ($0 eq 'sexget' or $0 eq 'fuckme') {
 266   $stream = "&stream=" . shift if @ARGV;
 267   if ($anonymous) {
 268     $cid = 'anonymous';
 269   } elsif ($id eq 'public') {
 270     $cid = 'public';
 271   } else {
 272     $cid = query_sid($server,$port,$id);
 273   }
 274   request("GET /sex?BS=$bs&user=$user&ID=$cid$stream HTTP/1.0");
 275   transfer($SH,STDOUT);
 276   # print while sysread $SH,$_,$bs;
 277   exit;
 278 }
 279
 280 if ($0 eq 'sexxx') {
 281   $stream = "&stream=" . ($opt_s || 'xx');
 282   if (@ARGV) {
 283     warn "streaming:\n";
 284     open my $tar,'-|','tar',"cv${opt_c}f",'-',@ARGV or die "$0: cannot run tar - $!\n";
 285     request("POST /sex?BS=$bs&user=$user$type$stream HTTP/1.0");
 286     transfer($tar,$SH);
 287     # while (read $tar,$_,$bs) { syswrite $SH,$_ }
 288   } else {
 289     $cid = query_sid($server,$port,$id);
 290     request("GET /sex?BS=$bs&user=$user&ID=$cid$stream HTTP/1.0");
 291     $opt_c = 'z' if $H{'CONTENT-TYPE'} =~ /gzip/i;
 292     if (-t STDOUT) {
 293       print "extracting from stream:\n";
 294       open $out,"|tar xv${opt_c}f -" or die "$0: cannot run tar - $!\n";
 295     } else {
 296       if ($opt_c) {
 297         open $out,"|gzip -d" or die "$0: cannot run gunzip - $!\n";
 298       } else {
 299         $out = *STDOUT;
 300       }
 301     }
 302     print {$out} $_ while sysread $SH,$_,$bs;
 303   }
 304   exit;
 305 }
 306
 307 # sexsend
 308 $stream = "&stream=" . shift if @ARGV;
 309
 310 if ($mode eq 'anonymous') {
 311   unless ($opt_q) {
 312     print "http://$server:$port/sex?user=$user&ID=anonymous$stream\n";
 313     printf "http://$server:$port/sex?%s\n",
 314            encode_b64("user=$user&ID=anonymous$stream");
 315   }
 316   $mode = "&mode=anonymous";
 317 } elsif ($mode eq 'public') {
 318   die "$0: need user/ID when sending to public, set it with fexsend -I\n" unless $user and $id;
 319   unless ($opt_q) {
 320     print "http://$server:$port/sex?user=$user&ID=public$stream\n";
 321     printf "http://$server:$port/sex?%s\n",
 322            encode_b64("user=$user&ID=public$stream");
 323   }
 324   $cid = query_sid($server,$port,$id);
 325   $mode = "&ID=$cid&mode=public";
 326 } else {
 327   # $user = checkalias($user) unless $opt_d;
 328 }
 329
 330 request("POST /sex?BS=$bs&user=$user$mode$type$timeout$stream HTTP/1.0");
 331 print STDERR "==> (streaming ...)\n" if $opt_v;
 332
 333 transfer(STDIN,$SH);
 334
 335 exit;
 336
 337
 338 sub transfer {
 339   my $source = shift;
 340   my $destination = shift;
 341   my ($t0,$t1,$tt);
 342   my ($B,$b,$bt);
 343
 344   $t0 = $t2 = time;
 345   $tt = $t0-1;
 346   $t1 = 0;
 347
 348   while ($b = sysread $source,$_,$bs) {
 349     print {$destination} $_ or die "$0: link failure - $!\n";
 350     $B += $b;
 351     $bt += $b;
 352     $t2 = time;
 353     if ($t2>$t1) {
 354       if ($opt_g) {
 355         if ($B>2*M) {
 356           printf STDERR "%d MB %d kB/s        \r",
 357             int($B/M),int($bt/k/($t2-$tt));
 358         } else {
 359           printf STDERR "%d kB %d kB/s        \r",
 360             int($B/k),int($bt/k/($t2-$tt));
 361         }
 362       }
 363       $t1 = $t2;
 364       if ($t2-$tt>10) {
 365         sleep 1; # be nice to bandwith
 366         $bt = 0;
 367         $tt = $t2;
 368       }
 369     }
 370   }
 371
 372   die "$0: no stream data\n" unless $B;
 373
 374   $tt = (time-$t0)||1;
 375
 376   if ($opt_v or $opt_g) {
 377     if ($B>2097152) {
 378       printf STDERR "transfered: %d MB in %d s with %d kB/s\n",
 379         int($B/1048576),$tt,int($B/1024/$tt);
 380     } elsif($B>2048) {
 381       printf STDERR "transfered: %d kB in %d s with %d kB/s\n",
 382         int($B/1024),$tt,int($B/1024/$tt);
 383     } else {
 384       printf STDERR "transfered: %d B in %d s with %d kB/s\n",
 385         $B,$tt,int($B/1024/$tt);
 386     }
 387   }
 388
 389 }
 390
 391
 392 sub request {
 393   my $req = shift;
 394
 395   print STDERR "==> $req\n" if $opt_v;
 396   syswrite $SH,"$req\r\n\r\n";
 397   for (;;) {
 398     unless (defined($_ = &getline)) {
 399       die "$0: server has closed the connection\n";
 400     }
 401     if (/^HTTP\/[\d\.]+ 200/) {
 402       print STDERR "<== $_" if $opt_v;
 403       last;
 404     } elsif (/^HTTP\/[\d\.]+ 199/) {
 405       print STDERR "<== $_" if $opt_v;
 406     } else {
 407       if ($opt_v) {
 408         print STDERR "<== $_";
 409         exit 3;
 410       } else {
 411         s:^HTTP/[ \d\.]+::;
 412         s/\r//;
 413         die "$0: server response: $_";
 414       }
 415     }
 416   }
 417   while (defined($_ = &getline)) {
 418     last if /^\s*$/;
 419     $H{uc($1)} = $2 if /(.+):\s*(.+)/;
 420     print STDERR "<== $_" if $opt_v;
 421   }
 422 }
 423
 424 # check for (mutt) alias
 425 sub checkalias {
 426   my $to = shift;
 427   if ($to !~ /@/ and open F,$ENV{HOME}.'/.mutt/aliases') {
 428     while (<F>) {
 429       next if /,/;
 430       if (/^alias $to\s/i) {
 431         chomp;
 432         s/\s*#.*//;
 433         s/\s+$//;
 434         s/.*\s+//;
 435         s/<//;
 436         s/>//;
 437         $to = $_;
 438         warn "$0: found alias, using address $to\n";
 439         die unless $to;
 440         last;
 441       }
 442     }
 443     close F;
 444   }
 445   return $to;
 446 }
 447
 448 sub despace {
 449   foreach (@_) {
 450     s/^\s+//;
 451     s/\s+$//;
 452   }
 453 }
 454
 455 sub query_sid {
 456   my ($server,$port,$id) = @_;
 457   my $req;
 458   local $_;
 459
 460   $req = "GET SID HTTP/1.1";
 461   print STDERR "==> $req\n" if $opt_v;
 462   syswrite $SH,"$req\r\n\r\n";
 463   $_ = &getline;
 464   unless (defined $_ and /\w/) {
 465     print STDERR "\n" if $opt_v;
 466     die "$0: no response from server\n";
 467   }
 468   s/\r//;
 469   if (/^HTTP.* 201 (.+)/) {
 470     print STDERR "<== $_" if $opt_v;
 471     $id = 'MD5H:'.md5_hex($id.$1);
 472     while (defined($_ = &getline)) {
 473       s/\r//;
 474       last if /^\n/;
 475       print STDERR "<== $_" if $opt_v;
 476     }
 477   } else {
 478     die "$0: $server does not support session ID\n";
 479   }
 480   return $id;
 481 }
 482
 483 sub sigpipehandler {
 484   local $_ = '';
 485   $SIG{ALRM} = sub { };
 486   alarm(1);
 487   $_ = &getline||'';
 488   if (/^HTTP.* \d+ (.*)/) {
 489     if ($opt_v) {
 490       die "\n$0: server error: @_\n";
 491     } else {
 492       die "\n$0: server error: $1\n";
 493     }
 494   } else {
 495     die "\n$0: got SIGPIPE (server closed connection)\n";
 496   }
 497 }
 498
 499 # read one text line from $SH;
 500 sub getline {
 501   my $line = '';
 502   my $c;
 503
 504   local $SIG{ALRM} = sub { die "$0: timeout while waiting for server reply\n" };
 505   alarm($opt_t||300);
 506
 507   # must use sysread to avoid perl line buffering
 508   while (sysread $SH,$c,1) {
 509     $line .= $c;
 510     last if $c eq "\n";
 511   }
 512
 513   alarm(0);
 514
 515   return $line;
 516 }
 517
 518 # from MIME::Base64::Perl
 519 sub decode_b64 {
 520   local $_ = shift;
 521   my $uu = '';
 522   my ($i,$l);
 523
 524   tr|A-Za-z0-9+=/||cd;
 525   s/=+$//;
 526   tr|A-Za-z0-9+/| -_|;
 527   return "" unless length;
 528
 529   $l = (length) - 60;
 530   for ($i = 0; $i <= $l; $i += 60) {
 531     $uu .= "M" . substr($_,$i,60);
 532   }
 533   $_ = substr($_,$i);
 534   if (length) {
 535     $uu .= chr(32 + (length)*3/4) . $_;
 536   }
 537   return unpack ("u",$uu);
 538 }
 539
 540
 541 ### common functions ###
 542
 543
 544 sub mtime {
 545   my @d = localtime((stat shift)[9]);
 546   return sprintf('%d%02d%02d',$d[5]+1900,$d[4]+1,$d[3]);
 547 }
 548
 549
 550 sub urldecode {
 551   local $_ = shift;
 552   s/\%([a-f\d]{2})/chr(hex($1))/ige;
 553   return $_;
 554 }
 555
 556
 557 sub get_ssl_env {
 558   # set SSL/TLS options
 559   $SSL{SSL_verify_mode} = $ENV{SSLVERIFY} if defined($ENV{SSLVERIFY});
 560   foreach my $opt (qw(
 561     SSL_version
 562     SSL_cipher_list
 563     SSL_verify_mode
 564     SSL_ca_path
 565     SSL_ca_file)
 566   ) {
 567     my $env = uc($opt);
 568     $env =~ s/_//g;
 569     $SSL{$opt} = $ENV{$env} if defined($ENV{$env});
 570   }
 571
 572   if ($SSL{SSL_verify_mode}) {
 573     &search_ca;
 574     unless ($SSL{SSL_ca_path} or $SSL{SSL_ca_file}) {
 575       die "$0: \$SSLVERIFYMODE, but not valid \$SSLCAPATH or \$SSLCAFILE\n";
 576     }
 577   } elsif (defined($SSL{SSL_verify_mode})) {
 578     # user has set SSLVERIFY=0 !
 579   } else {
 580     &search_ca;
 581     $SSL{SSL_verify_mode} = 1 if $SSL{SSL_ca_path} or $SSL{SSL_ca_file};
 582   }
 583 }
 584
 585 sub search_ca {
 586   local $_;
 587   return if $SSL{SSL_ca_file} or $SSL{SSL_ca_path};
 588   foreach (qw(/etc/ssl/certs/ca-certificates.crt)) {
 589     if (-f) {
 590       $SSL{SSL_ca_file} = $_;
 591       return;
 592     }
 593   }
 594   foreach (qw(/etc/ssl/certs /etc/pki/tls/certs)) {
 595     if (-f) {
 596       $SSL{SSL_ca_path} = $_;
 597       return;
 598     }
 599   }
 600 }
 601
 602
 603 sub serverconnect {
 604   my ($server,$port) = @_;
 605   my $connect = "CONNECT $server:$port HTTP/1.1";
 606   local $_;
 607
 608   if ($opt_v and $port == 443 and %SSL) {
 609     foreach my $v (keys %SSL) {
 610       printf "%s => %s\n",$v,$SSL{$v};
 611     }
 612   }
 613
 614   if ($proxy) {
 615     tcpconnect(split(':',$proxy));
 616     if ($port == 443) {
 617       printf "--> %s\n",$connect if $opt_v;
 618       nvtsend($connect,"");
 619       $_ = <$SH>;
 620       s/\r//;
 621       printf "<-- $_"if $opt_v;
 622       unless (/^HTTP.1.. 200/) {
 623         die "$0: proxy error : $_";
 624       }
 625       eval "use IO::Socket::SSL";
 626       die "$0: cannot load IO::Socket::SSL\n" if $@;
 627       $SH = IO::Socket::SSL->start_SSL($SH,%SSL);
 628     }
 629   } else {
 630     tcpconnect($server,$port);
 631   }
 632 #  if ($port == 443 and $opt_v) {
 633 #    printf "%s\n",$SH->get_cipher();
 634 #  }
 635 }
 636
 637
 638 # set up tcp/ip connection
 639 sub tcpconnect {
 640   my ($server,$port) = @_;
 641
 642   if ($SH) {
 643     close $SH;
 644     undef $SH;
 645   }
 646
 647   if ($port == 443) {
 648     # eval "use IO::Socket::SSL qw(debug3)";
 649     eval "use IO::Socket::SSL";
 650     die "$0: cannot load IO::Socket::SSL\n" if $@;
 651     $SH = IO::Socket::SSL->new(
 652       PeerAddr => $server,
 653       PeerPort => $port,
 654       Proto    => 'tcp',
 655       %SSL
 656     );
 657   } else {
 658     $SH = IO::Socket::INET->new(
 659       PeerAddr => $server,
 660       PeerPort => $port,
 661       Proto    => 'tcp',
 662     );
 663   }
 664
 665   if ($SH) {
 666     autoflush $SH 1;
 667   } else {
 668     die "$0: cannot connect $server:$port - $@\n";
 669   }
 670
 671   print "TCPCONNECT to $server:$port\n" if $opt_v;
 672 }
 673
 674
 675 sub sendheader {
 676   my $sp = shift;
 677   my @head = @_;
 678   my $head;
 679
 680   push @head,"Host: $sp";
 681
 682   foreach $head (@head) {
 683     print "--> $head\n" if $opt_v;
 684     print {$SH} $head,"\r\n";
 685   }
 686   print "-->\n" if $opt_v;
 687   print {$SH} "\r\n";
 688 }
 689
 690
 691 sub nvtsend {
 692   local $SIG{PIPE} = sub { $sigpipe = "@_" };
 693
 694   $sigpipe = '';
 695
 696   die "$0: internal error: no active network handle\n" unless $SH;
 697   die "$0: remote host has closed the link\n" unless $SH->connected;
 698
 699   foreach my $line (@_) {
 700     print {$SH} $line,"\r\n";
 701     if ($sigpipe) {
 702       undef $SH;
 703       return 0;
 704     }
 705   }
 706
 707   return 1;
 708 }
 709
 710
 711 # from MIME::Base64::Perl
 712 sub encode_b64 {
 713   my $res = "";
 714   my $eol = "\n";
 715   my $padding;
 716
 717   pos($_[0]) = 0;
 718   $res = join '',map(pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs));
 719   $res =~ tr|` -_|AA-Za-z0-9+/|;
 720   $padding = (3-length($_[0])%3)%3;
 721   $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
 722   return $res;
 723 }