]> git.treefish.org Git - fex.git/blob - htdocs/download/sexsend
Original release 20160919
[fex.git] / 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 = 20160919;
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";
400   syswrite $SH,"User-Agent: sexsend\r\n";
401   syswrite $SH,"\r\n";
402   for (;;) {
403     unless (defined($_ = &getline)) {
404       die "$0: server has closed the connection\n";
405     }
406     if (/^HTTP\/[\d\.]+ 200/) {
407       print STDERR "<-- $_" if $opt_v;
408       last;
409     } elsif (/^HTTP\/[\d\.]+ 199/) {
410       print STDERR "<-- $_" if $opt_v;
411     } else {
412       if ($opt_v) {
413         print STDERR "<-- $_";
414         exit 3;
415       } else {
416         s:^HTTP/[ \d\.]+::;
417         s/\r//;
418         die "$0: server response: $_";
419       }
420     }
421   }
422   while (defined($_ = &getline)) {
423     last if /^\s*$/;
424     $H{uc($1)} = $2 if /(.+):\s*(.+)/;
425     print STDERR "<-- $_" if $opt_v;
426   }
427 }
428
429 # check for (mutt) alias
430 sub checkalias {
431   my $to = shift;
432   if ($to !~ /@/ and open F,$ENV{HOME}.'/.mutt/aliases') {
433     while (<F>) {
434       next if /,/;
435       if (/^alias $to\s/i) {
436         chomp;
437         s/\s*#.*//;
438         s/\s+$//;
439         s/.*\s+//;
440         s/<//;
441         s/>//;
442         $to = $_;
443         warn "$0: found alias, using address $to\n";
444         die unless $to;
445         last;
446       }
447     }
448     close F;
449   }
450   return $to;
451 }
452
453 sub despace {
454   foreach (@_) {
455     s/^\s+//;
456     s/\s+$//;
457   }
458 }
459
460 sub query_sid {
461   my ($server,$port,$id) = @_;
462   my $req;
463   local $_;
464
465   $req = "GET SID HTTP/1.1";
466   print STDERR "--> $req\n" if $opt_v;
467   syswrite $SH,"$req\r\n\r\n";
468   $_ = &getline;
469   unless (defined $_ and /\w/) {
470     print STDERR "\n" if $opt_v;
471     die "$0: no response from server\n";
472   }
473   s/\r//;
474   if (/^HTTP.* 201 (.+)/) {
475     print STDERR "<-- $_" if $opt_v;
476     $id = 'MD5H:'.md5_hex($id.$1);
477     while (defined($_ = &getline)) {
478       s/\r//;
479       last if /^\n/;
480       print STDERR "<-- $_" if $opt_v;
481     }
482   } else {
483     die "$0: $server does not support session ID\n";
484   }
485   return $id;
486 }
487
488 sub sigpipehandler {
489   local $_ = '';
490   $SIG{ALRM} = sub { };
491   alarm(1);
492   $_ = &getline||'';
493   if (/^HTTP.* \d+ (.*)/) {
494     if ($opt_v) {
495       die "\n$0: server error: @_\n";
496     } else {
497       die "\n$0: server error: $1\n";
498     }
499   } else {
500     die "\n$0: got SIGPIPE (server closed connection)\n";
501   }
502 }
503
504 # read one text line from $SH;
505 sub getline {
506   my $line = '';
507   my $c;
508
509   local $SIG{ALRM} = sub { die "$0: timeout while waiting for server reply\n" };
510   alarm($opt_t||300);
511
512   # must use sysread to avoid perl line buffering
513   while (sysread $SH,$c,1) {
514     $line .= $c;
515     last if $c eq "\n";
516   }
517
518   alarm(0);
519
520   return $line;
521 }
522
523 # from MIME::Base64::Perl
524 sub decode_b64 {
525   local $_ = shift;
526   my $uu = '';
527   my ($i,$l);
528
529   tr|A-Za-z0-9+=/||cd;
530   s/=+$//;
531   tr|A-Za-z0-9+/| -_|;
532   return "" unless length;
533
534   $l = (length) - 60;
535   for ($i = 0; $i <= $l; $i += 60) {
536     $uu .= "M" . substr($_,$i,60);
537   }
538   $_ = substr($_,$i);
539   if (length) {
540     $uu .= chr(32 + (length)*3/4) . $_;
541   }
542   return unpack ("u",$uu);
543 }
544
545
546 ### common functions ###
547
548
549 sub mtime {
550   my @d = localtime((stat shift)[9]);
551   return sprintf('%d%02d%02d',$d[5]+1900,$d[4]+1,$d[3]);
552 }
553
554
555 sub urldecode {
556   local $_ = shift;
557   s/\%([a-f\d]{2})/chr(hex($1))/ige;
558   return $_;
559 }
560
561
562 sub get_ssl_env {
563   # set SSL/TLS options
564   $SSL{SSL_verify_mode} = $ENV{SSLVERIFY} if defined($ENV{SSLVERIFY});
565   foreach my $opt (qw(
566     SSL_version
567     SSL_cipher_list
568     SSL_verify_mode
569     SSL_ca_path
570     SSL_ca_file)
571   ) {
572     my $env = uc($opt);
573     $env =~ s/_//g;
574     $SSL{$opt} = $ENV{$env} if defined($ENV{$env});
575   }
576
577   if ($SSL{SSL_verify_mode}) {
578     &search_ca;
579     unless ($SSL{SSL_ca_path} or $SSL{SSL_ca_file}) {
580       die "$0: \$SSLVERIFYMODE, but not valid \$SSLCAPATH or \$SSLCAFILE\n";
581     }
582   } elsif (defined($SSL{SSL_verify_mode})) {
583     # user has set SSLVERIFY=0 !
584   } else {
585     &search_ca;
586     $SSL{SSL_verify_mode} = 1 if $SSL{SSL_ca_path} or $SSL{SSL_ca_file};
587   }
588 }
589
590 sub search_ca {
591   local $_;
592   return if $SSL{SSL_ca_file} or $SSL{SSL_ca_path};
593   foreach (qw(/etc/ssl/certs/ca-certificates.crt)) {
594     if (-f) {
595       $SSL{SSL_ca_file} = $_;
596       return;
597     }
598   }
599   foreach (qw(/etc/ssl/certs /etc/pki/tls/certs)) {
600     if (-f) {
601       $SSL{SSL_ca_path} = $_;
602       return;
603     }
604   }
605 }
606
607
608 sub serverconnect {
609   my ($server,$port) = @_;
610   my $connect = "CONNECT $server:$port HTTP/1.1";
611   local $_;
612
613   if ($proxy) {
614     tcpconnect(split(':',$proxy));
615     if ($https) {
616       printf "--> %s\n",$connect if $opt_v;
617       nvtsend($connect,"");
618       $_ = <$SH>;
619       s/\r//;
620       printf "<-- $_"if $opt_v;
621       unless (/^HTTP.1.. 200/) {
622         die "$0: proxy error : $_";
623       }
624       &enable_ssl;
625       $SH = IO::Socket::SSL->start_SSL($SH,%SSL);
626     }
627   } else {
628     tcpconnect($server,$port);
629   }
630 #  if ($https and $opt_v) {
631 #    printf "%s\n",$SH->get_cipher();
632 #  }
633 }
634
635
636 # set up tcp/ip connection
637 sub tcpconnect {
638   my ($server,$port) = @_;
639
640   if ($SH) {
641     close $SH;
642     undef $SH;
643   }
644
645   if ($https) {
646     # eval "use IO::Socket::SSL qw(debug3)";
647     &enable_ssl;
648     $SH = IO::Socket::SSL->new(
649       PeerAddr => $server,
650       PeerPort => $port,
651       Proto    => 'tcp',
652       %SSL
653     );
654   } else {
655     $SH = IO::Socket::INET->new(
656       PeerAddr => $server,
657       PeerPort => $port,
658       Proto    => 'tcp',
659     );
660   }
661
662   if ($SH) {
663     autoflush $SH 1;
664     binmode $SH;
665   } else {
666     die "$0: cannot connect $server:$port - $@\n";
667   }
668
669   print "TCPCONNECT to $server:$port\n" if $opt_v;
670 }
671
672
673 sub enable_ssl {
674   eval "use IO::Socket::SSL";
675   die "$0: cannot load IO::Socket::SSL\n" if $@;
676   eval '$SSL{SSL_verify_mode} = 0 if Net::SSLeay::SSLeay() <= 9470143';
677   if ($opt_v) {
678     foreach my $v (keys %SSL) {
679       printf "%s => %s\n",$v,$SSL{$v};
680     }
681   }
682 }
683
684
685 sub sendheader {
686   my $sp = shift;
687   my @head = @_;
688   my $head;
689
690   push @head,"Host: $sp";
691
692   foreach $head (@head) {
693     print "--> $head\n" if $opt_v;
694     print {$SH} $head,"\r\n";
695   }
696   print "-->\n" if $opt_v;
697   print {$SH} "\r\n";
698 }
699
700
701 sub nvtsend {
702   local $SIG{PIPE} = sub { $sigpipe = "@_" };
703
704   $sigpipe = '';
705
706   die "$0: internal error: no active network handle\n" unless $SH;
707   die "$0: remote host has closed the link\n" unless $SH->connected;
708
709   foreach my $line (@_) {
710     print {$SH} $line,"\r\n";
711     if ($sigpipe) {
712       undef $SH;
713       return 0;
714     }
715   }
716
717   return 1;
718 }
719
720
721 sub quote {
722   local $_ = shift;
723   s/([^\w\@\/%^,.=+_:+-])/\\$1/g;
724   return $_;
725 }
726
727
728 sub debug {
729   print "## DEBUG: @_\n" if $DEBUG;
730 }
731
732
733 # from MIME::Base64::Perl
734 sub encode_b64 {
735   my $res = "";
736   my $eol = "\n";
737   my $padding;
738
739   pos($_[0]) = 0;
740   $res = join '',map(pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs));
741   $res =~ tr|` -_|AA-Za-z0-9+/|;
742   $padding = (3-length($_[0])%3)%3;
743   $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
744   return $res;
745 }