http://i2p2.de%|%I2P%|%

[Zarutian]: An start of an http://www.i2p2.de/samv2.html%|%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

  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 {params} {
      variable session_counter
      set i session[incr session_counter]
      variable defaults
      if {![dict exists $params style]}       { dict set params style  [dict get $defaults style] }
      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
    }

    # 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 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]
      switch --exact -- [lindex $line 1] {
        "STATUS" {
          set params [get_pairs [string range $line 15 end]]
          if {![dict exists $params RESULT]} {}
          if {![dict exists $params DESTINATION]} {}
          if {![dict exists $params MESSAGE]} {}
          consume_one_line_of_rawbuffer $session_id
          dict set sessions $session_id stage 3
        }
      }
    }
    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" {

          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]
      switch -exact -- [lindex $line 1] {

      }
      return
    }
    proc rawgram_recive {session_id} {}
    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"
        }
      }
    }


    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_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_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_send $sock "STREAM CLOSE ID=[set stream_id]\n"
      }
    }
  }

======