From b6017ccf067a7fefa893c8bf19288a1909f17263 Mon Sep 17 00:00:00 2001
From: ian <ian>
Date: Thu, 26 Dec 2002 12:08:04 +0000
Subject: [PATCH] new socket id arrangements, working on tun

---
 base/chiark-tcl.h        |  19 ++-
 base/hook.c              |  15 ++-
 base/idtable.c           | 126 ++++++++++++++++++
 base/tables-examples.tct |  33 ++++-
 base/tcmdifgen           |  67 ++++++----
 base/troglodyte-Makefile |   1 +
 dgram/dgram.c            | 114 +++-------------
 hbytes/hbytes.h          |  19 ++-
 hbytes/hook.c            |  15 ++-
 tuntap/tuntap.c          | 276 +++++++++++++++++++++++++++++++++++++++
 10 files changed, 549 insertions(+), 136 deletions(-)
 create mode 100644 base/idtable.c
 create mode 100644 tuntap/tuntap.c

diff --git a/base/chiark-tcl.h b/base/chiark-tcl.h
index f8f59fd..f7d0110 100644
--- a/base/chiark-tcl.h
+++ b/base/chiark-tcl.h
@@ -175,10 +175,25 @@ int sockaddr_len(const SockAddr_Value*);
 const struct sockaddr *sockaddr_addr(const SockAddr_Value*);
 void sockaddr_free(const SockAddr_Value*);
 
+/* from idtable.c */
+
+typedef struct {
+  const char *const prefix;
+  int n;
+  void **a;
+} IdDataTable;
+
+extern Tcl_ObjType tabledataid_nearlytype;
+int tabledataid_parse(Tcl_Interp *ip, Tcl_Obj *o, IdDataTable *tab);
+
 /* from dgram.c */
 
-extern Tcl_ObjType dgramsockid_type;
-typedef struct DgramSocket *DgramSockID;
+extern IdDataTable dgram_socks;
+int newfdposixerr(Tcl_Interp *ip, int fd, const char *m);
+
+/* from tuntap.c */
+
+extern IdDataTable tuntap_socks;
 
 /* from hook.c */
 
diff --git a/base/hook.c b/base/hook.c
index a9d0316..b84306a 100644
--- a/base/hook.c
+++ b/base/hook.c
@@ -22,6 +22,13 @@ int posixerr(Tcl_Interp *ip, int errnoval, const char *m) {
   return TCL_ERROR;
 }
 
