Including README and examples and stuff.

[vinegar-ip.git] / make-probes.tcl

diff --git a/make-probes.tcl b/make-probes.tcl
index c3a1d3330b20eac311afc1c311f52dec7d971686..ce215a8dbf6addb0346003588c515c9718b29600 100755 (executable)
--- a/make-probes.tcl
+++ b/make-probes.tcl
@@ -1,5 +1,25 @@
-#!/usr/bin/tclsh8.2
-
+#!/usr/bin/tclsh
+
+# core packet generator for vinegar-ip
+#
+# This file is part of vinegar-ip, tools for IP transparency testing.
+# vinegar-ip is Copyright (C) 2002 Ian Jackson
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software Foundation,
+# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 
+#
+# $Id$
 
 proc debug {level str} {
     global debug_level
@@ -659,34 +679,6 @@ define icmp-inforeq-code 0 timestamp {} {}
 # MAYADD ICMP traceroute RFC1393
 # MAYADD ICMP router discovery RFC1256
 
-proc port-pair {scope} {
-    get-for $scope
-
-    get style choice-mult \
-           request 0.15 \
-           reply 0.15 \
-           servers 0.20 \
-           random
-
-    if {"$style" != "random"} {
-       get port enum-def
-       set def_port $port
-    } else {
-       set def_port x
-    }
-    if {"$style" != "servers"} {
-       get port enum-rand 0 0xffff
-       set rand_port $port
-    }
-    switch -exact $style {
-       random  { set source_port $rand_port; set dest_port $rand_port }
-       request { set source_port $rand_port; set dest_port $def_port }
-       reply   { set source_port $def_port;  set dest_port $rand_port }
-       servers { set source_port $def_port;  set dest_port $def_port }
-    }
-    return [list $source_port $dest_port $def_port $style]
-}
-
 
 define ip-proto 4 ip {mtu} {
     # RFC2003
@@ -751,6 +743,11 @@ define ip-proto 51 ah {mtu} {
     return $ah
 }
 
+proc udp-rport {} {
+    get-for udp
+    get port enum-rand 0 0xffff
+    return $port
+}
 
 define ip-proto 17 udp {mtu} {
     # RFC768
@@ -760,7 +757,25 @@ define ip-proto 17 udp {mtu} {
            checksum_bad 0.10 \
            checksum_none 0.20 \
            checksum_good]
-    manyset [port-pair udp] source_port dest_port def_port style
+
+    get style choice-mult \
+           request 0.15 \
+           reply 0.15 \
+           servers 0.20 \
+           random
+
+    if {"$style" != "random"} {
+       get port enum-def
+       set def_port $port
+    } else {
+       set def_port x
+    }
+    switch -exact $style {
+       random  { set source_port [udp-rport]; set dest_port [udp-rport] }
+       request { set source_port [udp-rport]; set dest_port $def_port   }
+       reply   { set source_port $def_port;   set dest_port [udp-rport] }
+       servers { set source_port $def_port;   set dest_port $def_port   }
+    }
 
     if {"$style" != "random"} {
        set port $def_port
@@ -1000,14 +1015,16 @@ define ip-proto 6 tcp {mtu} {
     get urg hex 0 0xffff
 
     set options {}
-    get optmode choice-mult badopt 0.3 opt 0.6 noopt
+    get optmode choice-mult badopt 0.3 opt 0.3 noopt
     switch -exact $optmode {
        noopt { }
        badopt {
            get options rand 1 60 1
        }
        opt {
-           while {[choice-prob tcp-opts-more 0.4]} {
+           set nooi 1
+           while {$nooi || [choice-prob tcp-opts-more 0.4]} {
+               set nooi 0
                get opt enum 1 255 0.5
                if {$opt == 1} {
                    assemble option {
@@ -1155,7 +1172,8 @@ namespace eval PCap {
 namespace import PCap::*
 
 proc emit {seed} {
-    global getlog_log errorInfo mtu
+    global getlog_log errorInfo mtu fake_time_t
+    global minframelen
 
     get-for ip
     get-config source 127.0.0.1 v4addr
@@ -1169,11 +1187,17 @@ proc emit {seed} {
        puts stderr "\nERROR\n$seed\n\n$emsg\n\n$errorInfo\n\n"
        puts stdout "[format %6s $seed] error"
     } else {
-       set ts_sec [clock seconds]
+       set ts_sec [incr fake_time_t]
        set ts_usec 0
 
-       set llpkt [random-bytes 12] ;# ether addrs
-       append llpkt 0800 ;# eth ip type
+       set l [packet-len $packet]
+       if {$l < $minframelen} {
+           append packet [string repeat 00 [expr {$minframelen - $l}]]
+       }
+
+       # RFC894
+       set llpkt [random-bytes 12]
+       append llpkt 0800
        append llpkt $packet
        
        set len [packet-len "$llpkt"]
@@ -1223,7 +1247,10 @@ set version_minor 4
 set thiszone 0
 set sigfigs 0
 set snaplen 131073
+
+# RFC894
 set linktype 1
+set minframelen 46
 
 pcap_write {
     x32 magic
@@ -1235,6 +1262,8 @@ pcap_write {
     s32 linktype
 }
 
+set fake_time_t [clock seconds]
+
 if {[llength $argv]} {
     foreach count $argv { emit "$xseed$count" }
 } else {