Original release 20160104

[fex.git] / htdocs / download / sexsend

diff --git a/htdocs/download/sexsend b/htdocs/download/sexsend
index 7340e497e98b97a984f2de429cba3699d947e7e7..d9fe821de487cd5e3733877c9009560286081c1d 100755 (executable)
--- a/htdocs/download/sexsend
+++ b/htdocs/download/sexsend
@@ -12,14 +12,15 @@ use Getopt::Std;
 use Socket;
 use IO::Handle;
 use IO::Socket::INET;
 use Socket;
 use IO::Handle;
 use IO::Socket::INET;

-use Digest::MD5 qw(md5_hex);  # encypted ID / SID 
+use Digest::MD5 qw(md5_hex);  # encypted ID / SID

 
 use constant k => 2**10;
 use constant M => 2**20;
 
 eval 'use Net::INET6Glue::INET_is_INET6';
 
 
 use constant k => 2**10;
 use constant M => 2**20;
 
 eval 'use Net::INET6Glue::INET_is_INET6';
 

-our $version = 20150120;
+our $version = 20160104;
+our $DEBUG = $ENV{DEBUG};

 
 my %SSL = (SSL_version => 'TLSv1');
 my $sigpipe;
 
 my %SSL = (SSL_version => 'TLSv1');
 my $sigpipe;


@@ -32,7 +33,7 @@ $0 =~ s:.*/::;
 $| = 1;
 
 # sexsend is default
 $| = 1;
 
 # sexsend is default

-$usage = 
+$usage =

   "usage: ... | $0 [options] [SEX-URL/]recipient [stream]\n".
   "options: -v           verbose mode\n".
   "         -g           show transfer rate\n".
   "usage: ... | $0 [options] [SEX-URL/]recipient [stream]\n".
   "options: -v           verbose mode\n".
   "         -g           show transfer rate\n".


