Dariaceli's Git
Browse code

Initial server implementation without encryption and test client in tcl

Dario Rodriguez authored on 05/05/2014 12:17:18
Showing 1 changed files
urusaitcl/urusaiclient.tcl
History View file @ 27b53a8
1 1 
new file mode 100755
... ... 
@@ -0,0 +1,118 @@
1 
+#!/usr/bin/wish -f
2 
+#
3 
+# urusaiclient.tcl
4 
+#
5 
+# Partially based on
6 
+#   http://wiki.tcl.tk/10968
7 
+#   http://wiki.tcl.tk/16733
8 
+#
9 
+# Author: Dario Rodriguez dario@softhome.net
10 
+#
11 
+
12 
+package require udp
13 
+package require sha1
14 
+
15 
+set host "192.168.1.249"
16 
+set port 20245
17 
+set from htpc
18 
+#set to yurie
19 
+set to otro
20 
+set myport 20246
21 
+set curserial 1
22 
+
23 
+labelframe .top -text "Conversation"
24 
+labelframe .bottom -text "Message"
25 
+
26 
+text .t -wrap word -yscrollcommand {.s set} -state disabled
27 
+scrollbar .s -command {.t yview}
28 
+entry .e -textvariable e
29 
+
30 
+grid .top -sticky nsew
31 
+grid .bottom -sticky nsew
32 
+grid row . 0 -weight 1
33 
+grid column . 0 -weight 1
34 
+pack .s .t -in .top -side right -fill both
35 
+pack configure .t -expand 1
36 
+pack .e -in .bottom -fill both -expand 1
37 
+
38 
+focus .e
39 
+update
40 
+bind .e <Return> {newmessage $e; set e {};break}
41 
+
42 
+proc appendline { from line } {
43 
+        .t conf -state normal
44 
+        .t insert end "$from: $line\n"
45 
+        .t conf -state disabled
46 
+        .t yview end
47 
+}
48 
+
49 
+# AI
50 
+proc newmessage { line } {
51 
+        global from to
52 
+        appendline "Me" $line
53 
+        sendmessage [genserial] $from $to message $line
54 
+}
55 
+
56 
+# Network code
57 
+proc recvmessage {} {
58 
+        global sock from
59 
+        set data [read $sock]
60 
+        binary scan $data H* hex
61 
+        puts $hex
62 
+        set pos 1
63 
+        set num ""
64 
+        set mystr ""
65 
+        set elems [list]
66 
+        foreach c [split $hex ""] {
67 
+                set num "$num$c"
68 
+                set pos [expr 1-$pos]
69 
+                if { $pos == 1 } {
70 
+                        if { [string compare $num "00"]==0 } {
71 
+                                lappend elems $mystr
72 
+                                set mystr ""
73 
+                        } else {
74 
+                                set mystr "$mystr[binary format H* $num]"
75 
+                        }
76 
+                        set num ""
77 
+                }
78 
+        }
79 
+        set serial [lindex $elems 0]
80 
+        set msgfrom [lindex $elems 1]
81 
+        set msgto [lindex $elems 2]
82 
+        set cmd [lindex $elems 3]
83 
+        set contents [lindex $elems 4]
84 
+        appendline "server" "$serial|$msgfrom|$msgto|$cmd|$contents"
85 
+        if { [string compare $cmd "message"]==0 } {
86 
+                sendmessage $serial $from $msgfrom "receipt" ""
87 
+        }
88 
+}
89 
+
90 
+proc sendmessage { serial from to cmd contents } {
91 
+        global sock host port
92 
+        set msg [format "%s\0%s\0%s\0%s\0%s\0" $serial $from $to $cmd $contents]
93 
+        udp_conf $sock $host $port
94 
+        puts -nonewline $sock $msg
95 
+}
96 
+
97 
+proc genserial { } {
98 
+        global curserial from to
99 
+        incr curserial
100 
+        return [string range [::sha1::sha1 -hex -- "[clock seconds]|[set from]|[set to]|[set curserial]"] 0 8]
101 
+
102 
+}
103 
+
104 
+
105 
+if { [llength $argv]>=3 } {
106 
+        set from [lindex $argv 0]
107 
+        set myport [lindex $argv 1]
108 
+        set to [lindex $argv 2]
109 
+}
110 
+
111 
+wm title . "urusai/tcl - $from"
112 
+set sock [udp_open]
113 
+udp_conf $sock $host $myport
114 
+fconfigure $sock -buffering none -translation binary
115 
+fileevent $sock readable recvmessage
116 
+
117 
+sendmessage [genserial] $from "" ping ""
118 
+