+int newfdposixerr(Tcl_Interp *ip, int fd, const char *m) {
+  int e;
+  e= errno;
+  close(fd);
+  return posixerr(ip,e,m);
+}
+
 void objfreeir(Tcl_Obj *o) {
   if (o->typePtr && o->typePtr->freeIntRepProc)
     o->typePtr->freeIntRepProc(o);
@@ -361,6 +368,12 @@ int do_toplevel_dgram_socket(ClientData cd, Tcl_Interp *ip,
   return subcmd->func(0,ip,objc,objv);
 }
 
+int do_toplevel_tuntap_socket(ClientData cd, Tcl_Interp *ip,
+			     const TunSocket_SubCommand *subcmd,
+			     int objc, Tcl_Obj *const *objv) {
+  return subcmd->func(0,ip,objc,objv);
+}
+
 int do_toplevel_ulong(ClientData cd, Tcl_Interp *ip,
 		      const ULong_SubCommand *subcmd,
 		      int objc, Tcl_Obj *const *objv) {
@@ -400,7 +413,7 @@ int Hbytes_Init(Tcl_Interp *ip) {
   Tcl_RegisterObjType(&enum_nearlytype);
   Tcl_RegisterObjType(&enum1_nearlytype);
   Tcl_RegisterObjType(&sockaddr_type);
-  Tcl_RegisterObjType(&dgramsockid_type);
+  Tcl_RegisterObjType(&tabledataid_nearlytype);
   Tcl_RegisterObjType(&ulong_type);
 
   for (cmd=toplevel_commands;
diff --git a/base/idtable.c b/base/idtable.c
new file mode 100644
index 0000000..c2f3aaa
--- /dev/null
+++ b/base/idtable.c
@@ -0,0 +1,126 @@
+/*
+ */
+/*
+ * dgram-socket create <local>                        => <sockid>
+ * dgram-socket close <sockid>
+ * dgram-socket transmit <sockid> <data> <remote>
+ * dgram-socket on-receive <sockid> [<script>]
+ *    calls, effectively,  eval <script> [list <data> <remote-addr> <socket>]
+ *    if script not supplied, cancel
+ */
+
+#include "tables.h"
+#include "hbytes.h"
+
+/* Arg parsing */
+
+static void setobjdataid(Tcl_Obj *o, int ix, IdDataTable *tab) {
+  unsigned long *ulp;
+  
+  ulp= TALLOC(sizeof(unsigned long));
+  *ulp= ix;
+  o->internalRep.twoPtrValue.ptr1= tab;
+  o->internalRep.twoPtrValue.ptr2= ulp;
+  o->typePtr= &tabledataid_nearlytype;
+}
+
+int tabledataid_parse(Tcl_Interp *ip, Tcl_Obj *o, IdDataTable *tab) {
+  int l;
+  unsigned long ul;
+  char *ep, *str;
+
+  if (o->typePtr == &tabledataid_nearlytype &&
+      o->internalRep.twoPtrValue.ptr1 == tab) return TCL_OK;
+
+  l= strlen(tab->prefix);
+  str= Tcl_GetStringFromObj(o,0);
+  if (memcmp(str,tab->prefix,l))
+    return staticerr(ip,"bad id (wrong prefix)",0);
+  errno=0; ul=strtoul(str+l,&ep,10);
+  if (errno || *ep) return staticerr(ip,"bad id number",0);
+  if (ul > INT_MAX) return staticerr(ip,"out of range id number",0);
+
+  objfreeir(o);
+  setobjdataid(o,ul,tab);
+  return TCL_OK;
+}
+
+int pat_iddata(Tcl_Interp *ip, Tcl_Obj *o, void **rv, IdDataTable *tab) {
+  int rc, ix;
+  void *r;
+  
+  rc= tabledataid_parse(ip,o,tab);
+  if (rc) return rc;
+
+  ix= *(unsigned long*)o->internalRep.twoPtrValue.ptr2;
+  if (ix >= tab->n || !(r= tab->a[ix]))
+    return staticerr(ip,"id not in use",0);
+
+  assert(*(int*)r == ix);
+
+  *rv= r;
+  return TCL_OK;
+}
+
+Tcl_Obj *ret_iddata(Tcl_Interp *ip, void *val, IdDataTable *tab) {
+  /* Command procedure implementation may set val->ix,
+   * ie *(int*)val, to -1, to mean it's a new struct.  Otherwise
+   * it had better be an old one !
+   */
+  Tcl_Obj *o;
+  int ix;
+
+  ix= *(int*)val;
+  if (ix==-1) {
+    for (ix=0; ix<tab->n && tab->a[ix]; ix++);
+    if (ix>=tab->n) {
+      tab->n += 2;
+      tab->n *= 2;
+      tab->a= (void*)Tcl_Realloc((void*)tab->a, tab->n*sizeof(*tab->a));
+      while (ix<tab->n) tab->a[ix++]=0;
+      ix--;
+    }
+    tab->a[ix]= val;
+    *(int*)val= ix;
+  } else {
+    assert(val == tab->a[ix]);
+  }
+
+  o= Tcl_NewObj();
+  setobjdataid(o,ix,tab);
+  Tcl_InvalidateStringRep(o);
+  return o;
+}
+
+static int tabledataid_nt_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
+  abort();
+}
+
+static void tabledataid_nt_free(Tcl_Obj *o) {
+  TFREE(o->internalRep.twoPtrValue.ptr2);
+  o->internalRep.twoPtrValue.ptr2= 0;
+}
+
+static void tabledataid_nt_dup(Tcl_Obj *src, Tcl_Obj *dup) {
+  setobjdataid(dup,*(unsigned long*)src->internalRep.twoPtrValue.ptr2,
+	       src->internalRep.twoPtrValue.ptr1);
+}
+
+static void tabledataid_nt_ustr(Tcl_Obj *o) {
+  char buf[75];
+  const char *prefix;
+
+  prefix= o->internalRep.twoPtrValue.ptr2;
+  snprintf(buf,sizeof(buf), "%lu",
+	   *(unsigned long*)o->internalRep.twoPtrValue.ptr2);
+  obj_updatestr_vstringls(o,
+			  prefix, strlen(prefix),
+			  buf, strlen(buf),
+			  (char*)0);
+}
+
+Tcl_ObjType tabledataid_ntype = {
+  "tabledataid",
+  tabledataid_nt_free, tabledataid_nt_dup,
+  tabledataid_nt_ustr, tabledataid_nt_sfa
+};
diff --git a/base/tables-examples.tct b/base/tables-examples.tct
index 2e1e573..82700dc 100644
--- a/base/tables-examples.tct
+++ b/base/tables-examples.tct
@@ -8,9 +8,10 @@ Fini hbv			fini_hbv(ip, rc, &@);
 Type sockaddr:			SockAddr_Value @
 Init sockaddr			sockaddr_clear(&@);
 
-Type sockid:			DgramSockID @
+Type iddata(IdDataTable *tab):	void *@
 Type ulong:			uint32_t @
 Type long:			long @
+Type string:			const char *@
 
 H-Include	"hbytes.h"
 
@@ -21,6 +22,9 @@ Table toplevel TopLevel_Command
 	dgram-socket
 		subcmd	enum(DgramSocket_SubCommand,"dgram-socket subcommand")
 		...	obj
+	tuntap-socket
+		subcmd	enum(TunSocket_SubCommand,"tuntap-socket subcommand")
+		...	obj
 	ulong
 		subcmd	enum(ULong_SubCommand,"ulong subcommand")
 		...	obj
@@ -168,15 +172,34 @@ Table padmethodinfo PadMethodInfo
 Table dgram_socket DgramSocket_SubCommand
 	create
 		local	sockaddr
-		=>	sockid
+		=>	iddata(&dgram_socks)
 	close
-		sock	sockid
+		sock	iddata(&dgram_socks)
 	transmit
-		sock	sockid
+		sock	iddata(&dgram_socks)
 		data	hb
 		remote	sockaddr
 	on-receive
-		sock	sockid
+		sock	iddata(&dgram_socks)
+		?script	obj
+
+Table tuntap_socket TunSocket_SubCommand
+	create-ptp
+		local	sockaddr
+		peer	sockaddr
+		mtu	long
+		?ifname	string
+		=>	iddata(&tuntap_socks)
+	close
+		sock	iddata(&tuntap_socks)
+	ifname
+		sock	iddata(&tuntap_socks)
+		=>	string
+	receive
+		sock	iddata(&tuntap_socks)
+		data	hb
+	on-transmit
+		sock	iddata(&tuntap_socks)
 		?script	obj
 
 Table blockcipherop BlockCipherOp
diff --git a/base/tcmdifgen b/base/tcmdifgen
index 1456770..5cd076e 100755
--- a/base/tcmdifgen
+++ b/base/tcmdifgen
@@ -77,27 +77,17 @@ sub parse ($$) {
 	} elsif (@i==2 && m/^(\??)([a-z]\w*)\s*(\S.*)/
 		 && defined $c_entry) {
 	    ($opt, $var, $type) = ($1,$2,$3);
-	    if ($type =~ m/^\w+$/) {
-		$xtypeargs='';
-	    } elsif ($type =~ m/^(\w+)\((.+)\)$/) {
-		$type= $1;
-		$xtypeargs= $2;
-	    }
+	    ($type, $xtypeargs) = split_type_args($type);
 	    push @{ $tables{$c_table}{$c_entry}{A} },
 	        { N => $var, T => $type, A => $xtypeargs, O => ($opt eq '?') };
 	} elsif (@i==2 && m/^\=\>\s*(\S.*)$/ && defined $c_entry) {
-	    $tables{$c_table}{$c_entry}{R}= $1;
+	    ($type, $xtypeargs) = split_type_args($1);
+	    $tables{$c_table}{$c_entry}{R}= $type;
+	    $tables{$c_table}{$c_entry}{X}= $xtypeargs;
 	} elsif (@i==0 && m/^Type\s+([^\:]+)\:\s+(\S.*)$/) {
 	    ($typename,$ctype)= ($1,$2);
 	    $ctype .= ' @' unless $ctype =~ m/\@/;
-	    if ($typename =~ m/^\w+$/) {
-		$xtypeargs='';
-	    } elsif ($typename =~ m/^(\w+)\((.+)\)$/) {
-		$typename=$1;
-		$xtypeargs=$2;
-	    } else {
-		badsyntax($wh,$.,"bad type name/args");
-	    }
+	    ($typename,$xtypeargs) = split_type_args($typename);
 	    $types{$typename}= { C => $ctype, X => $xtypeargs };
 	} elsif (@i==0 && s/^Init\s+(\w+)\s+(\S.*)//) {
 	    $type_init{$1}= $2;
@@ -125,7 +115,9 @@ foreach $t (sort keys %types) {
     $decl .= ");\n";
     o('h',160, $decl);
 
-    $decl= "Tcl_Obj *ret_$t(Tcl_Interp *ip, ".subst_in_decl('val',$c).");\n";
+    $decl= "Tcl_Obj *ret_$t(Tcl_Interp *ip, ".subst_in_decl('val',$c);
+    $decl .= ", $xta" if length $xta;
+    $decl .= ");\n";
     o('h',170, $decl);
 }
 
@@ -170,8 +162,9 @@ foreach $c_table (sort keys %tables) {
 	    $n= $arg->{N};
 	    $t= $arg->{T};
 	    $a= $arg->{A};
-	    push @do_al, make_decl($n, $t, $arg->{A});
-	    $pa_vars .= make_decl_init("a_$n", $t, $a, \$pa_init);
+	    push @do_al, make_decl($n, $t, $arg->{A},
+				   "table $c_table entry $c_entry arg $n");
+	    $pa_vars .= make_decl_init("a_$n", $t, $a, \$pa_init, "pa_vars");
 	    if ($arg->{O}) {
 		$pa_hint .= " ?$n?";
 		if ($any_mand) {
@@ -223,10 +216,14 @@ foreach $c_table (sort keys %tables) {
 	}
 	if (exists $r_entry->{R}) {
 	    $t= $r_entry->{R};
-	    push @do_al, make_decl("*result", $t);
-	    $pa_vars .= make_decl_init("result", $t, '', \$pa_init);
+	    $xta= $r_entry->{X};
+	    push @do_al, make_decl("*result", $t, "do_al result");
+	    $pa_vars .= make_decl_init("result", $t, $xta, \$pa_init,
+				       "pa_vars result");
 	    push @do_aa, "&result";
-	    $pa_rslt .= "  Tcl_SetObjResult(ip, ret_$t(ip, result));\n";
+	    $pa_rslt .= "  Tcl_SetObjResult(ip, ret_$t(ip, result";
+	    $pa_rslt .= ", $xta" if length $xta;
+	    $pa_rslt .= "));\n";
 	}
 	$pa_body .= "\n";
 	$pa_body .= "  rc= do_${c_table}_${c_entry_c}(";
@@ -330,10 +327,24 @@ sub o ($$) {
     $o{$wh}{sprintf "%010d", $pr} .= $s;
 }
 
-sub make_decl_init ($$$$) {
-    my ($n, $t, $a, $initcode) = @_;
+sub split_type_args ($) {
+    my ($type) = @_;
+    my ($xtypeargs);
+    if ($type =~ m/^\w+$/) {
+	$xtypeargs='';
+    } elsif ($type =~ m/^(\w+)\((.+)\)$/) {
+	$type= $1;
+	$xtypeargs= $2;
+    } else {
+	badsyntax($wh,$.,"bad type name/args \`$type'\n");
+    }
+    return ($type,$xtypeargs);
+}
+
+sub make_decl_init ($$$$$) {
+    my ($n, $t, $a, $initcode, $why) = @_;
     my ($o,$init);
-    $o= make_decl($n,$t,$a);
+    $o= make_decl($n,$t,$a,"$why _init");
     if (exists $type_init{$t}) {
 	$init= $type_init{$t};
 	$$initcode .= "  ".subst_in("$n", $init)."\n"
@@ -344,14 +355,14 @@ sub make_decl_init ($$$$) {
     return "  ".$o.";\n";
 }
 
-sub make_decl ($$$) {
-    my ($n, $t, $ta) = @_;
+sub make_decl ($$$$) {
+    my ($n, $t, $ta, $why) = @_;
     my ($type);
     if ($t eq 'enum') {
-	$ta =~ m/\,/ or die "invalid enum type \`$t'\n";
+	$ta =~ m/\,/ or die "invalid enum type \`$t' ($why)\n";
 	$c= "const $` *@";
     } else { 
-	defined $types{$t} or die "unknown type $t\n";
+	defined $types{$t} or die "unknown type $t ($why)\n";
 	$c= $types{$t}{C};
     }
     return subst_in_decl($n,$c);
diff --git a/base/troglodyte-Makefile b/base/troglodyte-Makefile
index d84d43e..8a19442 100644
--- a/base/troglodyte-Makefile
+++ b/base/troglodyte-Makefile
@@ -1,6 +1,7 @@
 OBJS=		tables.o \
 		hbytes.o \
 		enum.o \
+		idtable.o \
 		ulongs.o \
 		sockaddr.o \
 		dgram.o \
diff --git a/dgram/dgram.c b/dgram/dgram.c
index e541a3a..8148792 100644
--- a/dgram/dgram.c
+++ b/dgram/dgram.c
@@ -13,49 +13,33 @@
 #include "hbytes.h"
 
 typedef struct DgramSocket {
-  int ix, fd, script_llength;
+  int ix; /* first ! */
+  int fd, script_llength;
   Tcl_Interp *ip;
   Tcl_Obj *script;
   void *addr_buf, *msg_buf;
   int addr_buflen, msg_buflen;
 } DgramSocket;
 
-static int n_socks;
-static DgramSocket **socks;
-
-static int sockfail(Tcl_Interp *ip, int fd, const char *m) {
-  int e;
-  e= errno;
-  close(fd);
-  return posixerr(ip,e,m);
-}
+IdDataTable dgram_socks= { "dgramsock" };
 
 int do_dgram_socket_create(ClientData cd, Tcl_Interp *ip,
-			  SockAddr_Value local, DgramSockID *sock_r) {
-  int fd, al, r, sockix;
+			   SockAddr_Value local, void **sock_r) {
+  int fd, al, r;
   DgramSocket *sock;
   const struct sockaddr *sa;
 
-  for (sockix=0; sockix<n_socks && socks[sockix]; sockix++);
-  if (sockix>=n_socks) {
-    n_socks += 2;
-    n_socks *= 2;
-    socks= (void*)Tcl_Realloc((void*)socks, n_socks*sizeof(*socks));
-    while (sockix<n_socks) socks[sockix++]=0;
-    sockix--;
-  }
-
   sa= sockaddr_addr(&local);
   al= sockaddr_len(&local);
 
   fd= socket(sa->sa_family, SOCK_DGRAM, 0);
   if (fd<0) return posixerr(ip,errno,"socket");
-  r= bind(fd, sa, al);  if (r) return sockfail(ip,fd,"bind");
-  r= setnonblock(fd, 1);  if (r) return sockfail(ip,fd,"setnonblock");
+  r= bind(fd, sa, al);  if (r) return newfdposixerr(ip,fd,"bind");
+  r= setnonblock(fd, 1);  if (r) return newfdposixerr(ip,fd,"setnonblock");
 
-  socks[sockix]= sock= TALLOC(sizeof(DgramSocket));
+  sock= TALLOC(sizeof(DgramSocket));
+  sock->ix= -1;
   sock->fd= fd;
-  sock->ix= sockix;
   sock->script= 0;
   sock->addr_buflen= al+1;
   sock->addr_buf= TALLOC(sock->addr_buflen);
@@ -67,8 +51,9 @@ int do_dgram_socket_create(ClientData cd, Tcl_Interp *ip,
 }
 
 int do_dgram_socket_transmit(ClientData cd, Tcl_Interp *ip,
-			     DgramSocket *sock, HBytes_Value data,
+			     void *sock_v, HBytes_Value data,
 			     SockAddr_Value remote) {
+  DgramSocket *sock= sock_v;
   int l, r;
 
   r= sendto(sock->fd,
@@ -139,7 +124,7 @@ static void recv_call(ClientData sock_cd, int mask) {
 
   args[0]= ret_hb(ip, message_val);  hbytes_empty(&message_val);
   args[1]= ret_sockaddr(ip, peer_val);  sockaddr_clear(&peer_val);
-  args[2]= ret_sockid(ip, sock);
+  args[2]= ret_iddata(ip, sock, &dgram_socks);
   for (i=0; i<3; i++) Tcl_IncrRefCount(args[i]);
 
   invoke= Tcl_DuplicateObj(sock->script);
@@ -159,7 +144,8 @@ x_rc:
 }
 
 int do_dgram_socket_on_receive(ClientData cd, Tcl_Interp *ip,
-			       DgramSocket *sock, Tcl_Obj *script) {
+			       void *sock_v, Tcl_Obj *script) {
+  DgramSocket *sock= sock_v;
   int rc;
   
   if (script) {
@@ -177,7 +163,8 @@ int do_dgram_socket_on_receive(ClientData cd, Tcl_Interp *ip,
   return TCL_OK;
 }
 
-int do_dgram_socket_close(ClientData cd, Tcl_Interp *ip, DgramSocket *sock) {
+int do_dgram_socket_close(ClientData cd, Tcl_Interp *ip, void *sock_v) {
+  DgramSocket *sock= sock_v;
   int sockix;
   cancel(sock);
   close(sock->fd); /* nothing useful to be done with errors */
@@ -185,73 +172,6 @@ int do_dgram_socket_close(ClientData cd, Tcl_Interp *ip, DgramSocket *sock) {
   TFREE(sock->addr_buf);
   TFREE(sock->msg_buf);
   TFREE(sock);
-  socks[sockix]= 0;
-  return TCL_OK;
-}
-
-/* Arg parsing */
-
-int pat_sockid(Tcl_Interp *ip, Tcl_Obj *o, DgramSocket **val) {
-  int rc, sockix;
-  DgramSocket *sock;
-  
-  rc= Tcl_ConvertToType(ip,o,&dgramsockid_type);
-  if (rc) return rc;
-
-  sockix= o->internalRep.longValue;
-  if (sockix >= n_socks || !(sock= socks[sockix]))
-    return staticerr(ip,"dgram socket not open",0);
-
-  assert(socks[sockix]->ix == sockix);
-
-  *val= sock;
-  return TCL_OK;
-}
-
-Tcl_Obj *ret_sockid(Tcl_Interp *ip, DgramSocket *val) {
-  Tcl_Obj *o;
-
-  o= Tcl_NewObj();
-  Tcl_InvalidateStringRep(o);
-  o->internalRep.longValue= val->ix;
-  o->typePtr= &dgramsockid_type;
-  return o;
-}
-
-static void sockid_t_free(Tcl_Obj *o) { }
-
-static void sockid_t_dup(Tcl_Obj *src, Tcl_Obj *dup) {
-  dup->internalRep= src->internalRep;
-  dup->typePtr= &dgramsockid_type;
-}
-
-static void sockid_t_ustr(Tcl_Obj *o) {
-  char buf[75];
-
-  snprintf(buf,sizeof(buf), "%d", (int)o->internalRep.longValue);
-  obj_updatestr_vstringls(o,
-			  "dgramsock",9,
-			  buf, strlen(buf),
-			  (char*)0);
-}
-
-static int sockid_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
-  unsigned long ul;
-  char *ep, *str;
-  
-  str= Tcl_GetStringFromObj(o,0);
-  if (memcmp(str,"dgramsock",9)) return staticerr(ip,"bad dgram socket id",0);
-  errno=0; ul=strtoul(str+9,&ep,10);
-  if (errno || *ep) return staticerr(ip,"bad dgram socket id number",0);
-  if (ul > INT_MAX) return staticerr(ip,"out of range dgram socket id",0);
-
-  objfreeir(o);
-  o->internalRep.longValue= ul;
-  o->typePtr= &dgramsockid_type;
+  dgram_socks.a[sockix]= 0;
   return TCL_OK;
 }
-
-Tcl_ObjType dgramsockid_type = {
-  "dgramsockid",
-  sockid_t_free, sockid_t_dup, sockid_t_ustr, sockid_t_sfa
-};
diff --git a/hbytes/hbytes.h b/hbytes/hbytes.h
index f8f59fd..f7d0110 100644
--- a/hbytes/hbytes.h
+++ b/hbytes/hbytes.h
@@ -175,10 +175,25 @@ int sockaddr_len(const SockAddr_Value*);
 const struct sockaddr *sockaddr_addr(const SockAddr_Value*);
 void sockaddr_free(const SockAddr_Value*);
 
+/* from idtable.c */
+
+typedef struct {
+  const char *const prefix;
+  int n;
+  void **a;
+} IdDataTable;
+
+extern Tcl_ObjType tabledataid_nearlytype;
+int tabledataid_parse(Tcl_Interp *ip, Tcl_Obj *o, IdDataTable *tab);
+
 /* from dgram.c */
 
-extern Tcl_ObjType dgramsockid_type;
-typedef struct DgramSocket *DgramSockID;
+extern IdDataTable dgram_socks;
+int newfdposixerr(Tcl_Interp *ip, int fd, const char *m);
+
+/* from tuntap.c */
+
+extern IdDataTable tuntap_socks;
 
 /* from hook.c */
 
diff --git a/hbytes/hook.c b/hbytes/hook.c
index a9d0316..b84306a 100644
--- a/hbytes/hook.c
+++ b/hbytes/hook.c
@@ -22,6 +22,13 @@ int posixerr(Tcl_Interp *ip, int errnoval, const char *m) {
   return TCL_ERROR;
 }
 
+int newfdposixerr(Tcl_Interp *ip, int fd, const char *m) {
+  int e;
+  e= errno;
+  close(fd);
+  return posixerr(ip,e,m);
+}
+
 void objfreeir(Tcl_Obj *o) {
   if (o->typePtr && o->typePtr->freeIntRepProc)
     o->typePtr->freeIntRepProc(o);
@@ -361,6 +368,12 @@ int do_toplevel_dgram_socket(ClientData cd, Tcl_Interp *ip,
   return subcmd->func(0,ip,objc,objv);
 }
 
+int do_toplevel_tuntap_socket(ClientData cd, Tcl_Interp *ip,
+			     const TunSocket_SubCommand *subcmd,
+			     int objc, Tcl_Obj *const *objv) {
+  return subcmd->func(0,ip,objc,objv);
+}
+
 int do_toplevel_ulong(ClientData cd, Tcl_Interp *ip,
 		      const ULong_SubCommand *subcmd,
 		      int objc, Tcl_Obj *const *objv) {
@@ -400,7 +413,7 @@ int Hbytes_Init(Tcl_Interp *ip) {
   Tcl_RegisterObjType(&enum_nearlytype);
   Tcl_RegisterObjType(&enum1_nearlytype);
   Tcl_RegisterObjType(&sockaddr_type);
-  Tcl_RegisterObjType(&dgramsockid_type);
+  Tcl_RegisterObjType(&tabledataid_nearlytype);
   Tcl_RegisterObjType(&ulong_type);
 
   for (cmd=toplevel_commands;
diff --git a/tuntap/tuntap.c b/tuntap/tuntap.c
new file mode 100644
index 0000000..a4d9f9a
--- /dev/null
+++ b/tuntap/tuntap.c
@@ -0,0 +1,276 @@
+/*
+ */
+/*
+ * tuntap-socket create-ptp <local-addr> <peer-addr> <mtu> [<ifname>]
+ *               => <sockid>
+ * tuntap-socket close <sockid>
+ * tuntap-socket ifname <sockid>
+ * tuntap-socket receive <sockid> <data>
+ * tuntap-socket on-transmit <sockid> [<script>]
+ *    calls, effectively,  eval <script> [list <data> <socket>]
+ *    if script not supplied, cancel
+ */
+
+#include "tables.h"
+#include "hbytes.h"
+
+typedef struct TunSocket {
+  int ix, fd, script_llength;
+  Tcl_Interp *ip;
+  Tcl_Obj *script;
+  void msg_buf;
+  int mtu;
+  char *ifname;
+} TuntapSocket;
+
+IdDataTable tuntap_socks= { "tuntap" };
+
+static int sockfail(Tcl_Interp *ip, int fd, const char *m) {
+  int e;
+  e= errno;
+  close(fd);
+  return posixerr(ip,e,m);
+}
+
+int do_tuntap_socket_create_ptp(ClientData cd, Tcl_Interp *ip,
+				SockAddr_Value local, SockAddr_Value peer,
+				long mtu, const char *ifname,
+				void **sock_r) {
+  int fd, local_al, peer_al, r;
+  struct ifreq ifr;
+  DgramSocket *sock;
+  const struct sockaddr *local_sa, *peer_sa;
+
+  local_sa= sockaddr_addr(&local);
+  local_al= sockaddr_len(&local);
+
+  peer_sa= sockaddr_addr(&peer);
+  peer_al= sockaddr_len(&peer);
+
+  if (local_sa != AF_INET || local_al != sizeof(struct in_addr) ||
+      peer_sa != AF_INET || peer_al != sizeof(struct in_addr))
+    return staticerr(ip,"tuntap not IPv4");
+
+  memset(&ifr,0,sizeof(ifr));
+  ifr.ifr_flags= IFF_TUN | IFF_NO_PI;
+  
+  if (ifname) {
+    if (strlen(ifname) > IFNAMSIZ-1)
+      return staticerr(ip,"tun interface name too long");
+    strcpy(ifr.ifr_name, ifname);
+  }
+
+  fd= open("/dev/net/tun", O_RDWR);
+  if (fd<0) return posixerr(ip,errno,"open /dev/net/tun");
+
+  r= ioctl(fd, TUNSETIFF, (void*)&ifr);
+  if (r) return posixerr(ip,errno,"ioctl TUNSETIFF");
+
+  
+
+  r= 
+  r= bind(fd, sa, al);  if (r) return sockfail(ip,fd,"bind");
+  r= setnonblock(fd, 1);  if (r) return sockfail(ip,fd,"setnonblock");
+
+  sock= TALLOC(sizeof(DgramSocket));
+  sock->ix= -1;
+  sock->fd= fd;
+  sock->script= 0;
+  sock->addr_buflen= al+1;
+  sock->addr_buf= TALLOC(sock->addr_buflen);
+  sock->msg_buflen= 0;
+  sock->msg_buf= 0;
+
+  *sock_r= sock;
+  return TCL_OK;
+}
+
+int do_tuntap_socket_transmit(ClientData cd, Tcl_Interp *ip,
+			     TuntapSocket *sock, HBytes_Value data,
+			     SockAddr_Value remote) {
+  int l, r;
+
+  r= sendto(sock->fd,
+	    hbytes_data(&data), l=hbytes_len(&data),
+	    0,
+	    sockaddr_addr(&remote), sockaddr_len(&remote));
+  if (r==-1) return posixerr(ip,errno,"sendto");
+  else if (r!=l) return staticerr(ip,"sendto gave wrong answer",0);
+  return TCL_OK;
+}
+
+static void cancel(TuntapSocket *sock) {
+  if (sock->script) {
+    Tcl_DeleteFileHandler(sock->fd);
+    Tcl_DecrRefCount(sock->script);
+    sock->script= 0;
+  }
+}
+
+static void recv_call(ClientData sock_cd, int mask) {
+  TuntapSocket *sock= (void*)sock_cd;
+  Tcl_Interp *ip= sock->ip;
+  int sz, rc, i, peek;
+  HBytes_Value message_val;
+  SockAddr_Value peer_val;
+  Tcl_Obj *args[3], *invoke;
+  struct msghdr mh;
+  struct iovec iov;
+
+  hbytes_empty(&message_val);
+  sockaddr_clear(&peer_val);
+  invoke=0; for (i=0; i<3; i++) args[i]=0;
+
+  mh.msg_iov= &iov;
+  mh.msg_iovlen= 1;
+  mh.msg_control= 0;
+  mh.msg_controllen= 0;
+  mh.msg_flags= 0;
+
+  peek= MSG_PEEK;
+  
+  for (;;) {
+    mh.msg_name= sock->addr_buf;
+    mh.msg_namelen= sock->addr_buflen;
+
+    iov.iov_base= sock->msg_buf;
+    iov.iov_len= sock->msg_buflen;
+
+    sz= recvmsg(sock->fd, &mh, peek);
+    if (sz==-1) { rc=0; goto x_rc; }
+
+    assert(mh.msg_namelen < sock->addr_buflen);
+
+    if (!(mh.msg_flags & MSG_TRUNC)) {
+      if (!peek) break;
+      peek= 0;
+      continue;
+    }
+
+    TFREE(sock->msg_buf);
+    sock->msg_buflen *= 2;
+    sock->msg_buflen += 100;
+    sock->msg_buf= TALLOC(sock->msg_buflen);
+  }
+
+  hbytes_array(&message_val, iov.iov_base, sz);
+  sockaddr_create(&peer_val, mh.msg_name, mh.msg_namelen);
+
+  args[0]= ret_hb(ip, message_val);  hbytes_empty(&message_val);
+  args[1]= ret_sockaddr(ip, peer_val);  sockaddr_clear(&peer_val);
+  args[2]= ret_sockid(ip, sock);
+  for (i=0; i<3; i++) Tcl_IncrRefCount(args[i]);
+
+  invoke= Tcl_DuplicateObj(sock->script);
+  Tcl_IncrRefCount(invoke);
+
+  rc= Tcl_ListObjReplace(ip,invoke,sock->script_llength,0,3,args);
+  for (i=0; i<3; i++) { Tcl_DecrRefCount(args[i]); args[i]= 0; }
+  if (rc) goto x_rc;
+
+  rc= Tcl_EvalObjEx(ip,invoke,TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT);
+
+x_rc:
+  if (invoke) Tcl_DecrRefCount(invoke);
+
+  if (rc)
+    Tcl_BackgroundError(ip);
+}
+
+int do_tuntap_socket_on_receive(ClientData cd, Tcl_Interp *ip,
+			       TuntapSocket *sock, Tcl_Obj *script) {
+  int rc;
+  
+  if (script) {
+    rc= Tcl_ListObjLength(ip, script, &sock->script_llength);
+    if (rc) return rc;
+  }
+  
+  cancel(sock);
+  if (script) {
+    Tcl_IncrRefCount(script);
+    sock->script= script;
+    sock->ip= ip;
+  }
+  Tcl_CreateFileHandler(sock->fd, TCL_READABLE, recv_call, sock);
+  return TCL_OK;
+}
+
+int do_tuntap_socket_close(ClientData cd, Tcl_Interp *ip, TuntapSocket *sock) {
+  int sockix;
+  cancel(sock);
+  close(sock->fd); /* nothing useful to be done with errors */
+  sockix= sock->ix;
+  TFREE(sock->addr_buf);
+  TFREE(sock->msg_buf);
+  TFREE(sock);
+  socks[sockix]= 0;
+  return TCL_OK;
+}
+
+/* Arg parsing */
+
+int pat_sockid(Tcl_Interp *ip, Tcl_Obj *o, TuntapSocket **val) {
+  int rc, sockix;
+  TuntapSocket *sock;
+  
+  rc= Tcl_ConvertToType(ip,o,&tuntapsockid_type);
+  if (rc) return rc;
+
+  sockix= o->internalRep.longValue;
+  if (sockix >= n_socks || !(sock= socks[sockix]))
+    return staticerr(ip,"tuntap socket not open",0);
+
+  assert(socks[sockix]->ix == sockix);
+
+  *val= sock;
+  return TCL_OK;
+}
+
+Tcl_Obj *ret_sockid(Tcl_Interp *ip, TuntapSocket *val) {
+  Tcl_Obj *o;
+
+  o= Tcl_NewObj();
+  Tcl_InvalidateStringRep(o);
+  o->internalRep.longValue= val->ix;
+  o->typePtr= &tuntapsockid_type;
+  return o;
+}
+
+static void sockid_t_free(Tcl_Obj *o) { }
+
+static void sockid_t_dup(Tcl_Obj *src, Tcl_Obj *dup) {
+  dup->internalRep= src->internalRep;
+  dup->typePtr= &tuntapsockid_type;
+}
+
+static void sockid_t_ustr(Tcl_Obj *o) {
+  char buf[75];
+
+  snprintf(buf,sizeof(buf), "%d", (int)o->internalRep.longValue);
+  obj_updatestr_vstringls(o,
+			  "tuntapsock",9,
+			  buf, strlen(buf),
+			  (char*)0);
+}
+
+static int sockid_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
+  unsigned long ul;
+  char *ep, *str;
+  
+  str= Tcl_GetStringFromObj(o,0);
+  if (memcmp(str,"tuntapsock",9)) return staticerr(ip,"bad tuntap socket id",0);
+  errno=0; ul=strtoul(str+9,&ep,10);
+  if (errno || *ep) return staticerr(ip,"bad tuntap socket id number",0);
+  if (ul > INT_MAX) return staticerr(ip,"out of range tuntap socket id",0);
+
+  objfreeir(o);
+  o->internalRep.longValue= ul;
+  o->typePtr= &tuntapsockid_type;
+  return TCL_OK;
+}
+
+Tcl_ObjType tuntapsockid_type = {
+  "tuntapsockid",
+  sockid_t_free, sockid_t_dup, sockid_t_ustr, sockid_t_sfa
+};
-- 
2.30.2