nabaztag_hack_kit 0.0.2

data/ext/bytecode/lib/dhcp.mtl

@@ -0,0 +1,152 @@
+// --------------- DHCP
+
+const DHCP_DISCOVER=1;;
+const DHCP_OFFER=2;;
+const DHCP_REQUEST=3;;
+const DHCP_DECLINE=4;;
+const DHCP_ACK=5;;
+
+fun mkdhcp op netip hostip newip =
+  let 236+16+14->n in
+  let strnew n -> b in
+  (
+    for i=0;i<n do strset b  i 0;
+    strcpy b 0 "\1\1\6" 0 3;
+    strcpy b 12 netip 0 4;
+    strcpy b 12+16 mymac 0 6;
+    strcpy b 236 "\99\130\83\99\53\1" 0 6;
+    strset b 236+6 op;
+    strcpy b 236+7 "\61\7\1" 0 3;
+    strcpy b 236+10 mymac 0 6;
+    strcpy b 236+16 "\12\7Pabcdef\55\3\1\3\6" 0 14;
+    if op==DHCP_REQUEST then strcatlist b::"\54\4"::hostip::"\50\4"::newip::"\255"::nil
+    else strcat b "\255"
+  );;
+
+fun mkdhcpans op tid newip dmac=
+  let 236+7->n in
+  let strnew n -> b in
+  (
+    for i=0;i<n do strset b  i 0;
+    strcpy b 0 "\2\1\6" 0 3;
+    strcpy b 4 tid 0 4;
+    strcpy b 16 newip 0 4;
+    strcpy b 12+16 dmac 0 6;
+    strcpy b 236 "\99\130\83\99\53\1" 0 6;
+    strset b 236+6 op;
+    strcatlist b::"\54\4"::newip::"\51\4\0\1\$51\$80\1\4"::netmask::"\3\4"::netip::"\6\4"::netip::"\15\4home\255"::nil
+  );;
+
+fun extractdhcp src i type lease submask dns gateway mac=
+  if i<strlen src then
+  let strget src i -> c in
+  if c==255 then [type lease submask dns gateway mac]
+  else let strget src i+1 -> len in
+  let i+2->i in
+  if c==53 then extractdhcp src i+len (strget src i) lease submask dns gateway mac
+  else if c==51 then extractdhcp src i+len type (strgetword src i) submask dns gateway mac
+  else if c==1 then extractdhcp src i+len type lease (strsub src i 4) dns gateway mac
+  else if c==6 then extractdhcp src i+len type lease submask (strsub src i 4) gateway mac
+  else if c==3 then extractdhcp src i+len type lease submask dns (strsub src i 4) mac
+  else if c==61 then extractdhcp src i+len type lease submask dns gateway (strsub src i+1 6)
+  else extractdhcp src i+len type lease submask dns gateway mac;;
+
+fun mkdhcpip mac=
+  let strnew 4 -> s in
+  (
+    strcpy s 0 netip 0 4;
+    strset s 3 ((strget mac 5)&0x7f)+100;
+    s
+  );;
+
+fun cbnetdhcp src macfrom hostip=
+  Secholn "<dhcp"; MACecho macfrom 0 1;
+  let strget src 0 -> x in
+  let MACecho (strsub src 28 6)0 1 -> mac in
+  if x==2 && !strcmp mac mymac then
+  (
+    let IPecho (strsub src 16 4) 0 1-> newip in
+    let extractdhcp src 240 0 nil nil nil nil nil->[type lease submask dns gateway _] in
+    if type==DHCP_OFFER then
+    (
+      Secholn ">>>>>>>>>>>>>>>OFFER";
+      udpsend netip 68 ipbroadcast 67 (mkdhcp DHCP_REQUEST netip hostip newip) macbroadcast;
+      nil
+    )
+    else if type==DHCP_ACK then
+    (
+      Secholn ">>>>>>>>>>>>>>>ACK";
+      Secho "server    ";IPecho hostip 0 1;
+      Secho "ip        ";IPecho set netip=newip 0 1;
+      Secho "type      ";Iecholn type;
+      Secho "leasetime ";Iecholn lease;
+      Secho "submask   ";IPecho set netmask=submask 0 1;
+      Secho "dns       ";IPecho set netdns=dns 0 1;
+      Secho "gateway   ";IPecho set netgateway=gateway 0 1;
+      nil
+    )
+  );;
+
+fun cbnetdhcp67 src macfrom hostip=
+  Secholn "<dhcp"; MACecho macfrom 0 1;
+  let strget src 0 -> x in
+  let MACecho (strsub src 28 6)0 1 -> mac in
+  if x==1 /*&& !strcmp mac mymac*/ then
+  (
+    let extractdhcp src 240 0 nil nil nil nil nil ->[type _ _ _ _ dmac] in
+    let strsub src 4 4 -> tid in
+    let mkdhcpip macfrom -> newip in
+    if type==DHCP_DISCOVER then
+    (
+      Secholn ">>>>>>>>>>>>>>>DISCOVER";
+//      dump src;
+      udpsend netip 67 ipbroadcast 68 (mkdhcpans DHCP_OFFER tid newip dmac) macbroadcast;
+      nil
+    )
+    else if type==DHCP_REQUEST then
+    (
+      Secholn ">>>>>>>>>>>>>>>REQUEST";
+//      dump src;
+      udpsend netip 67 ipbroadcast 68 (mkdhcpans DHCP_ACK tid newip dmac) macbroadcast;
+      nil
+    )
+
+  );;
+
+fun startdhcp=
+  udpsend netip 68 ipbroadcast 67 (mkdhcp DHCP_DISCOVER "\0\0\0\0" nil nil) macbroadcast;
+  regudp 68 #cbnetdhcp;
+  0;;
+
+fun startdhcpserver=
+  regudp 67 #cbnetdhcp67;
+  0;;
+
+// --------------- net HOOK debut
+
+fun net src mac=
+  Secho "n ";//MACecho mac 0 1;
+//  dump src;
+  let strget src 7 -> p in
+  (
+    if p==6 then cbnetarp src mac // ARP
+    else if p==0 then
+      let strget src 17 -> ip in
+      if ip==6 then cbnettcp src mac
+      else if ip==17 then cbnetudp src mac;
+    0
+  );
+  //buttoncheckevent;
+  0;;
+
+fun netstart=
+  netCb #net;
+  resetarp;
+  resettcp;
+  resetudp;
+  0;;
+
+fun nettime=
+  arptime;
+  tcptime;
+  0;;

