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