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