data/ext/bytecode/lib/dns.mtl

@@ -0,0 +1,89 @@
+// --------------- DNS 
+fun parsequ s i= let strfind s i "\0" 0 nil -> j in  j+5;;
+
+fun parsequs s i n=  if n<=0 then i else parsequs s parsequ s i n-1;;
+
+fun skipname s i=
+  let strgetword s i -> x in
+  if (x&0xc000)==0xc000 then i+2
+  else (strfind s i "\0" 0 nil)+1;;
+
+fun parseans s i n=
+  if n<=0 then nil
+  else let skipname s i -> j in
+  let strgetword s j -> typ in
+  if typ==1 then
+    strcatlist (itoa strget s j+10)::"."::(itoa strget s j+11)::"."::
+    (itoa strget s j+12)::"."::(itoa strget s j+13)::nil
+  else parseans s (j+10+strgetword s j+8) n-1;;
+
+fun parsemsg s=
+  let strgetword s 0 -> id in
+  let strgetword s 2 -> code in
+  let strgetword s 4 -> nbqu in
+  let strgetword s 6 -> nbans in
+  if nbans==0 then nil
+  else let parsequs s 12 nbqu -> i in
+  parseans s i nbans;;
+
+fun filterdns src=
+  let strfind src 0 "." 0 nil ->i in
+  if i!=nil then
+    strcat
+      strcat ctoa i strsub src 0 i
+      filterdns strsub src i+1 nil
+  else strcat ctoa strlen src src;;
+
+fun question id dns=
+  strcatlist (itobin2 id)::"\$01\$00\$00\$01\$00\$00\$00\$00\$00\$00"::(filterdns dns)::"\$00\$00\$01\$00\$01"::nil;;
+
+var dnsid=0;;
+
+type Dns=[idD domainD reqD timeoutD cbD];;
+var ldnsreq;;
+var ldns;;
+
+fun dnsreq domain cb=
+  set dnsid=if dnsid==nil then time_ms else dnsid+1;
+  let listswitchstr ldns domain -> ip in
+  if ip!=nil then call cb[ip]
+  else let dump question dnsid domain -> tramedns in
+  (
+    udpsend netip DNSLOCAL netdns 53 tramedns nil;
+    set ldnsreq=[idD:dnsid domainD:domain reqD:tramedns timeoutD:time+5 cbD:cb]::ldnsreq;
+    nil
+  );
+  0;;
+
+fun selectbyid d v= d.idD==v;;
+
+fun cbnetdns msg mac ipfrom=
+  let strgetword msg 0 -> id in
+  let parsemsg msg -> ip in
+  let hd select ldnsreq id #selectbyid -> x in
+  if x!=nil then
+  (
+    set ldnsreq=listrem ldnsreq x;
+    if ip!=nil then set ldns=[x.domainD ip]::ldns;  // ### attention à la taille de la liste
+    call x.cbD [ip]
+  );
+  0;;
+
+fun filterdnsdead l=if l!=nil then let hd l-> d in if d.timeoutD==nil then filterdnsdead tl l else (hd l)::filterdnsdead tl l;;
+
+fun dnstime=
+  for l=ldnsreq;l!=nil;tl l do let hd l-> d in
+  if time-d.timeoutD>=0 then
+  (
+    set d.timeoutD=nil;
+    call d.cbD [nil]
+  );
+  set ldnsreq=filterdnsdead ldnsreq;
+  0;;
+
+
+fun startdnsclient=
+  regudp DNSLOCAL #cbnetdns;
+  set ldnsreq=nil;
+  set ldns=nil;
+  0;;

