1*71ec8d3aScloder#!/usr/bin/perl 2*71ec8d3aScloder# $OpenBSD: run.pl,v 1.1 2005/04/08 17:12:49 cloder Exp $ 3*71ec8d3aScloder# $EOM: run.pl,v 1.2 1999/08/05 22:42:42 niklas Exp $ 4*71ec8d3aScloder 5*71ec8d3aScloder# 6*71ec8d3aScloder# Copyright (c) 2004 Niklas Hallqvist. All rights reserved. 7*71ec8d3aScloder# 8*71ec8d3aScloder# Redistribution and use in source and binary forms, with or without 9*71ec8d3aScloder# modification, are permitted provided that the following conditions 10*71ec8d3aScloder# are met: 11*71ec8d3aScloder# 1. Redistributions of source code must retain the above copyright 12*71ec8d3aScloder# notice, this list of conditions and the following disclaimer. 13*71ec8d3aScloder# 2. Redistributions in binary form must reproduce the above copyright 14*71ec8d3aScloder# notice, this list of conditions and the following disclaimer in the 15*71ec8d3aScloder# documentation and/or other materials provided with the distribution. 16*71ec8d3aScloder# 17*71ec8d3aScloder# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR 18*71ec8d3aScloder# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 19*71ec8d3aScloder# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 20*71ec8d3aScloder# IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, 21*71ec8d3aScloder# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 22*71ec8d3aScloder# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 23*71ec8d3aScloder# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 24*71ec8d3aScloder# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25*71ec8d3aScloder# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 26*71ec8d3aScloder# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27*71ec8d3aScloder# 28*71ec8d3aScloder 29*71ec8d3aScloderuse strict; 30*71ec8d3aScloderrequire 5.002; 31*71ec8d3aScloderrequire 'sys/syscall.ph'; 32*71ec8d3aScloderuse Socket; 33*71ec8d3aScloderuse Sys::Hostname; 34*71ec8d3aScloder 35*71ec8d3aSclodermy ($rfd, $tickfac, $myaddr, $myport, $hisaddr, $hisport, $proto, $bindaddr, 36*71ec8d3aScloder $conaddr, $sec, $tick, $action, $template, $data, $next, 37*71ec8d3aScloder $nfd, $pkt, $verbose); 38*71ec8d3aScloder 39*71ec8d3aScloder$| = 1; 40*71ec8d3aScloder 41*71ec8d3aScloder$verbose = 1; 42*71ec8d3aScloder$tickfac = 0.001; 43*71ec8d3aScloder$myaddr = gethostbyname ('127.0.0.1'); 44*71ec8d3aScloder$myport = 1501; 45*71ec8d3aScloder $hisaddr = inet_aton ('127.0.0.1'); 46*71ec8d3aScloder$hisport = 1500; 47*71ec8d3aScloder 48*71ec8d3aScloder$proto = getprotobyname ('udp'); 49*71ec8d3aScloder$bindaddr = sockaddr_in ($myport, $myaddr); 50*71ec8d3aSclodersocket (SOCKET, PF_INET, SOCK_DGRAM, $proto) || die "socket: $!"; 51*71ec8d3aScloderbind (SOCKET, $bindaddr); 52*71ec8d3aSclodervec ($rfd, fileno SOCKET, 1) = 1; 53*71ec8d3aScloder 54*71ec8d3aScloder$conaddr = sockaddr_in ($hisport, $hisaddr); 55*71ec8d3aScloder 56*71ec8d3aSclodersub getsec 57*71ec8d3aScloder{ 58*71ec8d3aScloder my ($tv) = pack ("ll", 0, 0); 59*71ec8d3aScloder my ($tz) = pack ("ii", 0, 0); 60*71ec8d3aScloder syscall (&SYS_gettimeofday, $tv, $tz) && return undef; 61*71ec8d3aScloder my ($sec, $usec) = unpack ("ll", $tv); 62*71ec8d3aScloder $sec % 86400 + $usec / 1000000; 63*71ec8d3aScloder} 64*71ec8d3aScloder 65*71ec8d3aScloder$sec = &getsec; 66*71ec8d3aScloderwhile (<>) { 67*71ec8d3aScloder next if /^\s*#/o || /^\s*$/o; 68*71ec8d3aScloder chop; 69*71ec8d3aScloder ($tick, $action, $template, $data) = split ' ', $_, 4; 70*71ec8d3aScloder while ($data =~ /\\$/o) { 71*71ec8d3aScloder chop $data; 72*71ec8d3aScloder $_ = <>; 73*71ec8d3aScloder next if /^\s*#/o; 74*71ec8d3aScloder chop; 75*71ec8d3aScloder $data .= $_; 76*71ec8d3aScloder } 77*71ec8d3aScloder $data =~ s/\s//go; 78*71ec8d3aScloder $data = pack $template, $data; 79*71ec8d3aScloder $next = $sec + $tick * $tickfac; 80*71ec8d3aScloder if ($action eq "send") { 81*71ec8d3aScloder # Wait for the moment to come. 82*71ec8d3aScloder print STDERR "waiting ", $next - $sec, " secs\n"; 83*71ec8d3aScloder select undef, undef, undef, $next - $sec 84*71ec8d3aScloder while ($sec = &getsec) < $next; 85*71ec8d3aScloder# print $data; 86*71ec8d3aScloder send SOCKET, $data, 0, $conaddr; 87*71ec8d3aScloder print STDERR "sent ", unpack ("H*", $data), "\n" if $verbose; 88*71ec8d3aScloder } elsif ($action eq "recv") { 89*71ec8d3aScloder $sec = &getsec; 90*71ec8d3aScloder printf (STDERR "waiting for data or the %.3f sec timeout\n", 91*71ec8d3aScloder $next - $sec); 92*71ec8d3aScloder $nfd = select $rfd, undef, undef, $next - $sec; 93*71ec8d3aScloder if ($nfd) { 94*71ec8d3aScloder printf STDERR "got back after %.3f secs\n", &getsec - $sec 95*71ec8d3aScloder if $verbose; 96*71ec8d3aScloder# sysread (STDIN, $pkt, 65536) if $nfd; 97*71ec8d3aScloder sysread (SOCKET, $pkt, 65536) if $nfd; 98*71ec8d3aScloder print STDERR "read ", unpack ("H*", $pkt), "\n" if $verbose; 99*71ec8d3aScloder print STDERR "cmp ", unpack ("H*", $data), "\n" if $verbose; 100*71ec8d3aScloder } else { 101*71ec8d3aScloder print STDERR "timed out\n" if $verbose; 102*71ec8d3aScloder } 103*71ec8d3aScloder die "mismatch\n" if $pkt ne $data; 104*71ec8d3aScloder } 105*71ec8d3aScloder} 106