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';
-our $version = 20150120;
+our $version = 20160328;
+our $DEBUG = $ENV{DEBUG};
my %SSL = (SSL_version => 'TLSv1');
my $sigpipe;
$| = 1;
# sexsend is default
-$usage =
+$usage =
"usage: ... | $0 [options] [SEX-URL/]recipient [stream]\n".
"options: -v verbose mode\n".
" -g show transfer rate\n".
"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".
}
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".
$_ = "$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/;
}
close $idf;
}
-
+
getopts('hgvcu:s:') or die $usage;
die $usage if $opt_h;
die $usage unless -t;
unless ($user) {
die "$0: no xx user found, use \"$0 -u user\"\n";
}
-
+
} elsif ($0 eq 'sexget' or $0 eq 'fuckme') {
+
+ $opt_g = 0;
getopts('hgvVdu:') or die $usage;
die $usage if $opt_h;
print "Version: $version\n";
exit unless @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);
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";
}
-
+
} else { # sexsend
-
- $opt_g = 1;
+
+ $opt_g = 0;
getopts('hguvqVTt:') or die $usage;
die $usage if $opt_h;
print "Version: $version\n";
exit unless @ARGV;
}
-
+
if ($opt_t and $opt_t =~ /^\d+$/) {
$timeout = "&timeout=$opt_t";
}
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';
die "$0: no SEX URL found, use \"$0 SEX-URL/recipient\" or \"fexsend -I\"\n";
}
}
-
+
}
&get_ssl_env;
$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
-# $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";
}
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
- );
-} else {
+ );
+} else {
$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;
}
request("POST /sex?BS=$bs&user=$user$mode$type$timeout$stream HTTP/1.0");
-print STDERR "==> (streaming ...)\n" if $opt_v;
+print STDERR "--> (streaming ...)\n" if $opt_v;
transfer(STDIN,$SH);
-
+
exit;
my $destination = shift;
my ($t0,$t1,$tt);
my ($B,$b,$bt);
-
+
$t0 = $t2 = time;
$tt = $t0-1;
$t1 = 0;
}
die "$0: no stream data\n" unless $B;
-
+
$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",
$B,$tt,int($B/1024/$tt);
}
}
-
+
}
sub request {
my $req = shift;
-
- print STDERR "==> $req\n" if $opt_v;
- syswrite $SH,"$req\r\n\r\n";
+
+ print STDERR "--> $req\n" if $opt_v;
+ syswrite $SH,"$req\r\n";
+ syswrite $SH,"User-Agent: sexsend\r\n";
+ syswrite $SH,"\r\n";
for (;;) {
unless (defined($_ = &getline)) {
die "$0: server has closed the connection\n";
}
if (/^HTTP\/[\d\.]+ 200/) {
- print STDERR "<== $_" if $opt_v;
+ print STDERR "<-- $_" if $opt_v;
last;
} elsif (/^HTTP\/[\d\.]+ 199/) {
- print STDERR "<== $_" if $opt_v;
+ print STDERR "<-- $_" if $opt_v;
} else {
if ($opt_v) {
- print STDERR "<== $_";
+ print STDERR "<-- $_";
exit 3;
} else {
s:^HTTP/[ \d\.]+::;
while (defined($_ = &getline)) {
last if /^\s*$/;
$H{uc($1)} = $2 if /(.+):\s*(.+)/;
- print STDERR "<== $_" if $opt_v;
+ print STDERR "<-- $_" if $opt_v;
}
}
my ($server,$port,$id) = @_;
my $req;
local $_;
-
+
$req = "GET SID HTTP/1.1";
- print STDERR "==> $req\n" if $opt_v;
+ 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";
}
s/\r//;
if (/^HTTP.* 201 (.+)/) {
- print STDERR "<== $_" if $opt_v;
+ 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;
+ print STDERR "<-- $_" if $opt_v;
}
} else {
die "$0: $server does not support session ID\n";
return $id;
}
-sub sigpipehandler {
+sub sigpipehandler {
local $_ = '';
$SIG{ALRM} = sub { };
alarm(1);
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";
}
-
+
alarm(0);
-
+
return $line;
}
local $_ = shift;
my $uu = '';
my ($i,$l);
-
+
tr|A-Za-z0-9+=/||cd;
s/=+$//;
tr|A-Za-z0-9+/| -_|;
$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);
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 ($port == 443) {
+ if ($https) {
printf "--> %s\n",$connect if $opt_v;
nvtsend($connect,"");
$_ = <$SH>;
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);
}
-# if ($port == 443 and $opt_v) {
+# if ($https and $opt_v) {
# printf "%s\n",$SH->get_cipher();
# }
}
# set up tcp/ip connection
sub tcpconnect {
my ($server,$port) = @_;
-
+
if ($SH) {
close $SH;
undef $SH;
}
-
- if ($port == 443) {
+
+ if ($https) {
# 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,
Proto => 'tcp',
);
}
-
+
if ($SH) {
autoflush $SH 1;
+ binmode $SH;
} else {
die "$0: cannot connect $server:$port - $@\n";
}
-
+
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;
-
+
push @head,"Host: $sp";
-
+
foreach $head (@head) {
print "--> $head\n" if $opt_v;
print {$SH} $head,"\r\n";
sub nvtsend {
local $SIG{PIPE} = sub { $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;
-
+
foreach my $line (@_) {
print {$SH} $line,"\r\n";
if ($sigpipe) {
return 0;
}
}
-
+
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;
-
+
pos($_[0]) = 0;
$res = join '',map(pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs));
$res =~ tr|` -_|AA-Za-z0-9+/|;
projects / fex.git / blobdiff