#!/usr/bin/perl

sub TOHEX {
    $a = $_[0];
    #print $a, "\t";
    
    $a =~ /(\d*).(\d*).(\d*).(\d*)/;
    
    #print $1, " ", $2, " ", $3, " ", $4, "\t";
    $tohex = sprintf ("%02x%02x%02x%02x", $1, $2, $3, $4);
    
}

# --------- MAIN ----------
if (scalar(@ARGV) < 5){
    print("Not enough arguments\n");
    print("usage: make-server-ron.pl device meIP meHW gwIP clientIP0 [clientIP1 ...]\n\n");
    exit(-1);
}

$device    = shift(@ARGV);
$meIP      = shift(@ARGV);
$meHW      = shift(@ARGV);
$gwIP      = shift(@ARGV);
@clients   = @ARGV;
$n         = scalar(@clients);
#print "[", $n, "]\n";

($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();

print "// This configuration was generated by make-server-ron.pl\n";
print "// $mon/$mday/$year  $hour:$min:$sec\n";
print "//\n";
print "// make-server-ron.pl ", $device, " ", $meIP, " ", $meHW, " ", $gwIP, " ";
for($i=0; $i<$n; $i++) {
    print $clients[$i], " ";
}
print "\n//\n";
print "// Device :\t", $device, "\n";
print "// This IP:\t", $meIP, "\n";
print "// This HW:\t", $meHW, "\n";
print "// GW IP:  \t", $gwIP, "\n";
for($i=0; $i<$n; $i++) {
    print "// client", $i+2, ":\t", $clients[$i], "\n";
}

print "\n";

# --------------------------------------------------------------------------------------------
print "require(ron);\n";
print "ChangeUID(32767, 100);\n\n";

print "// ---- ARP machinery ----\n";
print "arpq :: ARPQuerier(", $meIP, ", ", $meHW, ");\n";
print "from0 :: FromDevice(", $device, ")\n";
print "from0\t-> c :: Classifier(12/0806 20/0002, -)\n";
print "\t-> [1]arpq;\n";
print "c[1] -> Discard;\n\n";

print "setgw :: SetIPAddress(", $gwIP, ")\n";
print "\t-> arpq\n";
print "\t-> QueueNotify(100)\n";
print "\t-> ToDeviceNotify(", $device, ");\n";
print "\n";

print "iprw :: IPRewriter(\n";
for($i=0; $i<$n; $i++) {
    print "\tpattern ", $meIP, " ";
    print 50000 + $i * 50, "-", 50049 + $i * 50, " - - ";
    print 2*$i, " ", 2*$i + 1, ",\n";
}
print "\tdrop,\n";
print "\tTCP_TIMEOUT 1200,\n";
print "\tREAP_TCP 300);\n\n";

print "ipc :: IPClassifier(\n";
for($i=0; $i<$n; $i++) {
    print "\tsrc ", $clients[$i], ",\n";
}
print "-);\n\n";


print "// Incoming Encapsulated Packets\n";
print "DivertSocket(3000)\n";
print "\t-> CheckIPHeader\n";
#//	-> Print(IN-ENCAP-RAW)
print "\t-> ipc;\n\n";

for($i=0; $i<$n; $i++) {
    print "ipc[$i]\n";
    print "\t-> IPPrint(IN-ENCAP-RAW)\n";
    print "\t-> StripIPHeader\n";
    print "\t-> Strip(8)\n";
    print "\t-> CheckIPHeader\n";
    print "\t-> IPPrint(IN-ENCAP-STR)\n";
    print "\t-> IPReassembler\n";
    print "\t-> CheckIPHeader\n";
    print "\t-> [", $i, "]iprw;\n\n";
}
print "ipc[", $n, "] -> DiscardNotify;\n";

print "// Incoming NAT reply packets\n";
print "DivertSocket(3001)\n";
print "\t-> CheckIPHeader\n";
print "//\t-> IPPrint(IN-NAT______)\n";
print "\t-> fragA :: IPFragmenter(1400, false)\n";
print "\t-> IPReassembler\n";
print "\t-> IPReassembler\n";
print "\t-> CheckIPHeader\n";
print "\t-> [", $n ,"]iprw;\n\n";


for($i=0; $i<$n; $i++) {
    print "iprw[", $i*2,  "] -> setgw;\n";
    print "iprw[", $i*2+1,"] -> CheckIPHeader\n";
    print "\t-> IPPrint(Rewritten", $i+1, "__)\n";
    print "\t-> frag", $i , " :: IPFragmenter(1400, false)\n";
    print "\t-> UDPIPEncap(", $meIP, ", 4001, ", $clients[$i], ", 4001)\n";
    print "\t-> IPPrint(Encapsulated)\n";
    print "\t-> setgw;\n\n";
}

print "icmperror :: ICMPError(", $meIP, ", 3, 4)\n";
print "//\t-> Print(SendingError,56)\n";
print "\t-> setgw;\n\n";

print "fragA[1] -> icmperror;\n";
for($i=0; $i<$n; $i++) {
    print "frag", $i, "[1] -> icmperror;\n";
}

# --------------------------------------------------------------------------------------------