@@ -43,7 +44,7 @@ $usage =
   "example: tail -f /var/log/syslog | $0 fex.flupp.org/admin log\n";
 
 if ($0 eq 'sexget' or $0 eq 'fuckme') {
   "example: tail -f /var/log/syslog | $0 fex.flupp.org/admin log\n";
 
 if ($0 eq 'sexget' or $0 eq 'fuckme') {

-  $usage = 
+  $usage =

     "usage: $0 [options] [[SEX-URL/]user:ID] [stream]\n".
     "options: -v           verbose mode\n".
     "         -g           show transfer rate\n".
     "usage: $0 [options] [[SEX-URL/]user:ID] [stream]\n".
     "options: -v           verbose mode\n".
     "         -g           show transfer rate\n".


@@ -56,7 +57,7 @@ if ($0 eq 'sexget' or $0 eq 'fuckme') {
 }
 
 if ($0 eq 'sexxx') {
 }
 
 if ($0 eq 'sexxx') {

-  $usage = 
+  $usage =

     "usage: $0 [-v] [-g] [-c] [-u [SEX-URL/]user] [-s stream] [files...]\n".
     "usage: $0 [-v] [-g]      [-u [SEX-URL/]user] [-s stream] | ...\n".
     "options: -v               verbose mode\n".
     "usage: $0 [-v] [-g] [-c] [-u [SEX-URL/]user] [-s stream] [files...]\n".
     "usage: $0 [-v] [-g]      [-u [SEX-URL/]user] [-s stream] | ...\n".
     "options: -v               verbose mode\n".


@@ -102,7 +103,7 @@ $opt_u = $opt_s = $opt_c = $opt_t = '';
 $_ = "$fexhome/config.pl"; require if -f;
 
 if ($0 eq 'sexxx') {
 $_ = "$fexhome/config.pl"; require if -f;
 
 if ($0 eq 'sexxx') {

-  
+

   # xx server URL, user and auth-ID
   if ($FEXXX = $ENV{FEXXX}) {
     $FEXXX = decode_b64($FEXXX) if $FEXXX !~ /\s/;
   # xx server URL, user and auth-ID
   if ($FEXXX = $ENV{FEXXX}) {
     $FEXXX = decode_b64($FEXXX) if $FEXXX !~ /\s/;


@@ -118,7 +119,7 @@ if ($0 eq 'sexxx') {
     }
     close $idf;
   }
     }
     close $idf;
   }

-  
+

   getopts('hgvcu:s:') or die $usage;
   die $usage if $opt_h;
   die $usage unless -t;
   getopts('hgvcu:s:') or die $usage;
   die $usage if $opt_h;
   die $usage unless -t;


@@ -140,8 +141,10 @@ if ($0 eq 'sexxx') {
   unless ($user) {
     die "$0: no xx user found, use \"$0 -u user\"\n";
   }
   unless ($user) {
     die "$0: no xx user found, use \"$0 -u user\"\n";
   }

-  
+

 } elsif ($0 eq 'sexget' or $0 eq 'fuckme') {
 } elsif ($0 eq 'sexget' or $0 eq 'fuckme') {

+
+  $opt_g = 0;

   getopts('hgvVdu:') or die $usage;
   die $usage if $opt_h;
 
   getopts('hgvVdu:') or die $usage;
   die $usage if $opt_h;
 


@@ -150,11 +153,11 @@ if ($0 eq 'sexxx') {
     print "Version: $version\n";
     exit unless @ARGV;
   }
     print "Version: $version\n";
     exit unless @ARGV;
   }

-  
+

   if (not $opt_u and @ARGV and $ARGV[0] =~ m{^anonymous|/|:}) {
     $opt_u = shift @ARGV;
   }
   if (not $opt_u and @ARGV and $ARGV[0] =~ m{^anonymous|/|:}) {
     $opt_u = shift @ARGV;
   }

-  
+

   if ($opt_u) {
     $fexcgi = $1 if $opt_u =~ s:(.+)/::;
     ($user,$id) = split(':',$opt_u);
   if ($opt_u) {
     $fexcgi = $1 if $opt_u =~ s:(.+)/::;
     ($user,$id) = split(':',$opt_u);


@@ -168,14 +171,14 @@ if ($0 eq 'sexxx') {
   unless ($fexcgi) {
     die "$0: no SEX URL found, use \"$0 -u SEX-URL/recipient\" or \"fexsend -I\"\n";
   }
   unless ($fexcgi) {
     die "$0: no SEX URL found, use \"$0 -u SEX-URL/recipient\" or \"fexsend -I\"\n";
   }

-  
+

   unless ($user) {
     die "$0: no recipient found, use \"$0 -u SEX-URL/recipient\" or \"fexsend -I\"\n";
   }
   unless ($user) {
     die "$0: no recipient found, use \"$0 -u SEX-URL/recipient\" or \"fexsend -I\"\n";
   }

-  
+

 } else { # sexsend
 } else { # sexsend

-  
-  $opt_g = 1;
+
+  $opt_g = 0;

   getopts('hguvqVTt:') or die $usage;
   die $usage if $opt_h;
 
   getopts('hguvqVTt:') or die $usage;
   die $usage if $opt_h;
 


@@ -183,7 +186,7 @@ if ($0 eq 'sexxx') {
     print "Version: $version\n";
     exit unless @ARGV;
   }
     print "Version: $version\n";
     exit unless @ARGV;
   }

-  
+

   if ($opt_t and $opt_t =~ /^\d+$/) {
     $timeout = "&timeout=$opt_t";
   }
   if ($opt_t and $opt_t =~ /^\d+$/) {
     $timeout = "&timeout=$opt_t";
   }


@@ -191,7 +194,7 @@ if ($0 eq 'sexxx') {
   my $save_user = $user;
   $user = shift or die $usage;
   $fexcgi = $1 if $user =~ s:(.+)/::;
   my $save_user = $user;
   $user = shift or die $usage;
   $fexcgi = $1 if $user =~ s:(.+)/::;

-  
+

   if ($user =~ /^anonymous/) {
     die "$0: need SEX-URL with anonymous SEX\n" unless $fexcgi;
     $mode = 'anonymous';
   if ($user =~ /^anonymous/) {
     die "$0: need SEX-URL with anonymous SEX\n" unless $fexcgi;
     $mode = 'anonymous';


@@ -211,7 +214,7 @@ if ($0 eq 'sexxx') {
       die "$0: no SEX URL found, use \"$0 SEX-URL/recipient\" or \"fexsend -I\"\n";
     }
   }
       die "$0: no SEX URL found, use \"$0 SEX-URL/recipient\" or \"fexsend -I\"\n";
     }
   }

-  
+

 }
 
 &get_ssl_env;
 }
 
 &get_ssl_env;


@@ -220,14 +223,14 @@ $fexcgi =~ s(^http://)()i;
 $fexcgi =~ s(/fup.*)();
 $server = $fexcgi;
 
 $fexcgi =~ s(/fup.*)();
 $server = $fexcgi;
 

-if    ($server =~ s(^https://)()i) { $port = 443 } 
-elsif ($server =~ /:(\d+)/)        { $port = $1 } 
-else                               { $port = 80 }    
+if    ($server =~ s(^https://)()i) { $port = 443 }
+elsif ($server =~ /:(\d+)/)        { $port = $1 }
+else                               { $port = 80 }

 
 $server =~ s([:/].*)();
 
 ## set up tcp/ip connection
 
 $server =~ s([:/].*)();
 
 ## set up tcp/ip connection

-# $iaddr = gethostbyname($server) 
+# $iaddr = gethostbyname($server)

 #          or die "$0: cannot find ip-address for $server $!\n";
 # socket(SH,PF_INET,SOCK_STREAM,getprotobyname('tcp')) or die "$0: socket $!\n";
 # connect(SH,sockaddr_in($port,$iaddr)) or die "$0: connect $!\n";
 #          or die "$0: cannot find ip-address for $server $!\n";
 # socket(SH,PF_INET,SOCK_STREAM,getprotobyname('tcp')) or die "$0: socket $!\n";
 # connect(SH,sockaddr_in($port,$iaddr)) or die "$0: connect $!\n";


@@ -240,21 +243,21 @@ if ($port == 443) {
   }
   eval "use IO::Socket::SSL";
   die "$0: cannot load IO::Socket::SSL\n" if $@;
   }
   eval "use IO::Socket::SSL";
   die "$0: cannot load IO::Socket::SSL\n" if $@;

-  $SH = IO::Socket::SSL->new(                                                  
-    PeerAddr => $server,                                                       
-    PeerPort => $port,                                                         
+  $SH = IO::Socket::SSL->new(
+    PeerAddr => $server,
+    PeerPort => $port,

     Proto    => 'tcp',
     %SSL
     Proto    => 'tcp',
     %SSL

-  );                                                                           
-} else {                                                                       
+  );
+} else {

   $SH = IO::Socket::INET->new(
     PeerAddr => $server,
     PeerPort => $port,
   $SH = IO::Socket::INET->new(
     PeerAddr => $server,
     PeerPort => $port,

-    Proto    => 'tcp',                                                         
-  );                                                                           
+    Proto    => 'tcp',
+  );

 }
 
 }
 

-die "cannot connect $server:$port - $!\n" unless $SH;                          
+die "cannot connect $server:$port - $!\n" unless $SH;

 warn "TCPCONNECT to $server:$port\n" if $opt_v;
 
 # autoflush $SH 1;
 warn "TCPCONNECT to $server:$port\n" if $opt_v;
 
 # autoflush $SH 1;


@@ -331,7 +334,7 @@ request("POST /sex?BS=$bs&user=$user$mode$type$timeout$stream HTTP/1.0");
 print STDERR "==> (streaming ...)\n" if $opt_v;
 
 transfer(STDIN,$SH);
 print STDERR "==> (streaming ...)\n" if $opt_v;
 
 transfer(STDIN,$SH);

-  
+

 exit;
 
 
 exit;
 
 


@@ -340,7 +343,7 @@ sub transfer {
   my $destination = shift;
   my ($t0,$t1,$tt);
   my ($B,$b,$bt);
   my $destination = shift;
   my ($t0,$t1,$tt);
   my ($B,$b,$bt);

-  
+

   $t0 = $t2 = time;
   $tt = $t0-1;
   $t1 = 0;
   $t0 = $t2 = time;
   $tt = $t0-1;
   $t1 = 0;


@@ -370,9 +373,9 @@ sub transfer {
   }
 
   die "$0: no stream data\n" unless $B;
   }
 
   die "$0: no stream data\n" unless $B;

-  
+

   $tt = (time-$t0)||1;
   $tt = (time-$t0)||1;

-  
+

   if ($opt_v or $opt_g) {
     if ($B>2097152) {
       printf STDERR "transfered: %d MB in %d s with %d kB/s\n",
   if ($opt_v or $opt_g) {
     if ($B>2097152) {
       printf STDERR "transfered: %d MB in %d s with %d kB/s\n",


@@ -385,13 +388,13 @@ sub transfer {
         $B,$tt,int($B/1024/$tt);
     }
   }
         $B,$tt,int($B/1024/$tt);
     }
   }

-  
+

 }
 
 
 sub request {
   my $req = shift;
 }
 
 
 sub request {
   my $req = shift;

-  
+

   print STDERR "==> $req\n" if $opt_v;
   syswrite $SH,"$req\r\n\r\n";
   for (;;) {
   print STDERR "==> $req\n" if $opt_v;
   syswrite $SH,"$req\r\n\r\n";
   for (;;) {


@@ -456,12 +459,12 @@ sub query_sid {
   my ($server,$port,$id) = @_;
   my $req;
   local $_;
   my ($server,$port,$id) = @_;
   my $req;
   local $_;

-  
+

   $req = "GET SID HTTP/1.1";
   print STDERR "==> $req\n" if $opt_v;
   syswrite $SH,"$req\r\n\r\n";
   $_ = &getline;
   $req = "GET SID HTTP/1.1";
   print STDERR "==> $req\n" if $opt_v;
   syswrite $SH,"$req\r\n\r\n";
   $_ = &getline;

-  unless (defined $_ and /\w/) { 
+  unless (defined $_ and /\w/) {

     print STDERR "\n" if $opt_v;
     die "$0: no response from server\n";
   }
     print STDERR "\n" if $opt_v;
     die "$0: no response from server\n";
   }


@@ -469,7 +472,7 @@ sub query_sid {
   if (/^HTTP.* 201 (.+)/) {
     print STDERR "<== $_" if $opt_v;
     $id = 'MD5H:'.md5_hex($id.$1);
   if (/^HTTP.* 201 (.+)/) {
     print STDERR "<== $_" if $opt_v;
     $id = 'MD5H:'.md5_hex($id.$1);

-    while (defined($_ = &getline)) { 
+    while (defined($_ = &getline)) {

       s/\r//;
       last if /^\n/;
       print STDERR "<== $_" if $opt_v;
       s/\r//;
       last if /^\n/;
       print STDERR "<== $_" if $opt_v;


@@ -480,7 +483,7 @@ sub query_sid {
   return $id;
 }
 
   return $id;
 }
 

-sub sigpipehandler { 
+sub sigpipehandler {

   local $_ = '';
   $SIG{ALRM} = sub { };
   alarm(1);
   local $_ = '';
   $SIG{ALRM} = sub { };
   alarm(1);


@@ -503,15 +506,15 @@ sub getline {
 
   local $SIG{ALRM} = sub { die "$0: timeout while waiting for server reply\n" };
   alarm($opt_t||300);
 
   local $SIG{ALRM} = sub { die "$0: timeout while waiting for server reply\n" };
   alarm($opt_t||300);

-  
+

   # must use sysread to avoid perl line buffering
   while (sysread $SH,$c,1) {
     $line .= $c;
     last if $c eq "\n";
   }
   # must use sysread to avoid perl line buffering
   while (sysread $SH,$c,1) {
     $line .= $c;
     last if $c eq "\n";
   }

-  
+

   alarm(0);
   alarm(0);

-  
+

   return $line;
 }
 
   return $line;
 }
 


@@ -520,7 +523,7 @@ sub decode_b64 {
   local $_ = shift;
   my $uu = '';
   my ($i,$l);
   local $_ = shift;
   my $uu = '';
   my ($i,$l);

-  
+

   tr|A-Za-z0-9+=/||cd;
   s/=+$//;
   tr|A-Za-z0-9+/| -_|;
   tr|A-Za-z0-9+=/||cd;
   s/=+$//;
   tr|A-Za-z0-9+/| -_|;


@@ -559,9 +562,9 @@ sub get_ssl_env {
   $SSL{SSL_verify_mode} = $ENV{SSLVERIFY} if defined($ENV{SSLVERIFY});
   foreach my $opt (qw(
     SSL_version
   $SSL{SSL_verify_mode} = $ENV{SSLVERIFY} if defined($ENV{SSLVERIFY});
   foreach my $opt (qw(
     SSL_version

-    SSL_cipher_list 
-    SSL_verify_mode 
-    SSL_ca_path 
+    SSL_cipher_list
+    SSL_verify_mode
+    SSL_ca_path

     SSL_ca_file)
   ) {
     my $env = uc($opt);
     SSL_ca_file)
   ) {
     my $env = uc($opt);


@@ -604,16 +607,10 @@ sub serverconnect {
   my ($server,$port) = @_;
   my $connect = "CONNECT $server:$port HTTP/1.1";
   local $_;
   my ($server,$port) = @_;
   my $connect = "CONNECT $server:$port HTTP/1.1";
   local $_;

-  
-  if ($opt_v and $port == 443 and %SSL) {
-    foreach my $v (keys %SSL) {
-      printf "%s => %s\n",$v,$SSL{$v};
-    }
-  }
-  
+

   if ($proxy) {
     tcpconnect(split(':',$proxy));
   if ($proxy) {
     tcpconnect(split(':',$proxy));

-    if ($port == 443) {
+    if ($https) {

       printf "--> %s\n",$connect if $opt_v;
       nvtsend($connect,"");
       $_ = <$SH>;
       printf "--> %s\n",$connect if $opt_v;
       nvtsend($connect,"");
       $_ = <$SH>;


@@ -622,14 +619,13 @@ sub serverconnect {
       unless (/^HTTP.1.. 200/) {
         die "$0: proxy error : $_";
       }
       unless (/^HTTP.1.. 200/) {
         die "$0: proxy error : $_";
       }

-      eval "use IO::Socket::SSL";
-      die "$0: cannot load IO::Socket::SSL\n" if $@;
+      &enable_ssl;

       $SH = IO::Socket::SSL->start_SSL($SH,%SSL);
     }
   } else {
     tcpconnect($server,$port);
   }
       $SH = IO::Socket::SSL->start_SSL($SH,%SSL);
     }
   } else {
     tcpconnect($server,$port);
   }

-#  if ($port == 443 and $opt_v) {
+#  if ($https and $opt_v) {

 #    printf "%s\n",$SH->get_cipher();
 #  }
 }
 #    printf "%s\n",$SH->get_cipher();
 #  }
 }


@@ -638,16 +634,15 @@ sub serverconnect {
 # set up tcp/ip connection
 sub tcpconnect {
   my ($server,$port) = @_;
 # set up tcp/ip connection
 sub tcpconnect {
   my ($server,$port) = @_;

-  
+

   if ($SH) {
     close $SH;
     undef $SH;
   }
   if ($SH) {
     close $SH;
     undef $SH;
   }

-  
-  if ($port == 443) {
+
+  if ($https) {

     # eval "use IO::Socket::SSL qw(debug3)";
     # eval "use IO::Socket::SSL qw(debug3)";

-    eval "use IO::Socket::SSL";
-    die "$0: cannot load IO::Socket::SSL\n" if $@;
+    &enable_ssl;

     $SH = IO::Socket::SSL->new(
       PeerAddr => $server,
       PeerPort => $port,
     $SH = IO::Socket::SSL->new(
       PeerAddr => $server,
       PeerPort => $port,


@@ -661,24 +656,37 @@ sub tcpconnect {
       Proto    => 'tcp',
     );
   }
       Proto    => 'tcp',
     );
   }

-  
+

   if ($SH) {
     autoflush $SH 1;
   if ($SH) {
     autoflush $SH 1;

+    binmode $SH;

   } else {
     die "$0: cannot connect $server:$port - $@\n";
   }
   } else {
     die "$0: cannot connect $server:$port - $@\n";
   }

-  
+

   print "TCPCONNECT to $server:$port\n" if $opt_v;
 }
 
 
   print "TCPCONNECT to $server:$port\n" if $opt_v;
 }
 
 

+sub enable_ssl {
+  eval "use IO::Socket::SSL";
+  die "$0: cannot load IO::Socket::SSL\n" if $@;
+  eval '$SSL{SSL_verify_mode} = 0 if Net::SSLeay::SSLeay() <= 9470143';
+  if ($opt_v) {
+    foreach my $v (keys %SSL) {
+      printf "%s => %s\n",$v,$SSL{$v};
+    }
+  }
+}
+
+

 sub sendheader {
   my $sp = shift;
   my @head = @_;
   my $head;
 sub sendheader {
   my $sp = shift;
   my @head = @_;
   my $head;

-  
+

   push @head,"Host: $sp";
   push @head,"Host: $sp";

-  
+

   foreach $head (@head) {
     print "--> $head\n" if $opt_v;
     print {$SH} $head,"\r\n";
   foreach $head (@head) {
     print "--> $head\n" if $opt_v;
     print {$SH} $head,"\r\n";


@@ -690,12 +698,12 @@ sub sendheader {
 
 sub nvtsend {
   local $SIG{PIPE} = sub { $sigpipe = "@_" };
 
 sub nvtsend {
   local $SIG{PIPE} = sub { $sigpipe = "@_" };

-  
+

   $sigpipe = '';
   $sigpipe = '';

-  
+

   die "$0: internal error: no active network handle\n" unless $SH;
   die "$0: remote host has closed the link\n" unless $SH->connected;
   die "$0: internal error: no active network handle\n" unless $SH;
   die "$0: remote host has closed the link\n" unless $SH->connected;

-  
+

   foreach my $line (@_) {
     print {$SH} $line,"\r\n";
     if ($sigpipe) {
   foreach my $line (@_) {
     print {$SH} $line,"\r\n";
     if ($sigpipe) {


@@ -703,17 +711,29 @@ sub nvtsend {
       return 0;
     }
   }
       return 0;
     }
   }

-  
+

   return 1;
 }
 
 
   return 1;
 }
 
 

+sub quote {
+  local $_ = shift;
+  s/([^\w\@\/%^,.=+_:+-])/\\$1/g;
+  return $_;
+}
+
+
+sub debug {
+  print "## DEBUG: @_\n" if $DEBUG;
+}
+
+

 # from MIME::Base64::Perl
 sub encode_b64 {
   my $res = "";
   my $eol = "\n";
   my $padding;
 # from MIME::Base64::Perl
 sub encode_b64 {
   my $res = "";
   my $eol = "\n";
   my $padding;

-  
+

   pos($_[0]) = 0;
   $res = join '',map(pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs));
   $res =~ tr|` -_|AA-Za-z0-9+/|;
   pos($_[0]) = 0;
   $res = join '',map(pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs));
   $res =~ tr|` -_|AA-Za-z0-9+/|;