data/ext/bytecode/lib/http.mtl

@@ -0,0 +1,84 @@
+//------------------- HTTP
+
+//where to put this
+fun isip s i=
+	if i>=strlen s then 1
+	else let strget s i -> c in
+	if (c<'0' || c>'9')&&c!='.' then 0
+	else isip s i+1;;
+
+
+fun cuturl url=
+  if !strcmp (strsub url 0 strlen http_prefurl) http_prefurl then cuturl strsub url strlen http_prefurl strlen url
+  else let strstr url "/" 0 -> i in
+    let if i==nil then url else strsub url 0 i -> addr in
+    let strstr addr ":" 0 -> j in
+    let if j==nil then [addr 80]
+      else [strsub addr 0 j atoi strsub addr j+1 strlen addr] -> [host port] in
+    let if i==nil then "/" else strsub url i strlen url -> path in
+    [host port path];;
+
+fun httpsendreq ip x=
+ 	Secho "found ip>>>>>>>>>>>>>>>>>>>>>>>>>"; Secholn ip;
+ 	let x->[port httpreq] in
+ 	if ip==nil then (call httpreq.cbH [httpreq nil]; nil)
+ 	else
+ 	(
+ 		set httpreq.cnxH=opentcp netip nil useparamip ip port fixarg4 #tcpevent httpreq;
+ 		set httpreq.stateH=HTTP_REACH;
+ 		nil
+ 	);
+ 	0;;
+
+fun httprequest verb url postdata cb type=
+  let cuturl url ->[host port path] in
+  //let if confGetProxy then strcatlist "http://"::host::":"::(itoa port)::path::nil else path -> path in //Icy-MetaData:1\13\n
+  //let if confGetProxy then webip confGetProxyip else host -> host in
+  //let if confGetProxy then confGetProxyport else port -> port in
+
+  let strcatlist verb::" "::path::" HTTP/1.0\13\nUser-Agent: MTL\13\nPragma: no-cache\13\nIcy-MetaData:1\13\nHost: "::host::"\13\n"::
+      if postdata==nil then "\13\n"::nil
+      else "Content-length: "::(itoa strlen postdata)::"\13\n\13\n"::postdata::nil
+    -> request in  // création de la chaîne requête
+
+  let [outputH:request indexH:0 cbH:cb typeH:type stateH:HTTP_SOLVE aliveH:time_ms] -> httpreq in  // création de la structure requête
+  (
+//    Secho "HTTPREQUEST host =";Secholn host;
+    if isip host 0 then httpsendreq host [port httpreq]
+    else
+    (
+      dnsreq host fixarg2 #httpsendreq [port httpreq];
+      nil
+    );
+    httpreq  // on retourne la structure requête pour pouvoir éventuellement l'interrompre en cours de route
+  );;
+
+
+var http_sep="\13\n\13\n";;  // séparateur entre l'en-tête et le corps de la réponse à une requête
+
+
+//##> retourne le header d'une réponse à une requête
+fun httpgetheader res =
+  let strstr res http_sep 0 -> i in
+  if i==nil then res
+  else strsub res 0 i+strlen http_sep;;
+
+//##> retourne le contenu d'une réponse à une requête (sans header)
+fun httpgetcontent res =
+  let strstr res http_sep 0 -> i in
+  if i==nil then nil
+  else strsub res i+strlen http_sep strlen res;;
+
+// Cryptage des trames
+fun bintoi3 s x=((strget s x)<<16)+((strget s x+1)<<8)+(strget s x+2);;
+
+fun pingextract_ s i res=
+  if i<strlen s then
+  let (strget s i)-> code in
+  if code==255 then res
+  else if code>=0 && code<=10 then
+    let bintoi3 s i+1 -> len in
+    if len>=0 then pingextract_ s i+4+len [code strsub s i+4 len]::res;;
+
+fun pingextract s=
+  if (strget s 0)==0x7f then pingextract_ s 1 nil;;

