#!/usr/bin/perl -T #!/usr/bin/env perl # railroad crossing gate thingy, railroad.cgi use Socket; ## Start user config # # host that controls the railroad gate controller $host = "localhost"; # gate up port $up_port = "8000"; # gate down port $down_port = "8001"; # file that contains the railroad gate's current status $status = "/tmp/.railroad.status"; # # End user config # Setup # select STDOUT; $| = 1; # Print MIME # print "Content-type:text/html\n\n"; # Send data # sub Send { my($in_addr,$addr,$proto); open ST, ">$status" || print "Can't open $status: $!\n"; print ST "$value\n"; close ST; $in_addr = (gethostbyname($host))[4]; $addr = sockaddr_in($port, $in_addr); $proto = getprotobyname('tcp'); socket(Server, AF_INET, SOCK_STREAM, $proto) or print "socket: $!\n"; connect(Server, $addr) or print "connect: $!\n"; select Server; send(Server, "", MSG_OOB); close Server; } # blah # read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); @pairs = split(/&/, $buffer); foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $FORM{$name} = $value; } $value =~ tr/a-z//csd; if ($value eq "up") { &Send($port = $up_port); } elsif ($value eq "down") { &Send($port = $down_port); } else { $value = "broken"; } # Setup # select STDOUT; $| = 1; # Draw me a web page # print < Results The railroad crossing gate is now $value, or should be.

END_OF_FILE