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' if ($nfound == -1);
    croak 'Timeout' if ($nfound == 0);
    croak 'Recv() error' if (!defined(recv SOCK, $buf, 512, 0));
    $answer .= $buf;
} while $buf ne '';
shutdown SOCK, 2;

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) = @_;

(Read more)

#!/usr/bin/perl

use Tk;

sub Exit {
    exit(0);
}

sub showHelp {
    $tl = $root->Toplevel;
    $tl->title("Help");
    $tl->Label(-text => '(c) tswr')->pack();
}

(Read more)

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 };
$SIG{__DIE__} = sub { print "Goodbye, my darling!\n" };

warn "i'm only warning...";
die "i'm dying...";

(Read more)