git.treefish.org Git - fex.git/blob - htdocs/download/sexsend

1 #!/usr/bin/perl -w

3 # client for stream exchange of the FEX service

4 #

5 # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>

6 #

7 # Perl Artistic Licence

9 # sexsend / sexget / sexxx

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

17 use constant k => 2**10;

18 use constant M => 2**20;

20 eval 'use Net::INET6Glue::INET_is_INET6';

22 our $version = 20160919;

23 our $DEBUG = $ENV{DEBUG};

25 my %SSL = (SSL_version => 'TLSv1');

26 my $sigpipe;

28 if (-f ($_ = '/etc/fex/config.pl')) {

29 eval { require } or warn $@;

30 }

32 $0 =~ s:.*/::;

33 $| = 1;

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";

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 }

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 }

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

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 }

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 }