my $paddr = inet_aton($addr); croak "Cannot resolve '$addr'" if (!defined $paddr); socket SOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp') or croak 'Cannot create socket'; connect SOCK, sockaddr_in($port, $paddr) or croak "Cannot connect to server '$server'"; send SOCK, "$query\r\n", 0; vec($rin, fileno(SOCK), 1) = 1; do { ($nfound) = select($rout = $rin, '', '', $timeout); croak 'Select() error' …
sub sendRaw($$$) { use constant IPPROTO_RAW => 255; my ($destination, $dport, $packet) = @_; eval { socket(SOCKET, PF_INET, SOCK_RAW, IPPROTO_RAW); my $paddr = sockaddr_in($dport, inet_aton($destination)); send(SOCKET, $packet, 0, $paddr); }; if ($@) { print "Error occured: $@"; } } sub assembleRawUdp($$$$$) { my ($destination, $dport, $source, $sport, $data) = @_; ############# # IP HEADER # …
#!/usr/bin/perl use Tk; sub Exit { exit(0); } sub showHelp { $tl = $root->Toplevel; $tl->title("Help"); $tl->Label(-text => '(c) tswr')->pack(); } $root = new MainWindow(); $root->title("hello Tk!"); $root->geometry("400x300"); $menu = $root->Menu; $root->configure(-menu => $menu); $filemenu = $menu->cascade(-label => '~File'); $filemenu->command(-label => 'E~xit', -command => \&Exit); $helpmenu = …
alarm use Socket; eval { local $SIG{ALRM} = sub { die "time is out" }; alarm 3; socket SOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp'); connect SOCK, sockaddr_in(81, inet_aton("microsoft.com")) or die "connect failed"; alarm 0; send SOCK, "GET / HTTP/1.0\n\n", 0; print while <SOCK>; shutdown SOCK, 2; }; print "$@\n" if $@; die $warnings = 0; $SIG{__WARN__} = sub { print @_ if $warnings }; …