]> git.treefish.org Git - fex.git/blob - bin/sexsend
d9fe821de487cd5e3733877c9009560286081c1d
[fex.git] / 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 = 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 }