data/ext/bytecode/lib/tcp.mtl

@@ -0,0 +1,340 @@
+// ------------- TCP
+const TFIN=0x01;;
+const TSYN=0x02;;
+const TRST=0x04;;
+const TPUSH=0x08;;
+const TACK=0x10;;
+const TURGE=0x20;;
+
+const STOFF=-1;;
+const STSYN=0;;
+const STEST=1;;
+const STLISTEN=2;;
+const STFIN=3;;
+
+const CLIENT_SEQ_START="\0\0\1\0";;
+const CLIENT_SEQ_NULL="\0\0\0\0";;
+
+const TCPWRITE=0;;
+const TCPREAD=1;;
+const TCPCLOSE=-1;;
+const TCPSTART=2;;
+
+const TCPMAX=1024;;
+
+type Tcp=[stateT locT dstT locpT dstpT seqT ackT cbT macT lastsentT retryT locksendT enableT];;
+
+fun mktcp_ ipsrc ipdst portsrc portdst seq ack flag content=
+  let strcatlist
+  "\$aa\$aa\$03\$00\$00\$00\$08\$00\$45\$00\$00\$00\$00\$00\$00\$00\100\6\0\0"::
+  ipsrc::
+  ipdst::
+  "\0\0\0\0"::
+  seq::
+  ack::
+  "\0\0\$ff\$ff\0\0\0\0"::
+  if flag&TSYN then "\2\4\5\$b4"::content::nil  // 5.b4 final : taille MSS
+  else content::nil
+  -> tcp in
+  let strlen tcp ->len in
+  (
+    strputword tcp 8+2 len-8;
+    strputword tcp 8+20 portsrc;
+    strputword tcp 8+22 portdst;
+
+    strset tcp 8+32 4*if flag&TSYN then 24 else 20;
+    strset tcp 8+33 flag;
+
+    strputchk tcp 8+10 netChk tcp 8 20 0;
+
+    let strnew 2 -> s in
+    (
+      strputword s 0 len-28;
+      strputchk tcp 8+36
+       netChk tcp 8+20 (len-28) netChk s 0 2 netChk "\0\6" 0 nil netChk tcp 8+12 8 0
+    );
+    tcp
+  );;
+
+fun mktcp t flag content=
+//  Secholn "mktcp "; Secho "seq "; SEQecho t.seqT 0 1; Secho "ack "; SEQecho t.ackT 0 1;
+  mktcp_ t.locT t.dstT t.locpT t.dstpT t.seqT t.ackT flag content;;
+
+fun resendtcp t=
+  netSend t.lastsentT 0 nil (/*MACecho*/ t.macT /*0 1*/) 0 1;
+  0;;
+
+fun headerlen src=((strget src 8+32)>>4)<<2;;
+
+fun datalength src=(strgetword src 10)-20-headerlen src;;
+
+fun sendtcp t trame=
+//  Secholn "tcpSend"; dump trame;
+  netSend trame 0 nil (/*MACecho*/ t.macT /*0 1*/) 0 1;
+  let strget trame 8+33 -> flag in
+  set t.seqT=netSeqAdd t.seqT (datalength trame)+(if flag&(TSYN|TFIN) then 1 else 0);
+  0;;
+
+fun sendtcpforretry t trame=
+  set t.lastsentT=trame;
+  set t.retryT=nil;
+  sendtcp t trame;;
+
+
+fun tcpSend2 mac tcp trame=
+  set tcp.macT=mac;
+  sendtcpforretry/*sendtcp*/ tcp trame;;
+
+// List of all current tcp requests
+var ltcp;;
+
+
+fun remtcp t=set t.stateT=STOFF; set ltcp=remfromlist ltcp t;;
+
+var counttcp;;
+
+fun opentcp local localp dst dstp cb=
+  let if localp==nil then 1024+set counttcp=((if counttcp==nil then time_ms else counttcp)+1)&16383 else localp -> localp in
+  let [stateT:STSYN locT:local dstT:dst locpT:localp dstpT:dstp seqT:CLIENT_SEQ_START ackT:CLIENT_SEQ_NULL cbT:cb enableT:1] -> tcp in
+  let mktcp tcp TSYN nil -> trame in
+  let dst -> ip in  //  ajouter le test de passerelle
+  (
+    set ltcp=tcp::ltcp;
+    arpreq ip fixarg2 fixarg3 #tcpSend2 trame tcp;
+    tcp
+  );;
+
+fun listentcp localp cb=
+  let [stateT:STLISTEN locpT:localp cbT:cb enableT:1] -> tcp in
+  (
+    set ltcp=tcp::ltcp
+  );;
+
+fun findtcp l localp dstp src=
+  if l!=nil then let hd l-> t in
+  if t.locpT==localp && t.dstpT==dstp && (!vstrcmp src 8+16 t.locT 0 4)&& (!vstrcmp src 8+12 t.dstT 0 4)
+  then t
+  else if t.stateT==STLISTEN && t.locpT==localp then t
+  else findtcp tl l localp dstp src;;
+
+fun sendclose t=
+  Secholn "## sendclose";
+  sendtcp t mktcp t TFIN+TACK nil;
+  set t.stateT=STFIN;
+  0;;
+
+fun cbnettcp src mac=
+  Secho "t";
+  let /*Iecholn*/ strgetword src 8+20+2 -> locp in
+  let /*Iecholn*/ strgetword src 8+20+0 -> dstp in
+  let findtcp ltcp locp dstp src -> t in
+  if t!=nil && t.enableT then let t.stateT -> st in
+    let /*Iecholn*/ strget src 8+33 -> flag in
+    let /*SEQecho*/ (strsub src 8+24 4) /*0 1*/-> rseq in
+    let /*SEQecho*/ (strsub src 8+28 4) /*0 1*/-> rack in
+    if st==STSYN then
+    (
+      Secholn "stsyn";
+      if (flag==TSYN+TACK) && !vstrcmp (SEQecho(t.seqT)0 1) 0 rack 0 4 then
+      (
+        set t.ackT=SEQecho (netSeqAdd rseq 1) 0 1;
+        sendtcp t mktcp t TACK nil;
+        set t.stateT=STEST;
+        set t.lastsentT=nil;
+//        Secholn "call TCPWRITE";
+        call t.cbT [t TCPWRITE nil]
+      )
+      else
+      (
+//        Secholn "TSRT+TACK";
+        sendtcp t mktcp t TRST+TACK nil;
+        remtcp t;
+        nil
+      )
+    )
+    else if st==STEST then
+      if !vstrcmp t.ackT 0 rseq 0 4 then
+      let strgetword src 10 -> iplen in
+      let ((strget src 8+32)>>4)<<2 -> tcplen in
+      let datalength src -> datalen in
+      (
+        if datalen then
+        (
+  //        dump src;
+  //        Iecholn iplen;
+  //        Iecholn tcplen;
+//          Secho "update ackT : add ";
+          set t.ackT=netSeqAdd t.ackT datalen
+        );
+        if flag&TFIN then
+        (
+          set t.ackT=netSeqAdd t.ackT 1;
+          nil
+        )
+        else if !vstrcmp t.seqT 0 rack 0 4 then
+        (
+//          Secholn "acquittement de l'envoi";
+          set t.lastsentT=nil;  // acquittement de l'envoi
+          if t.locksendT==1 then
+          (
+            set t.locksendT=0;
+            call t.cbT [t TCPWRITE nil]
+          )
+          else if t.locksendT==2 then
+          (
+            sendclose t;
+            nil
+          )
+        )
+        else (Secholn "##bad ack"; SEQecho t.seqT 0 1;SEQecho rack 0 1; nil);
+        if datalen then
+          let 8+20+headerlen src -> start in
+          let strsub src start datalen -> data in
+          call t.cbT [t TCPREAD data];
+        if datalen || flag&TFIN then sendtcp t mktcp t TACK nil;
+        if flag&TFIN then
+        (
+          sendtcp t mktcp t TFIN+TACK nil;
+          remtcp t;
+          call t.cbT [t TCPCLOSE nil]
+        )
+      )
+      else (/*SEQecho(t.ackT)0 1; SEQecho rseq 0 1;*/Secho "##bs/";sendtcp t mktcp t TACK nil; nil)
+    else if st==STFIN then
+      (
+        Secholn "STFIN";
+        set t.ackT=SEQecho (netSeqAdd rseq 1) 0 1;
+        sendtcp t mktcp t TACK nil;
+        remtcp t;
+        nil
+      )
+    else if st==STLISTEN then
+      if flag&TSYN then
+      (
+        let [stateT:STEST locT:(strsub src 8+16 4) dstT:(strsub src 8+12 4) locpT:locp dstpT:dstp
+        seqT:CLIENT_SEQ_START ackT:(netSeqAdd rseq 1) cbT:t.cbT macT:mac  enableT:1] -> tcp in
+        (
+          set ltcp=tcp::ltcp;
+          sendtcpforretry tcp mktcp tcp TACK+TSYN nil;
+          call tcp.cbT [tcp TCPSTART nil]
+        )
+      )
+  ;;
+
+
+fun writetcp t msg i=
+  if t.stateT!=STEST then nil
+  else if t.lastsentT!=nil then
+  (
+//    Secholn "locksend";
+    set t.locksendT=1;
+    i
+  )
+  else let strsub msg i TCPMAX -> content in
+  let mktcp t TACK content -> trame in
+  (
+    sendtcpforretry t trame;
+    let i+strlen content -> ni in
+    (
+      if ni!=strlen msg then set t.locksendT=1;
+      ni
+    )
+  );;
+
+
+fun closetcp t=
+  if t.stateT!=STEST then 0
+  else if t.lastsentT!=nil then
+  (
+    set t.locksendT=2;
+    0
+  )
+  else sendclose t;
+  0;;
+
+fun tcpcb t cb= set t.cbT=cb;;
+
+fun enabletcp t v= set t.enableT=v;;
+fun enabledtcpP t= t.enableT;;
+
+fun tcptime =
+  for l=ltcp;l!=nil;tl l do let hd l-> t in
+  if t.lastsentT!=nil then
+  (
+    if t.retryT!=nil then
+    (
+      set t.retryT=1+t.retryT;
+      if t.retryT>10 then
+      (
+        remtcp t;
+        call t.cbT [t TCPCLOSE nil];
+        nil
+      )
+      else resendtcp t
+    )
+    else set t.retryT=0
+  );
+  0;;
+
+fun resettcp=
+  set ltcp=nil;
+  0;;
+
+
+fun tcpread cnx input httpreq=
+  if input==nil ||0==strlen input then  // erreur ou fin
+  (  closetcp cnx;  // on ferme la socket
+    if httpreq.typeH==HTTP_NORMAL then call httpreq.cbH [httpreq strcatlist rev httpreq.inputH nil]  // on retourne ce qui a été reçu
+    else call httpreq.cbH [httpreq nil] // HTTP_STREAM or HTTP_DIRECT
+  )
+  else
+  (
+//    dump input;
+    set lasthttpevent=time;
+    set httpreq.aliveH=time_ms;
+    if httpreq.typeH==HTTP_NORMAL then set httpreq.inputH=input::httpreq.inputH  // on bufferise ce qui a été reçu
+    else if httpreq.typeH==HTTP_DIRECT then
+    (
+      call httpreq.cbH [httpreq input];
+      nil
+    )
+    else let strcat hd httpreq.inputH input -> s in
+    let strstr s "\13\10\13\10" 0 -> i in
+    if i==nil then
+    (
+      set httpreq.inputH=s::nil
+    )
+    else
+    (
+      set httpreq.inputH=nil;
+      set httpreq.typeH=HTTP_DIRECT;
+      call httpreq.cbH [httpreq strsub s 0 i];
+      if i+4<strlen s then call httpreq.cbH [httpreq strsub s i+4 nil];
+      nil
+    );
+    nil
+  );;
+
+
+fun tcpwrite cnx httpreq=
+  set httpreq.stateH=HTTP_CONNECTED;
+  set httpreq.aliveH=time_ms;
+  if httpreq.outputH!=nil then  // s'il y a des choses à envoyer (notamment la première fois)
+  (
+    set httpreq.indexH=writetcp cnx httpreq.outputH httpreq.indexH;  // envoyer ce qui peut l'être
+    if httpreq.indexH==nil then  // si erreur lors de l'envoi
+    (  closetcp cnx;  // on ferme la socket
+      call httpreq.cbH [httpreq nil]  )  // on retourne nil
+    else if httpreq.indexH>=strlen httpreq.outputH then  // sinon si tout a été envoyé
+    (  set httpreq.indexH=nil;  // purger les données d'émission
+      set httpreq.outputH=nil;
+      nil
+    )
+  );;
+
+
+fun tcpevent t val msg sock=
+  if val==TCPWRITE then tcpwrite t sock
+  else if val==TCPCLOSE then tcpread t nil sock
+  else tcpread t msg sock;
+  0;;

