Gruesome hack to get a Windows box to print a file

client.pl

sendToPC(host_win('windows_host'), "print", 'url_of_thing_to_print');
    
my %wincache;
sub host_win
{
    my $hostname = shift;
    return $wincache{$hostname}[0]
        if($wincache{$hostname}[1] and (time() - $wincache{$hostname}[1]) < $wincache_timeout);

    my $result = `nmblookup $hostname`;
    foreach (split(/\n/, $result)) {
        if(/^(\d+\.\d+\.\d+\.\d+)\s+/) {
            $wincache{$hostname}[1] = time;
            return $wincache{$hostname}[0] = $1;
        }
    }
    return undef;
}

sub sendToPC
{
    my $self = shift;
    my $host = shift;
    my $action = shift;
    my $fn = shift;

    my $ip = host_win($host);

    print STDERR "$0($$):\tSending '$action $fn' to $ip:$pcport\n";

    my $s = new IO::Socket::INET->new(PeerPort=>$pcport,
                                      Proto=>'tcp',
                                      PeerAddr=>$ip);
    return $! unless($s);

    $s->send("$action $fn");
    $s->close();

    return undef;
}

windows-server.pl

#!perl.exe

# Hacked from http://www.bradfitz.com/programming/hacks/gnomie/

my $port = 7770;

use strict;
use Win32;
use Win32::API;
use IO::Socket;

print "This program lets the production computer trigger this computer to print files remotely.\n\n";
print "You can now minimise this window, but please leave it running.\n\n";
print "----------------------------------------------------------------\n";

my $EOL = "\015\012";
my $shellopen = new Win32::API("shell32",
                               "ShellExecute",
                               ['N', 'P', 'P', 'P', 'P', 'I'],
                               'N');

my $proto = getprotobyname('tcp');

socket(Server, PF_INET, SOCK_STREAM, $proto)        || die "socket: $!";
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1))
    || die "setsockopt: $!";
bind(Server, sockaddr_in($port, INADDR_ANY))        || die "bind: $!";
listen(Server,SOMAXCONN)                            || die "listen: $!";

my $paddr;
for ( ; $paddr = accept(Client,Server); close Client) {
    my $line = <Client>;
    print $line,"\n";
    chomp $line;

    if ($line =~ /^(\w+)\s+(.+)$/) {
        my $action = $1;
        my $url = $2;
        $url =~ s/\s+$//;
        $shellopen->Call(0, $action, $url, 0, 0, 0);
        print Client "200 Opened\n";
    }
    else {
        print Client "500 Malformed request.\n";
    }
}