Zarutian: An start of an SAMv2 library for Tcl
# I, Zarutian, hereby put this code into the International public domain.
package require Tcl 8.5
package provide i2p/sam2 0.2
# 0.1 was refactored into 0.2
# 0.2 isnt spec implementation finished
namespace eval i2p {}
namespace eval i2p::sam2 {
variable defaults { bridge {host localhost port none} style STREAM}
variable session_counter 0
variable sessions
# public below
proc new_session_for_streams {params} {
if {![dict exists $params accept_callback]} { error "an accept_callback must be provided" }
set i [next_session_nr]
variable sessions
dict set sessions $i accept_callback [dict get $params accept_callback]
dict set params style STREAM
dict set params session_id $i
return [new_session $params]
}
proc new_session_for_datagrams {params} {
if {![dict exists $params recieve_callback]} { error "an recive_callback must be provided" }
set i [next_session_nr]
variable sessions
dict set sessions $i datagram_recieve_callback [dict get $params recieve_callback]
dict set params style DATAGRAM
dict set params session_id $i
return [new_session $params]
}
proc new_session_for_rawgrams {params} {
if {![dict exists $params recieve_callback]} { error "an recive_callback must be provided" }
set i [next_session_nr]
variable sessions
dict set sessions $i rawgram_recieve_callback [dict get $params recieve_callback]
dict set params style RAW
dict set params session_id $i
return [new_session $params]
}
proc new_session {params} {
if {[dict exists $params session_id]} {
set i [dict get $params session_id]
} else {
set i [next_session_nr]
}
variable defaults
if {![dict exists $params style]} { error "an style must be provided" }
if {![dict exists $params bridge]} { dict set params bridge [dict get $defaults bridge] }
if {![dict exists $params bridge host]} { dict set params bridge host [dict get $defaults bridge host] }
if {![dict exists $params bridge port]} { dict set params bridge port [dict get $defaults bridge port] }
if {![dict exists $params stream]} { dict set params stream [dict get $defaults stream] }
if {![dict exists $params condition_callback} { error "an condition_callback must be provided" }
if {![dict exists $params my_name]} { error "my_name must be provided" }
variable sessions
dict set sessions $i condition_callback [dict get $params condition_callback]
dict set sessions $i my_name [dict get $params my_name]
dict set sessions $i style [dict get $params style]
dict set sessions $i stream_counter 0
dict set sessions $i stage 1
dict set sessions $i socket [set sock [socket -async [dict get $params bridge host] [dict get $params bridge port]]]
fconfigure $sock -buffering none -translation binary -encoding binary -blocking no
fileevent $sock readable [list i2p::sam2::raw_session_recive $i]
raw_session_send $sock "HELLO VERSION MIN=2.0 MAX=2.0\n"
return $i
}
proc new_stream {session_id destination callback} {
variable sessions
if {![string equal "STREAM" [dict get $sessions $session_id style]]} {
error "cant open an new stream in session $session_id as its style isnt STREAM"
}
set sock [dict get $sessions $session_id socket]
set i [expr {[dict get $sessions $session_id stream_counter] + 1}]
dict set sessions $session_id stream_counter $i
set p "STREAM CONNECT ID="
append p $i
append p " DESTINATION="
append p $destination
append p "\n"
raw_session_send $sock $p
dict set sessions $session_id streams $i destination $destination
dict set sessions $session_id streams $i callback $callback
dict set sessions $session_id streams $i status connecting
dict set sessions $session_id streams $i ready_to_send no
return $i
}
proc send_on_stream {session_id stream_id data} {
variable sessions
if {![string equal "STREAM" [dict get $sessions $session_id style]]} {
error "cant send on stream $stream_id in session $session_id as its style isnt STREAM"
}
set sock [dict get $sessions $session_id socket]
if {[dict get $sessions $session_id streams $stream_id ready_to_send]} {
set p "STREAM SEND ID="
append p $stream_id
append p " SIZE="
if {[string length $data] <= 32768} {
append p [string length $data]
append p "\n"
append p $data
dict set sessions $sessions_id streams $stream_id more2send no
} else {
append p 32768
append p "\n"
append p [string range $data 0 32767]
dict append sessions $session_id streams $stream_id out_buffer [string range $data 32768 end]
dict set sessions $session_id streams $stream_id more2send yes
}
raw_session_send $sock $p
} else {
dict append sessions $session_id streams $stream_id out_buffer $data
dict set sessions $session_id streams $stream_id more2send yes
}
}
proc close_stream {session_id stream_id} {
variable sessions
if {![string equal "STREAM" [dict get $sessions $session_id style]]} {
error "cant close stream $stream_id in session $session_id as its style isnt STREAM"
}
set sock [dict get $sessions $session_id socket]
if {[dict get $sessions $session_id streams $stream_id more2send]} {
dict set sessions $session_id streams $stream_id closeAfterAllIsSent yes
} else {
raw_session_send $sock "STREAM CLOSE ID=[set stream_id]\n"
}
}
proc send_rawgram {session_id destination data} {
variable sessions
if {![string equal "RAW" [dict get $sessions $session_id style]]} {
error "cant send rawgram via session $session_id as its style isnt RAW"
}
set sock [dict get $sessions $session_id socket]
set p "RAW SEND "
append p "DESTINATION="
append p $destination
append p " SIZE="
append p [string length $data]
append p "\n"
append p $data
raw_session_send $sock $p
}
proc send_datagram {session_id destination data} {
variable sessionscant close stream $stream_
if {![string equal "DATAGRAM" [dict get $sessions $session_id style]]} {
error "cant send datagram via session $session_id as its style isnt DATAGRAM"
}
set sock [dict get $sessions $session_id socket]
set p "DATAGRAM SEND "
append p "DESTINATION="
append p $destination
append p " SIZE="
append p [string length $data]
append p "\n"
append p $data
raw_session_send $sock $p
}
# internal below
proc invoke_condition_callback {args} {
variable sessions
lassign $args session_id
after 0 [list {*}[dict get $sessions $session_id condition_callback] {*}$args]
return
}
proc get_pairs {line} {
dict set out MESSAGE ""
foreach pair [split [string range $line 14 end] " "] {
set tmp [string first "=" $pair]
set key [string range $pair 0 [expr {$tmp - 1}]]
set value [string range $pair [expr {$tmp + 1}] end]
if {[string equal $key "MESSAGE"]} {
set tmp [expr {[string first "MESSAGE=" $line] + 8}]
dict set out MESSAGE [string range $line $tmp end]
} elseif {[string equal $key "DESTINATION"]} {
# cant recall if DESTINATION needed any special handling like MESSAGE -Zarutian
dict set out DESTINATION $value
} else {
dict set out $key $value
}
}
return $out
}
proc consume_one_line_of_rawbuffer {session_id} {
variable sessions
set buffer [dict get $sessions $session_id raw_buffer]
dict set sessions $session_id raw_buffer [string range $buffer [expr {[string first "\n" $buffer] + 1} end]
return
}
proc next_session_nr {} {
variable session_counter
return session[incr session_counter]
}
proc raw_session_send {socket data} { catch { puts -nonewline $socket $data; flush $socket } }
proc raw_session_recive {session_id} {
variable sessions
set sock [dict get $sessions $session_id socket]
if {[eof $sock]} {
close $sock
invoke_condition_callback $session_id bridge connection closed
return
}
dict append sessions $session_id raw_buffer [set buffer [read $sock]]
if {[string first "\n" $buffer] != -1} {
switch -exact -- [lindex $buffer 0] {
"HELLO" { hello_recive $session_id }
"SESSION" { session_recive $session_id }
"STREAM" { stream_recive $session_id }
"DATAGRAM" { datagram_recive $session_id }
"RAW" { rawgram_recive $session_id }
"NAMING" { naming_recive $session_id }
"DEST" { dest_recive $session_id }
default {
invoke_condition_callback $session_id bridge protocol unknown_message_type
return
}
}
}
return
}
proc hello_recive {session_id} {
variable sessions
set buffer [dict get $sessions $session_id raw_buffer]
set line [lindex [split $buffer "\n"] 0]
if {[string equal "REPLY" [lindex $line 1]]} {
set params [get_pairs [string range $line 12 end]]
if {![dict exists $params RESULT]} {
invoke_condition_callback $session_id bridge connection missingHelloReplyParam RESULT
return
}
if {![dict exists $params VERSION]} {
invoke_condition_callback $session_id bridge connection missingHelloReplyParam VERSION
return
}
if {[string equal [dict get $params RESULT] "NOVERSION"]} {
invoke_condition_callback $session_id bridge connection noversion
return
}
if {![string equal [dict get $params RESULT] "OK"]} {
invoke_condition_callback $session_id bridge connection resultNotOk
return
}
if {![string equal [dict get $params VERSION] "2.0"]} {
invoke_condition_callback $session_id bridge connection versionNot2.0
return
}
#---
consume_one_line_of_raw_buffer $session_id
set p "SESSION CREATE STYLE="
append p [string toupper [dict get $sessions $session_id style]]
append p " DESTINATION="
append p [dict get $sessions $session_id my_name]
append p "\n"
raw_session_send $sock $p
dict set sessions $session_id stage 2
}
return
}
proc session_recive {session_id} {
variable sessions
set buffer [dict get $sessions $session_id raw_buffer]
set line [lindex [split $buffer "\n"] 0]
if {[string equal [lindex $line 1] "STATUS"]} {
set params [get_pairs [string range $line 15 end]]
if {![dict exists $params RESULT]} {
invoke_condition_callback $session_id bridge session statusParamMissing RESULT
return
}
if {![dict exists $params DESTINATION]} {
invoke_condition_callback $session_id bridge session statusParamMissing DESTINATION
return
}
if {![string equal "OK" [dict get $params RESULT]]} {
if {![dict exists $params MESSAGE]} {
dict set params MESSAGE ""
}
consume_one_line_of_rawbuffer $session_id
invoke_condition_callback $session_id bridge session statusNotOk [dict get $params RESULT] [dict get $params MESSAGE]
} else {
consume_one_line_of_rawbuffer $session_id
dict set sessions $session_id stage 3
}
return
}
}
proc stream_recive {session_id} {
variable sessions
set sock [dict get $sessions $session_id socket]
set buffer [dict get $sessions $session_id raw_buffer]
set line [lindex [split $buffer "\n"] 0]
switch -exact -- [lindex $line 1] {
"STATUS" {
set params [get_pairs [string range $line 14 end]]
if {![dict exists $params RESULT]} {
invoke_condition_callback $session_id bridge stream statusParamMissing RESULT
return
}
if {![dict exists $params ID]} {}
if {![dict exists $params MESSAGE]} {
dict set params MESSAGE ""
}
if {$done != 2} {
after 0 [list {*}[dict get $sessions $session_id condition_callback] bridge protocol statusInvalidParams $session_id]
return
}
if {[string equal $RESULT "OK"]} {
set p "STREAM RECEIVE ID="
append p $ID
append p " LIMIT=NONE\n"
raw_send $sock $p
}
after 0 [list {*}[dict get $sessions $session_id streams $ID callback] connected $RESULT $MESSAGE]
dict set sessions $session_id raw_buffer [string range $buffer [expr {[string first "\n" $buffer] + 1}] end]
return
}
"CONNECTED" {
set done 0
foreach pair [split [string range $line 14 end] " "] {
set tmp [string first "=" $pair]
set key [string range $pair 0 [expr {$tmp - 1}]]
set value [string range $pair [expr {$tmp + 1}] end]
if {[string equal $key "DESTINATION"]} { incr done; set DESTINATION $value }
if {[string equal $key "ID"]} { incr done; set ID $value }
}
if {$done != 2} {
after 0 [list {*}[dict get $sessions $session_id condition_callback] bridge protocol connectedInvalidParams $session_id]
return
}
set p "STREAM RECEIVE ID="
append p $ID
append p " LIMIT=NONE\n"
raw_send $sock $p
after 0 [list {*}[dict get $sessions condition_callback] stream connected $ID $DESTINATION]
dict set sessions $session_id raw_buffer [string range $buffer [expr {[string first "\n" $buffer] + 1}] end]
return
}
"SEND" {
set done 0
foreach pair [split [string range $line 14 end] " "] {
set tmp [string first "=" $pair]
set key [string range $pair 0 [expr {$tmp - 1}]]
set value [string range $pair [expr {$tmp + 1}] end]
if {[string equal $key "RESULT"]} { incr done; set RESULT $value }
if {[string equal $key "ID"]} { incr done; set ID $value }
if {[string equal $key "STATE"]} { incr done; set STATE $value
}
if {$done != 3} {
after 0 [list {*}[dict get $sessions $session_id condition_callback] bridge protocol sendInvalidParams $session_id]
return
}
if {[string equal $RESULT "FAILED"]} {
after 0 [list {*}[dict get $sessions $session_id streams $ID callback] sendFail]
}
if {[string equal $STATE "BUFFER_FULL"]} {
dict set sessions $session_id streams $ID ready_to_send no
} elseif {[string equal $STATE "READY"]} {
dict set sessions $session_id streams $ID ready_to_send yes
send_next $session_id $ID
}
dict set sessions $session_id raw_buffer [string range $buffer [expr {[string first "\n" $buffer] + 1}] end]
return
}
"READY_TO_SEND" {
set done 0
foreach pair [split [string range $line 14 end] " "] {
set tmp [string first "=" $pair]
set key [string range $pair 0 [expr {$tmp - 1}]]
set value [string range $pair [expr {$tmp + 1}] end]
if {[string equal $key "ID"]} { incr done; set ID $value }
}
if {$done != 1} {
after 0 [list {*}[dict get $sessions $session_id condition_callback] bridge protocol ReadyToSendInvalidParams $session_id]
return
}
send_next $session_id $ID
dict set sessions $session_id raw_buffer [string range $buffer [expr {[string first "\n" $buffer] + 1}] end]
return
}
"CLOSED" {
}
"RECEIVED" {}
}
return
}
proc datagram_recive {session_id} {
variable sessions
set sock [dict get $sessions $session_id socket]
set buffer [dict get $sessions $session_id raw_buffer]
set line [lindex [split $buffer "\n"] 0]
if {[string equal "RECEIVED" [lindex $line 1]]} {
}
return
}
proc rawgram_recive {session_id} {
variable sessions
set sock [dict get $sessions $session_id socket]
set buffer [dict get $sessions $session_id raw_buffer]
set line [lindex [split $buffer "\n"] 0]
if {[string equal "RECEIVED" [lindex $line 1]]} {
}
return
}
proc naming_recive {session_id} {}
proc dest_recive {session_id} {}
proc send_next {session_id stream_id} {
variable sessions
set sock [dict get $sessions $session_id socket]
if {[dict get $sessions $session_id streams $stream_id more2send]} {
set p "STREAM SEND ID="
append p $ID
append p " SIZE="
if {[string length [dict get $sessions $session_id streams $stream_id out_buffer]] <= 32768} {
append p [string length [dict get $sessions $session_id streams $stream_id out_buffer]]
append p "\n"
append p [dict get $sessions $session_id streams $stream_id out_buffer]
dict set sessions $sessions_id streams $stream_id more2send no
} else {
append p 32768
append p "\n"
append p [string range [dict get $sessions $session_id streams $stream_id out_buffer] 0 32767]
dict set sessions $session_id streams $stream_id out_buffer \
[string range [dict get $sessions $session_id streams $stream_id out_buffer] 32768 end]
dict set sessions $session_id streams $stream_id more2send yes
}
raw_send $sock $p
} else {
if {[dict get $sessions $session_id streams $stream_id closeAfterAllIsSent]} {
raw_send $sock "STREAM CLOSE ID=[set stream_id]\n"
}
}
}
}