data/ext/bytecode/lib/udp.mtl

@@ -0,0 +1,49 @@
+// ------------- UDP
+
+fun mkudp ipsrc ipdst portsrc portdst content=
+  let strcatlist
+  "\$aa\$aa\$03\$00\$00\$00\$08\$00\$45\$00\$00\$00\$00\$00\$00\$00\100\17\0\0"::
+  ipsrc::
+  ipdst::
+  "\0\0\0\0\0\0\0\0"::
+  content::
+  nil -> udp in
+  (
+    strputword udp 8+2 28+strlen content;
+    strputword udp 8+20 portsrc;
+    strputword udp 8+22 portdst;
+    strputword udp 8+24 8+strlen content;
+    strputchk udp 8+10 netChk udp 8 20 0;
+    strputchk udp 8+26 netChk udp 8+20 (8+strlen content) netChk udp 8+24 2 netChk "\0\17" 0 nil netChk udp 8+12 8 0;
+    udp
+  );;
+
+fun udpSend2 mac udp=
+  Secho ">u";
+//  dump udp;
+  netSend udp 0 nil (/*MACecho*/ mac /*0 1*/) 0 1;;
+
+fun udpsend local localp dst dstp content mac=
+  let mkudp local dst localp dstp content -> udp in
+  if mac!=nil then udpSend2 mac udp
+  else let dst -> ip in  //  ajouter le test de passerelle
+  arpreq ip fixarg2 #udpSend2 udp;;
+
+var ludp;;
+
+fun remudp l port=
+  if l!=nil then let hd l ->[p _] in if p==port then remudp tl l port else (hd l)::remudp tl l port;;
+
+fun regudp port cb=
+  set ludp=[port cb]::remudp ludp port;;
+
+fun unregudp port=
+  set ludp=remudp ludp port;;
+
+fun resetudp= set ludp=nil;;
+
+fun cbnetudp src mac=
+  Secho "<u";
+  let Iecholn strgetword src 8+20+2 -> locp in
+  let listswitch ludp locp -> cb in
+  call cb [strsub src 8+20+8 nil mac strsub src 20 4];;