]> wagner.pp.ru Git - openssl-gost/engine.git/blob - tcl_tests/yarrowc.tcl
Update Copyright lines after registration rework
[openssl-gost/engine.git] / tcl_tests / yarrowc.tcl
1 set argport 7670
2 if {[lindex $argv 0] eq "-port"} {
3         set argport [lindex $argv 1]
4         set argv [lrange $argv 2 end]
5 }
6 set request [lindex $argv 0]
7 set len [switch $request ping {expr -1} protocol {expr -2} version {expr -3} check {expr 1} default {expr $request}]
8 set read_data {}
9
10 proc get_port {} {
11         if {[regexp {^\d+$} $::argport]} {return $::argport}
12         set f [open $::argport r]
13         set r [read -nonewline $f]
14         close $f
15         return $r
16 }
17
18 proc get_data {socket} {
19         set read_data [read $socket]
20         if {$read_data eq ""} {
21                 close $socket
22                 handle_data
23         } else {
24                 append ::read_data $read_data
25         }
26 }
27
28 proc handle_data {} {
29         global len read_data
30         if {$len > 0} {
31                 if {$::request eq "check" && $read_data ne ""} {exit 0}
32                 if {$read_data eq ""} {
33                         puts stderr "not ready"
34                         exit 1
35                 }
36                 binary scan $read_data H* data
37                 set data [regsub -all ".{48}" [regsub -all ".." $data "& "] "&\n"]
38                 if {[string index $data end] eq "\n"} {set data [string replace $data end end]}
39                 puts $data
40         } else {
41                 if {$len == -1 || $len == -3} {
42                         if {[string length $read_data] < 4} {error "Not enough data"}
43                         binary scan $read_data I rlen
44                         set read_data [string range $read_data 4 end]
45                         puts [encoding convertfrom utf-8 $read_data]
46                         if {[string length $read_data] != $rlen} {
47                                 puts stderr "Real string length [string length $read_data] != claimed $rlen!"
48                                 exit 2
49                         }
50                 } elseif {$len == -2} {
51                         if {[string length $read_data] < 4} {error "Not enough data"}
52                         if {[string length $read_data] > 4} {error "Excess data"}
53                         binary scan $read_data I r
54                         puts $r
55                 }
56         }
57         exit 0
58 }
59
60 set port [get_port]
61                 
62 if {[info exists errmsg] && $errmsg ne ""} {error $errmsg}
63 if {$port eq ""} {error "Cannot find port number"}
64
65 set s [socket localhost $port]
66 fconfigure $s -encoding binary -buffering none -blocking 0
67 fileevent $s readable [list get_data $s]
68 puts -nonewline $s [binary format I $len]
69 after 4000 {puts stderr "Timeout.  Read for now: '$read_data'"; exit 2}
70 vwait forever