Advertisement
Guest User

Untitled

a guest
Apr 8th, 2011
132
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 18.31 KB | None | 0 0
  1. #!/usr/bin/env perl
  2. #
  3. # (As of 2011/04/08 - Linux repeater Perl script from http://chunkvnc.com/download.html)
  4. #
  5. # Copyright (c) 2009-2010 by Karl J. Runge <runge@karlrunge.com>
  6. #
  7. # ultravnc_repeater.pl is free software; you can redistribute it and/or modify
  8. # it under the terms of the GNU General Public License as published by
  9. # the Free Software Foundation; either version 2 of the License, or (at
  10. # your option) any later version.
  11. #
  12. # ultravnc_repeater.pl is distributed in the hope that it will be useful,
  13. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15. # GNU General Public License for more details.
  16. #
  17. # You should have received a copy of the GNU General Public License
  18. # along with ultravnc_repeater.pl; if not, write to the Free Software
  19. # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA
  20. # or see <http://www.gnu.org/licenses/>.
  21. #
  22.  
  23. my $usage = '
  24. ultravnc_repeater.pl:
  25. perl script implementing the ultravnc repeater
  26. proxy protocol.
  27.  
  28. protocol: Listen on one port for vnc clients (default 5900.)
  29. Listen on one port for vnc servers (default 5500.)
  30. Read 250 bytes from connecting vnc client or server.
  31. Accept ID:<string> from clients and servers, connect them
  32. together once both are present.
  33.  
  34. The string "RFB 000.000\n" is sent to the client (the client
  35. must understand this means send ID:... or host:port.)
  36. Also accept <host>:<port> from clients and make the
  37. connection to the vnc server immediately.
  38.  
  39. Note there is no authentication or security WRT ID names or
  40. identities; it is up to the client and server to completely
  41. manage that aspect and whether to encrypt the session, etc.
  42.  
  43. usage: ultravnc_repeater.pl [-r] [client_port [server_port]]
  44.  
  45. Use -r to refuse new server/client connections when there is an existing
  46. server/client ID. The default is to close the previous one.
  47.  
  48. To write to a log file set the env. var ULTRAVNC_REPEATER_LOGFILE.
  49.  
  50. To run in a loop restarting the server if it exits set the env. var.
  51. ULTRAVNC_REPEATER_LOOP=1 or ULTRAVNC_REPEATER_LOOP=BG, the latter
  52. forks into the background. Set ULTRAVNC_REPEATER_PIDFILE to a file
  53. to store the master pid in.
  54.  
  55. Set ULTRAVNC_REPEATER_NO_RFB=1 to disable sending "RFB 000.000" to
  56. the client. Then this program acts as general TCP rendezvous tool.
  57.  
  58. Examples:
  59.  
  60. ultravnc_repeater.pl
  61. ultravnc_repeater.pl -r
  62. ultravnc_repeater.pl 5901
  63. ultravnc_repeater.pl 5901 5501
  64.  
  65. env ULTRAVNC_REPEATER_LOOP=BG ULTRAVNC_REPEATER_LOGFILE=/tmp/u.log ultravnc_repeater.pl ...
  66.  
  67. ';
  68.  
  69. use strict;
  70.  
  71. # Set up logging:
  72. #
  73. if (exists $ENV{ULTRAVNC_REPEATER_LOGFILE}) {
  74. close STDOUT;
  75. if (!open(STDOUT, ">>$ENV{ULTRAVNC_REPEATER_LOGFILE}")) {
  76. die "ultravnc_repeater.pl: $ENV{ULTRAVNC_REPEATER_LOGFILE} $!\n";
  77. }
  78. close STDERR;
  79. open(STDERR, ">&STDOUT");
  80. }
  81. select(STDERR); $| = 1;
  82. select(STDOUT); $| = 1;
  83.  
  84. # interrupt handler:
  85. #
  86. my $looppid = '';
  87. my $pidfile = '';
  88. #
  89. sub get_out {
  90. lprint("$_[0]:\t$$ looppid=$looppid");
  91. if ($looppid) {
  92. kill 'TERM', $looppid;
  93. fsleep(0.2);
  94. }
  95. unlink $pidfile if $pidfile;
  96. cleanup();
  97. exit 0;
  98. }
  99.  
  100. sub lprint {
  101. print STDERR scalar(localtime), ": ", @_, "\n";
  102. }
  103.  
  104. # These are overridden in actual server thread:
  105. #
  106. $SIG{INT} = \&get_out;
  107. $SIG{TERM} = \&get_out;
  108.  
  109. # pidfile:
  110. #
  111. sub open_pidfile {
  112. if (exists $ENV{ULTRAVNC_REPEATER_PIDFILE}) {
  113. my $pf = $ENV{ULTRAVNC_REPEATER_PIDFILE};
  114. if (open(PID, ">$pf")) {
  115. print PID "$$\n";
  116. close PID;
  117. $pidfile = $pf;
  118. } else {
  119. lprint("could not open pidfile: $pf - $! - continuing...");
  120. }
  121. delete $ENV{ULTRAVNC_REPEATER_PIDFILE};
  122. }
  123. }
  124.  
  125. ####################################################################
  126. # Set ULTRAVNC_REPEATER_LOOP=1 to have this script create an outer loop
  127. # restarting itself if it ever exits. Set ULTRAVNC_REPEATER_LOOP=BG to
  128. # do this in the background as a daemon.
  129.  
  130. if (exists $ENV{ULTRAVNC_REPEATER_LOOP}) {
  131. my $csl = $ENV{ULTRAVNC_REPEATER_LOOP};
  132. if ($csl ne 'BG' && $csl ne '1') {
  133. die "ultravnc_repeater.pl: invalid ULTRAVNC_REPEATER_LOOP.\n";
  134. }
  135. if ($csl eq 'BG') {
  136. # go into bg as "daemon":
  137. setpgrp(0, 0);
  138. my $pid = fork();
  139. if (! defined $pid) {
  140. die "ultravnc_repeater.pl: $!\n";
  141. } elsif ($pid) {
  142. wait;
  143. exit 0;
  144. }
  145. if (fork) {
  146. exit 0;
  147. }
  148. setpgrp(0, 0);
  149. close STDIN;
  150. if (! $ENV{ULTRAVNC_REPEATER_LOGFILE}) {
  151. close STDOUT;
  152. close STDERR;
  153. }
  154. }
  155. delete $ENV{ULTRAVNC_REPEATER_LOOP};
  156.  
  157. if (exists $ENV{ULTRAVNC_REPEATER_PIDFILE}) {
  158. open_pidfile();
  159. }
  160.  
  161. lprint("ultravnc_repeater.pl: starting service. master-pid=$$");
  162. while (1) {
  163. $looppid = fork;
  164. if (! defined $looppid) {
  165. sleep 10;
  166. } elsif ($looppid) {
  167. wait;
  168. } else {
  169. exec $0, @ARGV;
  170. exit 1;
  171. }
  172. lprint("ultravnc_repeater.pl: re-starting service. master-pid=$$");
  173. sleep 1;
  174. }
  175. exit 0;
  176. }
  177. if (exists $ENV{ULTRAVNC_REPEATER_PIDFILE}) {
  178. open_pidfile();
  179. }
  180.  
  181. # End of background/daemon stuff.
  182. ####################################################################
  183.  
  184. use warnings;
  185. use IO::Socket::INET;
  186. use IO::Select;
  187.  
  188. # Test for INET6 support:
  189. #
  190. my $have_inet6 = 0;
  191. eval "use IO::Socket::INET6;";
  192. $have_inet6 = 1 if $@ eq "";
  193. print "perl module IO::Socket::INET6 not available: no IPv6 support.\n" if ! $have_inet6;
  194.  
  195. my $prog = 'ultravnc_repeater';
  196. my %ID;
  197.  
  198. my $refuse = 0;
  199. my $init_timeout = 5;
  200.  
  201. if (@ARGV && $ARGV[0] =~ /-h/) {
  202. print $usage;
  203. exit 0;
  204. }
  205. if (@ARGV && $ARGV[0] eq '-r') {
  206. $refuse = 1;
  207. lprint("enabling refuse mode (-r).");
  208. shift;
  209. }
  210.  
  211. my $client_port = shift;
  212. my $server_port = shift;
  213.  
  214. $client_port = 5900 unless $client_port;
  215. $server_port = 5500 unless $server_port;
  216.  
  217. my $uname = `uname`;
  218.  
  219. my $repeater_bufsize = 250;
  220. $repeater_bufsize = $ENV{BUFSIZE} if exists $ENV{BUFSIZE};
  221.  
  222. my ($RIN, $WIN, $EIN, $ROUT);
  223.  
  224. my $client_listen = IO::Socket::INET->new(
  225. Listen => 10,
  226. LocalPort => $client_port,
  227. ReuseAddr => 1,
  228. Proto => "tcp"
  229. );
  230. my $err1 = $!;
  231. my $err2 = '';
  232. $client_listen = '' if ! $client_listen;
  233.  
  234. my $client_listen6 = '';
  235. if ($have_inet6) {
  236. eval {$client_listen6 = IO::Socket::INET6->new(
  237. Listen => 10,
  238. LocalPort => $client_port,
  239. ReuseAddr => 1,
  240. Domain => AF_INET6,
  241. LocalAddr => "::",
  242. Proto => "tcp"
  243. );};
  244. $err2 = $!;
  245. }
  246. if (! $client_listen && ! $client_listen6) {
  247. cleanup();
  248. die "$prog: error: client listen on port $client_port: $err1 - $err2\n";
  249. }
  250.  
  251. my $server_listen = IO::Socket::INET->new(
  252. Listen => 10,
  253. LocalPort => $server_port,
  254. ReuseAddr => 1,
  255. Proto => "tcp"
  256. );
  257. $err1 = $!;
  258. $err2 = '';
  259. $server_listen = '' if ! $server_listen;
  260.  
  261. my $server_listen6 = '';
  262. if ($have_inet6) {
  263. eval {$server_listen6 = IO::Socket::INET6->new(
  264. Listen => 10,
  265. LocalPort => $server_port,
  266. ReuseAddr => 1,
  267. Domain => AF_INET6,
  268. LocalAddr => "::",
  269. Proto => "tcp"
  270. );};
  271. $err2 = $!;
  272. }
  273. if (! $server_listen && ! $server_listen6) {
  274. cleanup();
  275. die "$prog: error: server listen on port $server_port: $err1 - $err2\n";
  276. }
  277.  
  278. my $select = new IO::Select();
  279. if (! $select) {
  280. cleanup();
  281. die "$prog: select $!\n";
  282. }
  283.  
  284. $select->add($client_listen) if $client_listen;
  285. $select->add($client_listen6) if $client_listen6;
  286. $select->add($server_listen) if $server_listen;
  287. $select->add($server_listen6) if $server_listen6;
  288.  
  289. $SIG{INT} = sub {cleanup(); exit;};
  290. $SIG{TERM} = sub {cleanup(); exit;};
  291.  
  292. my $SOCK1 = '';
  293. my $SOCK2 = '';
  294. my $CURR = '';
  295.  
  296. lprint("$prog: starting up. pid: $$");
  297. lprint("watching for IPv4 connections on $client_port/client.") if $client_listen;
  298. lprint("watching for IPv4 connections on $server_port/server.") if $server_listen;
  299. lprint("watching for IPv6 connections on $client_port/client.") if $client_listen6;
  300. lprint("watching for IPv6 connections on $server_port/server.") if $server_listen6;
  301.  
  302. my $alarm_sock = '';
  303. my $got_alarm = 0;
  304. sub alarm_handler {
  305. lprint("$prog: got sig alarm.");
  306. if ($alarm_sock ne '') {
  307. close $alarm_sock;
  308. }
  309. $alarm_sock = '';
  310. $got_alarm = 1;
  311. }
  312.  
  313. while (my @ready = $select->can_read()) {
  314. foreach my $fh (@ready) {
  315. if (($client_listen && $fh == $client_listen) || ($client_listen6 && $fh == $client_listen6)) {
  316. lprint("new vnc client connecting.");
  317. } elsif (($server_listen && $fh == $server_listen) || ($server_listen6 && $fh == $server_listen6)) {
  318. lprint("new vnc server connecting.");
  319. }
  320. my $sock = $fh->accept();
  321. if (! $sock) {
  322. lprint("$prog: accept $!");
  323. next;
  324. }
  325.  
  326. if (($client_listen && $fh == $client_listen) || ($client_listen6 && $fh == $client_listen6)) {
  327. if (exists $ENV{ULTRAVNC_REPEATER_NO_RFB} && $ENV{ULTRAVNC_REPEATER_NO_RFB}) {
  328. lprint("ULTRAVNC_REPEATER_NO_RFB: not sending RFB 000.000");
  329. } else {
  330. my $str = "RFB 000.000\n";
  331. my $len = length $str;
  332. my $n = syswrite($sock, $str, $len, 0);
  333. if ($n != $len) {
  334. lprint("$prog: bad $str write: $n != $len $!");
  335. close $sock;
  336. }
  337. }
  338. }
  339.  
  340. my $buf = '';
  341. my $size = $repeater_bufsize;
  342. $size = 1024 unless $size;
  343.  
  344. $SIG{ALRM} = "alarm_handler";
  345. $alarm_sock = $sock;
  346. $got_alarm = 0;
  347. alarm($init_timeout);
  348. my $n = sysread($sock, $buf, $size);
  349. alarm(0);
  350.  
  351. if ($got_alarm) {
  352. lprint("$prog: read timed out: $!");
  353. } elsif (! defined $n) {
  354. lprint("$prog: read error: $!");
  355. } elsif ($repeater_bufsize > 0 && $n != $size) {
  356. lprint("$prog: short read $n != $size $!");
  357. close $sock;
  358. } elsif (($client_listen && $fh == $client_listen) || ($client_listen6 && $fh == $client_listen6)) {
  359. do_new_client($sock, $buf);
  360. } elsif (($server_listen && $fh == $server_listen) || ($server_listen6 && $fh == $server_listen6)) {
  361. do_new_server($sock, $buf);
  362. }
  363. }
  364. }
  365.  
  366. sub do_new_client {
  367. my ($sock, $buf) = @_;
  368.  
  369. if ($buf =~ /^ID:(\w+)/) {
  370. my $id = $1;
  371. if (exists $ID{$id} && exists $ID{$id}{client} && $ID{$id}{client} eq "0") {
  372. if (!established($ID{$id}{sock})) {
  373. lprint("server socket for ID:$id is no longer established, closing it.");
  374. close $ID{$id}{sock};
  375. delete $ID{$id};
  376. } else {
  377. lprint("server socket for ID:$id is still established.");
  378. }
  379. }
  380. if (exists $ID{$id}) {
  381. if ($ID{$id}{client}) {
  382. my $ref = $refuse;
  383. if ($ref && !established($ID{$id}{sock})) {
  384. lprint("socket for ID:$id is no longer established, closing it.");
  385. $ref = 0;
  386. }
  387. if ($ref) {
  388. lprint("refusing extra vnc client for ID:$id.");
  389. close $sock;
  390. return;
  391. } else {
  392. lprint("closing and deleting previous vnc client with ID:$id.");
  393. close $ID{$id}{sock};
  394.  
  395. lprint("storing new vnc client with ID:$id.");
  396. $ID{$id}{client} = 1;
  397. $ID{$id}{sock} = $sock;
  398. }
  399. } else {
  400. lprint("hooking up new vnc client with existing vnc server for ID:$id.");
  401. my $sock2 = $ID{$id}{sock};
  402. delete $ID{$id};
  403. hookup($sock, $sock2, "ID:$id");
  404. }
  405. } else {
  406. lprint("storing new vnc client with ID:$id.");
  407. $ID{$id}{client} = 1;
  408. $ID{$id}{sock} = $sock;
  409. }
  410. } else {
  411. my $str = sprintf("%s", $buf);
  412. $str =~ s/\s*$//g;
  413. $str =~ s/\0*$//g;
  414. my $host = '';
  415. my $port = '';
  416. if ($str =~ /^(.+):(\d+)$/) {
  417. $host = $1;
  418. $port = $2;
  419. } else {
  420. $host = $str;
  421. $port = 5900;
  422. }
  423. if ($port < 0) {
  424. my $pnew = -$port;
  425. lprint("resetting port from $port to $pnew.");
  426. $port = $pnew;
  427. } elsif ($port < 200) {
  428. my $pnew = $port + 5900;
  429. lprint("resetting port from $port to $pnew.");
  430. $port = $pnew;
  431. }
  432. lprint("making vnc client connection directly to vnc server host='$host' port='$port'.");
  433. my $sock2 = IO::Socket::INET->new(
  434. PeerAddr => $host,
  435. PeerPort => $port,
  436. Proto => "tcp"
  437. );
  438. if (! $sock2 && $have_inet6) {
  439. lprint("IPv4 connect error: $!, trying IPv6 ...");
  440. eval{$sock2 = IO::Socket::INET6->new(
  441. PeerAddr => $host,
  442. PeerPort => $port,
  443. Proto => "tcp"
  444. );};
  445. lprint("IPv6 connect error: $!") if !$sock2;
  446. } else {
  447. lprint("IPv4 connect error: $!") if !$sock2;
  448. }
  449. if (!$sock2) {
  450. lprint("failed to connect to $host:$port.");
  451. close $sock;
  452. return;
  453. }
  454. hookup($sock, $sock2, "$host:$port");
  455. }
  456. }
  457.  
  458. sub do_new_server {
  459. my ($sock, $buf) = @_;
  460.  
  461. if ($buf =~ /^ID:(\w+)/) {
  462. my $id = $1;
  463. my $store = 1;
  464. if (exists $ID{$id} && exists $ID{$id}{client} && $ID{$id}{client} eq "1") {
  465. if (!established($ID{$id}{sock})) {
  466. lprint("client socket for ID:$id is no longer established, closing it.");
  467. close $ID{$id}{sock};
  468. delete $ID{$id};
  469. } else {
  470. lprint("client socket for ID:$id is still established.");
  471. }
  472. }
  473. if (exists $ID{$id}) {
  474. if (! $ID{$id}{client}) {
  475. my $ref = $refuse;
  476. if ($ref && !established($ID{$id}{sock})) {
  477. lprint("socket for ID:$id is no longer established, closing it.");
  478. $ref = 0;
  479. }
  480. if ($ref) {
  481. lprint("refusing extra vnc server for ID:$id.");
  482. close $sock;
  483. return;
  484. } else {
  485. lprint("closing and deleting previous vnc server with ID:$id.");
  486. close $ID{$id}{sock};
  487.  
  488. lprint("storing new vnc server with ID:$id.");
  489. $ID{$id}{client} = 0;
  490. $ID{$id}{sock} = $sock;
  491. }
  492. } else {
  493. lprint("hooking up new vnc server with existing vnc client for ID:$id.");
  494. my $sock2 = $ID{$id}{sock};
  495. delete $ID{$id};
  496. hookup($sock, $sock2, "ID:$id");
  497. }
  498. } else {
  499. lprint("storing new vnc server with ID:$id.");
  500. $ID{$id}{client} = 0;
  501. $ID{$id}{sock} = $sock;
  502. }
  503. } else {
  504. lprint("invalid ID:NNNNN string for vnc server: $buf");
  505. close $sock;
  506. return;
  507. }
  508. }
  509.  
  510. sub established {
  511. my $fh = shift;
  512.  
  513. return established_linux_proc($fh);
  514.  
  515. # not working:
  516. my $est = 1;
  517. my $str = "Z";
  518. my $res;
  519. #$res = recv($fh, $str, 1, MSG_PEEK | MSG_DONTWAIT);
  520. if (defined($res)) {
  521. lprint("established OK: $! '$str'.");
  522. $est = 1;
  523. } else {
  524. # would check for EAGAIN here to decide ...
  525. lprint("established err: $! '$str'.");
  526. $est = 1;
  527. }
  528. return $est;
  529. }
  530.  
  531.  
  532. sub established_linux_proc {
  533. # hack for Linux to see if remote side has gone away:
  534. my $fh = shift;
  535.  
  536. # if we can't figure things out, we must return true.
  537. if ($uname !~ /Linux/) {
  538. return 1;
  539. }
  540.  
  541. my @proc_net_tcp = ();
  542. if (-e "/proc/net/tcp") {
  543. push @proc_net_tcp, "/proc/net/tcp";
  544. }
  545. if (-e "/proc/net/tcp6") {
  546. push @proc_net_tcp, "/proc/net/tcp6";
  547. }
  548. if (! @proc_net_tcp) {
  549. return 1;
  550. }
  551.  
  552. my $n = fileno($fh);
  553. if (!defined($n)) {
  554. return 1;
  555. }
  556.  
  557. my $proc_fd = "/proc/$$/fd/$n";
  558. if (! -e $proc_fd) {
  559. return 1;
  560. }
  561.  
  562. my $val = readlink($proc_fd);
  563. if (! defined $val || $val !~ /socket:\[(\d+)\]/) {
  564. return 1;
  565. }
  566. my $num = $1;
  567.  
  568. my $st = '';
  569.  
  570. foreach my $tcp (@proc_net_tcp) {
  571. if (! open(TCP, "<$tcp")) {
  572. next;
  573. }
  574. while (<TCP>) {
  575. next if /^\s*[A-z]/;
  576. chomp;
  577. # sl local_address rem_address st tx_queue rx_queue tr tm->when retrnsmt uid timeout inode
  578. # 170: 0102000A:170C FE02000A:87FA 01 00000000:00000000 00:00000000 00000000 1001 0 423294766 1 f6fa4100 21 4 4 2 -1
  579. # 172: 0102000A:170C FE02000A:87FA 08 00000000:00000001 00:00000000 00000000 1001 0 423294766 1 f6fa4100 21 4 4 2 -1
  580. my @items = split(' ', $_);
  581. my $state = $items[3];
  582. my $inode = $items[9];
  583. if (!defined $state || $state !~ /^\d+$/) {
  584. next;
  585. }
  586. if (!defined $inode || $inode !~ /^\d+$/) {
  587. next;
  588. }
  589. if ($inode == $num) {
  590. $st = $state;
  591. last;
  592. }
  593. }
  594. close TCP;
  595. last if $st ne '';
  596. }
  597.  
  598. if ($st ne '' && $st != 1) {
  599. return 0;
  600. }
  601. return 1;
  602. }
  603.  
  604. sub handler {
  605. lprint("\[$$/$CURR] got SIGTERM.");
  606. close $SOCK1 if $SOCK1;
  607. close $SOCK2 if $SOCK2;
  608. exit;
  609. }
  610.  
  611. sub hookup {
  612. my ($sock1, $sock2, $tag) = @_;
  613.  
  614. my $worker = fork();
  615.  
  616. if (! defined $worker) {
  617. lprint("failed to fork worker: $!");
  618. close $sock1;
  619. close $sock2;
  620. return;
  621. } elsif ($worker) {
  622. close $sock1;
  623. close $sock2;
  624. wait;
  625. } else {
  626. cleanup();
  627. if (fork) {
  628. exit 0;
  629. }
  630. setpgrp(0, 0);
  631. $SOCK1 = $sock1;
  632. $SOCK2 = $sock2;
  633. $CURR = $tag;
  634. $SIG{TERM} = "handler";
  635. $SIG{INT} = "handler";
  636. xfer_both($sock1, $sock2);
  637. exit 0;
  638. }
  639. }
  640.  
  641. sub xfer {
  642. my ($in, $out) = @_;
  643.  
  644. $RIN = $WIN = $EIN = "";
  645. $ROUT = "";
  646. vec($RIN, fileno($in), 1) = 1;
  647. vec($WIN, fileno($in), 1) = 1;
  648. $EIN = $RIN | $WIN;
  649.  
  650. my $buf;
  651.  
  652. while (1) {
  653. my $nf = 0;
  654. while (! $nf) {
  655. $nf = select($ROUT=$RIN, undef, undef, undef);
  656. }
  657. my $len = sysread($in, $buf, 8192);
  658. if (! defined($len)) {
  659. next if $! =~ /^Interrupted/;
  660. lprint("\[$$/$CURR] $!");
  661. last;
  662. } elsif ($len == 0) {
  663. lprint("\[$$/$CURR] Input is EOF.");
  664. last;
  665. }
  666. my $offset = 0;
  667. my $quit = 0;
  668. while ($len) {
  669. my $written = syswrite($out, $buf, $len, $offset);
  670. if (! defined $written) {
  671. lprint("\[$$/$CURR] Output is EOF. $!");
  672. $quit = 1;
  673. last;
  674. }
  675. $len -= $written;
  676. $offset += $written;
  677. }
  678. last if $quit;
  679. }
  680. close($out);
  681. close($in);
  682. lprint("\[$$/$CURR] finished xfer.");
  683. }
  684.  
  685. sub xfer_both {
  686. my ($sock1, $sock2) = @_;
  687.  
  688. my $parent = $$;
  689.  
  690. my $child = fork();
  691.  
  692. if (! defined $child) {
  693. lprint("$prog\[$$/$CURR] failed to fork: $!");
  694. return;
  695. }
  696.  
  697. $SIG{TERM} = "handler";
  698. $SIG{INT} = "handler";
  699.  
  700. if ($child) {
  701. lprint("[$$/$CURR] parent 1 -> 2.");
  702. xfer($sock1, $sock2);
  703. select(undef, undef, undef, 0.25);
  704. if (kill 0, $child) {
  705. select(undef, undef, undef, 0.9);
  706. if (kill 0, $child) {
  707. lprint("\[$$/$CURR] kill TERM child $child");
  708. kill "TERM", $child;
  709. } else {
  710. lprint("\[$$/$CURR] child $child gone.");
  711. }
  712. }
  713. } else {
  714. select(undef, undef, undef, 0.05);
  715. lprint("[$$/$CURR] child 2 -> 1.");
  716. xfer($sock2, $sock1);
  717. select(undef, undef, undef, 0.25);
  718. if (kill 0, $parent) {
  719. select(undef, undef, undef, 0.8);
  720. if (kill 0, $parent) {
  721. lprint("\[$$/$CURR] kill TERM parent $parent.");
  722. kill "TERM", $parent;
  723. } else {
  724. lprint("\[$$/$CURR] parent $parent gone.");
  725. }
  726. }
  727. }
  728. }
  729.  
  730. sub fsleep {
  731. my ($time) = @_;
  732. select(undef, undef, undef, $time) if $time;
  733. }
  734.  
  735. sub cleanup {
  736. close $client_listen if $client_listen;
  737. close $client_listen6 if $client_listen6;
  738. close $server_listen if $server_listen;
  739. close $server_listen6 if $server_listen6;
  740. foreach my $id (keys %ID) {
  741. close $ID{$id}{sock};
  742. }
  743. }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement