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