forked from RedoXyde/mtl_linux
-
Notifications
You must be signed in to change notification settings - Fork 1
/
nominal.mtl
3959 lines (3490 loc) · 128 KB
/
nominal.mtl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
// VLISP - Feb 06 - by Sylvain Huet
// Metal
proto main 0;;
//var SIMU;;
var NOMINAL;;
var AUDIOLIB;;
ifdef NOMINAL
{
var AUDIOLIB;;
var EARSLIB;;
var INFOLIB;;
var RECLIB;;
}
ifdef SIMU
{
var HARDWARE=4;;
var DNSLOCAL=999;;
}
else
{
var HARDWARE=4;;
var DNSLOCAL=1597;;
}
proto buttoncheckevent 0;;
type Wifi=initW | gomasterW | masterW | gostationW _ | dhcpW _| stationW | reconnectW;;
var wifi;;
var netip="\0\0\0\0";;
var netmask="\255\255\255\0";;
var netgateway="\0\0\0\0";;
var netdns="\0\0\0\0";;
var mymac;;
var macbroadcast="\$ff\$ff\$ff\$ff\$ff\$ff";;
var ipbroadcast="\$ff\$ff\$ff\$ff";;
var master=0;;
var netip_empty="\0\0\0\0";;
var netip_master="\192\168\2\1";;
var netmask_master="\255\255\255\0";;
var netgateway_master="\192\168\0\1";;
var wifiscans;;
var IEEE80211_CRYPT_NONE=0;;
var IEEE80211_CRYPT_WEP64=1;;
var IEEE80211_CRYPT_WEP128=2;;
var IEEE80211_CRYPT_WPA=3;;
var IEEE80211_CRYPT_WPA_UNSUPPORTED=4;;
var IEEE80211_AUTH_OPEN=0;;
var IEEE80211_AUTH_SHARED=1;;
var FIRMWARE=0x01010f;;
// --------------- UTIL debut
//fun strcmp a b = vstrcmp a 0 b 0 nil;;
fun strstr s p i=strfind s i p 0 nil;;
fun itoanil l=if l==nil then '0'::nil else l;;
fun listlen l=if l==nil then 0 else 1+listlen tl l;;
fun listrem l x=if l!=nil then if x==hd l then tl l else (hd l)::listrem tl l x;;
fun slistlen l= if l==nil then 0 else (strlen hd l)+slistlen tl l;;
fun listnth l i=if !i then hd l else if i>0 then listnth tl l i-1;;
fun listtostr l=
let strnew listlen l -> s in
let 0->i in
(
for p=l;p!=nil;tl p do
(
strset s i hd p;
set i=i+1
);
s
);;
fun atoibin2 val=itobin2 atoi val;;
fun countpattern s p i=
let strstr s p i -> j in
if j==nil then 0
else 1+countpattern s p j+strlen p;;
fun strreplace2 sn s p v i id=
if i<strlen s then
let strstr s p i -> j in
let if j==nil then strlen s else j -> k in
(
strcpy sn id s i k-i;
if j!=nil then strcpy sn id+k-i v 0 nil;
strreplace2 sn s p v k+strlen p id+k-i+strlen v
);;
fun strreplace s p v=
let countpattern s p 0 -> i in
if !i then s
else let strnew (strlen s) + ((strlen v)-(strlen p))*i -> sn in
(
strreplace2 sn s p v 0 0;
sn
);;
fun rev p q=if p==nil then q else rev tl p (hd p)::q;;
fun remfromlist l t= if l!=nil then if t==hd l then tl l else (hd l)::remfromlist tl l t;;
fun insert x l f=
if l==nil then x::nil
else let call f [x hd l] -> r in
if r>0 then (hd l)::insert x tl l f
else if r<0 then x::l
else insert x tl l f;;
fun sort l f= if l!=nil then insert hd l sort tl l f f;;
fun select l a f= if l!=nil then let hd l-> x in if call f [x a] then x::select tl l a f else select tl l a f;;
fun conc p q=if p==nil then q else (hd p)::conc tl p q;;
fun _useparamip s i val j=
if i<4 then
let strstr val "." j -> k in
(
strset s i atoi strsub val j if k==nil then nil else k-j;
_useparamip s i+1 val if k==nil then strlen val else k+1
);;
fun useparamip val=
let strnew 4 -> ip in
(
_useparamip ip 0 val 0;
ip
);;
fun webip ip=
strcatlist (itoa strget ip 0)::"."::(itoa strget ip 1)::"."::(itoa strget ip 2)::"."::(itoa strget ip 3)::nil;;
fun _webmac key i=
if i<strlen key then (ctoh strget key i)::if i+1<strlen key then ":"::_webmac key i+1 else _webmac key i+1;;
fun webmac key=strcatlist _webmac key 0;;
proto setleds 1;;
// ---------------- UTIL fin
fun MACecho src i0 ln=
for i=0;i<6 do (Secho ctoh strget src i0+i; Secho "."); if ln then Secholn "";
src;;
fun SEQecho src i0 ln=
for i=0;i<4 do (Secho ctoh strget src i0+i; Secho "."); if ln then Secholn "";
src;;
fun IPecho src i0 ln=
for i=0;i<4 do (Iecho strget src i0+i; Secho ".");if ln then Secholn "";
src;;
fun itoh4 i = strcatlist (ctoh i>>24)::(ctoh i>>16)::(ctoh i>>8)::(ctoh i)::nil;;
fun dump s=
for i0=0;i0<strlen s;i0+16 do
(
Secho itoh4 i0;
Secho " ";
for i=0;i<16 do let strget s i0+i -> c in
(
Secho if c==nil then " " else ctoh c;
Secho " "
);
Secho " ";
for i=0;i<16 do let strget s i0+i -> c in
(
Secho if c==nil then " " else if c<32 then "." else ctoa c
);
Secholn ""
);
s;;
fun dumpscan l0=
Secholn "## DUMPSCAN >>>>";
for l=l0;l!=nil;tl l do
let hd l->[ssid mac bssid rssi channel rateset encryption] in
(
Secho "## SCAN "; Secholn ssid;
Secho "mac:"; MACecho mac 0 1;
Secho "bssid:"; MACecho bssid 0 1;
Secho "rssi:"; Iecholn rssi;
Secho "channel:"; Iecholn channel;
Secho "rateset:"; Iecholn rateset;
Secho "encryption:"; Iecholn encryption
);
l0;;
// ------------- Config debut
var CONF_SERVERURL=0;; //41
var CONF_NETDHCP=41;; //1
var CONF_NETIP=42;; //4
var CONF_NETMASK=46;; //4
var CONF_NETGATEWAY=50;; //4
var CONF_NETDNS=54;; //4
var CONF_WIFISSID=58;; //32
var CONF_WIFIAUTH=90;; //1
var CONF_WIFICRYPT=91;; //1
var CONF_WIFIKEY0=92;; //64
var CONF_PROXYENABLE=156;; //1
var CONF_PROXYIP=157;; //4
var CONF_PROXYPORT=161;; //2
var CONF_LOGIN=163;; //6
var CONF_PWD=169;; //6
var CONF_WIFIPMK=175;; //32
var CONF_MAGIC=207;; //1
var CONF_LENGTH=208;;
var conf;;
/*
var conf0=
"r.nabaztag.com/vl\0-----------------------\
\1\0\0\0\0\255\255\255\0\0\0\0\0\0\0\0\0\
\0-------------------------------\
\0\0abcde\0----------------------------------------------------------\
\0\0\0\0\0\0\0\
\0\0\0\0\0\0\
\0\0\0\0\0\0\
--------------------------------\
\$48";;
*/
fun confSave=
Secholn "## save configuration";
dump conf;
save conf 0 "conf.bin" 0 CONF_LENGTH;;
fun confInit=
set conf=strnew CONF_LENGTH;
load conf 0 "conf.bin" 0 CONF_LENGTH;
/* if (strget conf CONF_MAGIC)!=0x48 then
(
set conf=strnew CONF_LENGTH;
strcpy conf 0 conf0 0 nil;
confSave;
set conf=strnew CONF_LENGTH;
load conf 0 "conf.bin" 0 CONF_LENGTH
);
*/ dump conf;;
fun confGet i len= strsub conf i len;;
fun confGetbin i len= strsub conf i len;;
fun confGetstr i len=
let strstr conf "\0" i -> j in
strsub conf i (if j==nil then len else min len j-i);;
fun confSet i val len=
strcpy conf i val 0 len;;
fun confSetbin i val len=strcpy conf i val 0 len;;
fun confSetstr i val len=
let min strlen val len-1 -> len in
(
strcpy conf i val 0 len;
strset conf i+len 0
);;
fun webport s= ((strget s 0)<<8)+strget s 1;;
fun confGetWifissid=confGetstr CONF_WIFISSID 32;;
fun confGetWificrypt=strget confGet CONF_WIFICRYPT 1 0;;
fun confGetWifikey0=confGetstr CONF_WIFIKEY0 64;;
fun confGetWifiauth=strget confGet CONF_WIFIAUTH 1 0;;
fun confGetWifipmk=confGetbin CONF_WIFIPMK 32;;
fun confGetDhcp=strget confGet CONF_NETDHCP 1 0;;
fun confGetNetip=confGet CONF_NETIP 4;;
fun confGetNetmask=confGet CONF_NETMASK 4;;
fun confGetNetgateway=confGet CONF_NETGATEWAY 4;;
fun confGetNetdns=confGet CONF_NETDNS 4;;
fun confGetServerUrl=confGetstr CONF_SERVERURL 40;;
fun confGetLogin=confGet CONF_LOGIN 6;;
fun confGetPwd=confGet CONF_PWD 6;;
fun confGetProxy=strget confGet CONF_PROXYENABLE 1 0;;
fun confGetProxyip=confGet CONF_PROXYIP 4;;
fun confGetProxyport=webport confGet CONF_PROXYPORT 2;;
// ------------- Config fin
ifndef SIMU
{
// ------------- IP debut
fun strputchk s i w=
strset s i ~(w>>8);
strset s i+1 ~w;
0;;
// ------------- IP fin
// ------------- ARP debut
var ARPREQ=1;;
var ARPANS=2;;
var larp;;
var larpreq;;
fun mkarp op ipsrc macdst ipdst=
strcatlist
"\$aa\$aa\$03\$00\$00\$00\$08\$06\$00\$01\$08\$00\$06\$04\$00"::(ctoa op)::
mymac::
netip::
macdst::
ipdst
::nil;;
fun sendarp ip=
netSend (mkarp ARPREQ netip macbroadcast ip) 0 nil macbroadcast 0 1;;
fun filterarpip l src =
if l!=nil then let hd l->[ip _ _] in if !vstrcmp src 8+14 ip 0 4 then filterarpip tl l src
else (hd l)::filterarpip tl l src;;
fun checkarp l src=
if l!=nil then let hd l->[ip _ cb] in
(
if !vstrcmp src 8+14 ip 0 4 then
let strsub src 8+8 6 -> mac in
(
Secho "found MAC target : "; MACecho mac 0 1;
set larp=[ip mac]::larp;
call cb [mac]
);
checkarp tl l src
);;
fun cbnetarp src mac=
Secho "<a";
let strget src 8+7-> op in
if op==1 then // req
(
// Secho "ask ";MACecho src 16+10 1; IPecho src 16+16 1;
if !vstrcmp src 32 netip 0 4 then
netSend (mkarp ARPANS netip strsub src 16 6 strsub src 22 4) 0 nil mac 0 1;
nil
)
else if op==2 then
let larpreq->l in
(
set larpreq=filterarpip larpreq src;
checkarp l src
);;
fun subnet_ ip i=
if i<0 then 1
else if ((strget ip i)^(strget netip i))&(strget netmask i) then 0
else subnet_ ip i-1;;
fun subnet ip=
Secho "test subnet "; IPecho ip 0 1;
Iecholn subnet_ ip 3;;
fun arpreq ip cb=
let IPecho (if subnet ip then ip else netgateway) 0 1 -> ip in
let listswitchstr larp ip -> mac in
if mac!=nil then call cb [mac]
else
(
sendarp ip;
set larpreq=[ip time cb]::larpreq; // ### attention à la taille de la liste
0
);;
fun filterarp l dt =
if l!=nil then let hd l->[ip t _] in if (time-t)>dt then filterarp tl l dt
else
(
sendarp ip;
(hd l)::filterarp tl l dt
);;
fun arptime =
set larpreq=filterarp larpreq 10;;
fun resetarp=
set larp=nil;
set larpreq=nil;
0;;
// ------------- ARP fin
// ------------- UDP debut
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];;
// -------------- UDP fin
// ------------- TCP debut
var TFIN=0x01;;
var TSYN=0x02;;
var TRST=0x04;;
var TPUSH=0x08;;
var TACK=0x10;;
var TURGE=0x20;;
var STOFF=-1;;
var STSYN=0;;
var STEST=1;;
var STLISTEN=2;;
var STFIN=3;;
var CLIENT_SEQ_START="\0\0\1\0";;
var CLIENT_SEQ_NULL="\0\0\0\0";;
var TCPWRITE=0;;
var TCPREAD=1;;
var TCPCLOSE=-1;;
var TCPSTART=2;;
var 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;;
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 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;;
// -------------- TDP fin
// --------------- DHCP debut
var DHCP_DISCOVER=1;;
var DHCP_OFFER=2;;
var DHCP_REQUEST=3;;
var DHCP_DECLINE=4;;
var 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;;
// --------------- DHCP fin
// --------------- 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;;
// --------------- net HOOK fin
}
else
{
// --------------- TCP/UDP EMULATION debut
var TCPWRITE=0;;
var TCPREAD=1;;
var TCPCLOSE=-1;;
var TCPSTART=2;;
fun udpsend local localp dst dstp content mac=
udpSend localp dst dstp content 0 nil;;
var ludp;;
fun regudp port cb=
set ludp=[udpStart port cb]::ludp;;
fun resetudp=set ludp=nil;;
fun netudp t src ip=
let listswitch ludp t -> cb in
call cb [src nil ip];;
var ltcp;;
fun writetcp t msg i=
tcpSend t msg i nil;;
fun remtcp l t= if l!=nil then let hd l->[tt _] in if t==tt then tl l
else (hd l)::remtcp tl l t;;
fun updatetcp l t cb= if l!=nil then let hd l->[tt _] in if t==tt then [t cb]::tl l
else (hd l)::updatetcp tl l t cb;;
fun closetcp t=
set ltcp=remtcp ltcp t;
tcpClose t;;
fun tcpcb t cb=
set ltcp=updatetcp ltcp t cb;
cb;;
fun listentcp port cb=
set ltcp=[tcpListen port cb]::ltcp;;
fun opentcp local localp dst dstp cb=
// Secholn "opentcp";IPecho dst 0 0; Secho ":"; Iecholn dstp;
let tcpOpen dst dstp -> t in
if t!=nil then
(
set ltcp=[t cb]::ltcp;
t
);;
fun enabletcp t v=
tcpEnable t v;;
fun nettcp t val msg=
if val==TCPSTART then
let listswitch ltcp atoi msg -> cb in
(
if cb==nil then Secholn "callback is nil"
else Secholn "callback is not nil";
set ltcp=[t cb]::ltcp;
call cb [t val msg]
)
else let listswitch ltcp t -> cb in
call cb [t val msg];;
fun startdhcp=0;;
fun startdhcpserver=0;;
fun nettime=0;;
fun netstart=
tcpCb #nettcp;
udpCb #netudp;
set ltcp=nil;
set ludp=nil;
// set wifi=stationW;
set netdns=confGetNetdns;
set netdns="\192\168\1\1";
// set netdns="\10\0\1\1";
set netip="\127\0\0\1";
0;;
// --------------- TCP/UDP EMULATION fin
}
// --------------- DNS debut
fun parsequ s i= let strfind s i "\0" 0 nil -> j in j+5;;