egghelp.org community Forum Index
[ egghelp.org home | forum home ]
egghelp.org community
Discussion of eggdrop bots, shell accounts and tcl scripts.
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

socket api - nonblocking tcp made easy

 
Post new topic   Reply to topic    egghelp.org community Forum Index -> Tcl FAQ
View previous topic :: View next topic  
Author Message
user
 


Joined: 18 Mar 2003
Posts: 1452
Location: Norway

PostPosted: Tue Feb 13, 2007 2:37 pm    Post subject: socket api - nonblocking tcp made easy Reply with quote

This is an attempt to make the built in sockets even more user friendly. I just started coding this thing, so please help me find bugs/suggest new features/tell me what you think Smile

Code:

# ::sock::Connect <host> <port> ?options?
#
#   Create a tcp connection and return the socket id or "" if it
#   failed. A failure to create the socket most likely means the dns
#   lookup failed. If you need the actual error message, it will be
#   stored in $::sock::(error)
#
#   Options:
#
#      Anything that can be set via ::sock::Set (see below), plus
#      '-myaddr <vhost>' and '-myport <local port>'


# ::sock::Listen <port> ?options?
#
#   Like Connect, but for creating listening sockets
#   All options listed under ::sock::Set can be set and are copied to
#   incoming client connections except "timeout".
#   The "onDisc" code will be executed if you set a timeout for the
#   listening socket and let it time out.
#   You can also specify a vhost using -myaddr <vhost>

# ::sock::Puts <sock> <data>
#
#    Write data to a client socket.

# ::sock::Close <sock>
#
#    Close a socket and clean up its mess
#   (cancel timers and unset variables used to store options)


# ::sock::Set <sock> <option> <value>
#
#   All options are stored untill the socket is closed. If the
#   connection is closed by the remote host, they are deleted AFTER
#   invoking the "onDisc" code.
#   All options can be changed at any time, but the "onConn" code will
#   only be   evaluated once for each client socket, so changing it
#   after the connection has been established has no effect.
#
# Options:
#
#   mode <line|binary>
#      affects how data is read/written
#
#   timeout <milliseconds>
#      If the time runs out, the onDisc callback will be executed
#      before the socket is closed. The timer is killed before
#      "onConn" is executed, so you'll have to set the timeout again
#      from within your onConn code if you want it to keep running
#      after that.
#
#   onConn <code>
#      This code is executed when a connection is established
#      Appended arguments: the client socket id (and server socket id
#      if it is a client connecting to a listening socket)
#
#   onData <code>
#      Invoked when data is recieved (set to {} if you don't expect
#      to recieve any data)
#      Appended arguments: the socket id and a chunk of data
#
#   onDisc <code>
#      Invoked when an error occurs or the connection is closed by
#      the remote host or a timeout occurs.
#      Appended arguments: the socket id and reason/error message.
#
#   onAll <code>
#      A shortcut to set all the other on* callbacks to call the same
#      proc. The callback name (onConn, onData or onDisc) is appended
#      as an argument if you provide an empty "code" part, the
#      commands "onConn", "onData" and "onDisc" will be invoked in
#      the global namespace.
#
# Reserved/custom options:
#
#   Options starting with two underscore characters (__) are reserved
#   for internal use - don't touch them!
#   Options starting with a dash (-) will be passed to the "socket"
#   command when creating the socket and then deleted.
#
#   Feel free to invent your own options. (As long as they don't
#   conflict with the reserved ones) This can come in handy if you
#   need to store som data associated with the socket.


# ::sock::Get <sock> <option>
#
# Retrieve the value of the given option


# ::sock::Info <sock> <local|remote> <ip/host/port combinations>
#
# Retrieve local or remote host, ip and/or port
# Eg: ::sock::Info $sock local ip:port => 127.0.0.1:6667
#     ::sock::Info $sock remote host   => wiki.tcl.tk

package require Tcl 8.2


namespace eval ::sock {

   variable ""

   # default "Connect" options
   set (connect) {
      timeout 20000
      mode line
      onAll ::sock::Log
   }

   # default "Listen" options
   set (listen) {
      timeout 0
      mode line
      onAll ::sock::Log
   }
   lappend (listen) -myaddr [info host]


   # the "public" procs
   proc Connect {host port args} {
      array set "" [concat $::sock::(connect) $args {__type client}]
      set code [concat [list socket -async] [array get "" -*] [list $host $port]]
      array unset "" -*
      if {[catch $code sock]} {
         set ::sock::(error) $sock
         return
      }
      fconfigure $sock -blocking 0
      fileevent $sock writable [list ::sock::__onConn $sock]
      variable $sock
      array set $sock {}
      foreach key [lsort -dict [array names ""]] {
         Set $sock $key $($key)
      }
      set sock
   }

   proc Listen {port args} {
      set sid [incr ::sock::(sid)]
      array set "" [concat $::sock::(listen) $args [list __type server __sid $sid]]
      set code [list socket -server [list ::sock::__onListen $sid]]
      eval lappend code [array get "" -*] [list $port]
      array unset "" -*
      if {[catch $code sock]} {
         set ::sock(error) $sock
         return
      }
      set ::sock::($sid) $sock
      variable $sock
      array set $sock {}
      foreach key [lsort -dict [array names ""]] {
         Set $sock $key $($key)
      }
      set sock
   }

   proc Puts {sock data} {
      upvar #0 ::sock::$sock ""
      if {$(mode)=="binary"} {
         puts -nonewline $sock $data
      } {
         puts $sock $data
      }
      flush $sock
   }

   proc Close {sock} {
      upvar #0 ::sock::$sock ""
      if {[info exists (__after)]} {after cancel $(__after)}
      if {$(__type)=="server"} {unset ::sock::($(__sid))}
      close $sock
      unset ""
   }

   proc Set {sock key val} {
      upvar #0 ::sock::$sock ""
      if {![array exists ""]} {error "invalid socket \"$sock\""}
      switch -- $key {
         "timeout" {
            if {[info exists (__after)]} {
               after cancel $(__after)
               unset (__after)
            }
            if {$val>0} {
               set (__after) [after $val [list ::sock::__onDisc $sock timeout]]
            }
         }
         "mode" {
            if {$(__type)=="client"} {
               if {$val=="binary"} {
                  fconfigure $sock -buffering none -translation binary
               } {
                  fconfigure $sock -buffering line -translation auto
               }
            }
         }
         "onData" {
            if {$(__type)=="client"} {
               if {$val=={}} {
                  fileevent $sock readable {}
               } {
                  fileevent $sock readable [list ::sock::__onData $sock]
               }
            }
         }
         "onAll" {
            Set $sock onConn [concat $val onConn]
            Set $sock onData [concat $val onData]
            Set $sock onDisc [concat $val onDisc]
         }
      }
      set ($key) $val
   }
   
   proc Get {sock key} {
      set ::sock::${sock}($key)
   }

   proc Info {sock where what} {
      set where [string map {local -sockname remote -peername} $where]
      foreach {ip host port} [fconfigure $sock $where] break
      string map [list ip $ip host $host port $port] $what
   }
   
   
   # "private" procs
   # (you should never have to invoke these yourself)
   if {![info exists (sid)]} {set (sid) 0}
   
   proc __onConn sock {
      upvar #0 ::sock::$sock ""
      if {[set err [fconfigure $sock -error]]!=""} {
         __onDisc $sock $err
      } {
         fileevent $sock writable {}
         __callback $(onConn) $sock
      }
   }

   proc __onListen {sid csock chost cport} {
      set ssock $::sock::($sid)
      array set "" [array get ::sock::$ssock]
      if {[info exists (__after)]} {unset (__after)}
      set (__type) client
      set (ssock) $ssock
      fconfigure $csock -blocking 0
      variable $csock
      array set $csock {}
      foreach key [lsort -dict [array names ""]] {
         Set $csock $key $($key)
      }
      __callback $(onConn) $csock $ssock
   }

   proc __onDisc {sock why} {
      upvar #0 ::sock::$sock ""
      __callback $(onDisc) $sock $why
      if {[info exists (__after)]} {after cancel $(__after)}
      close $sock
      unset ""
   }

   proc __onData sock {
      upvar #0 ::sock::$sock ""
      if {$(mode)=="binary"} {
         set code {![fblocked $sock]&&[set data [read $sock]]!=""}
      } {
         set code {[gets $sock data]>0}
      }
      if {[catch {while $code {__callback $(onData) $sock $data}} err]} {
         __onDisc $sock $err
      } elseif {[eof $sock]} {
         __onDisc $sock EOF
      } elseif {[set err [fconfigure $sock -error]]!=""} {
         __onDisc $sock $err
      }
   }

   proc __callback {code args} {
      if {[catch {uplevel #0 [concat $code $args]} err]} {
         Log "Error executing callback: $err"
      }
   }

   if {[llength [info commands putlog]]} {
      proc Log args {putlog "::sock: [join $args ", "]"}
   } {
      proc Log args {puts   "::sock: [join $args ", "]"}
   }

}

_________________
Have you ever read "The Manual"?


Last edited by user on Tue Feb 13, 2007 3:20 pm; edited 3 times in total
Back to top
View user's profile Send private message
user
 


Joined: 18 Mar 2003
Posts: 1452
Location: Norway

PostPosted: Tue Feb 13, 2007 2:38 pm    Post subject: Reply with quote

Code:
# Some examples
#
# PS: the vwaits and setting of the ::done variable are there
# to enter/exit the event loop if you test the examples in tclsh.
# You can remove all the vwaits and lines containg ::done if
# you're testing under Eggdrop


# Making a http request (using onAll with empty code)
proc onConn {sock} {
   puts $sock "GET / HTTP/1.0\nHost: www.google.com\nConnection: close\n"
   sock::Set $sock mode binary
   sock::Log "REQUEST SENT."
}
proc onData {sock data} {
   sock::Log "GOT: $data"
}
proc onDisc {sock why} {
   sock::Log "DISCONNECTED: $why"
   set ::done now
}
proc test1 {} {
   sock::Connect www.google.com 80 onAll {}
   if {$::tcl_interactive} {vwait ::done}
}
test1



# Same thing with non-empty callback which makes it a bit more
# compact and flexible...
proc test2_handler {host uri type sock {arg ""}} {
   switch -- $type {
      "onConn" {
         puts "CONN: requesting $uri from $host"
         puts $sock "GET $uri HTTP/1.0\nHost: $host\nConnection: close\n"
         # try commenting out the next line:
         sock::Set $sock mode binary
      }
      "onData" {
         puts "DATA: $arg"
      }
      "onDisc" {
         puts "DISC: $arg"
         set ::done 1
      }
   }
}
proc test2 {host port uri} {
   set sock [sock::Connect $host $port onAll [list test2_handler $host $uri]]
   if {$::tcl_interactive} {vwait ::done}
}
test2 www.google.com 80 /404


# A basic server on a random port
# It will wait for an incoming connection, send a message to the first
# client that connects, then kill both the server and client sockets.
proc test3 {} {
   set sock [sock::Listen 0]
   sock::Set $sock onConn test3_conn
   sock::Set $sock onDisc test3_disc
   sock::Set $sock timeout 60000
   set name [sock::Info $sock local ip:port]
   sock::Log test3 "Telnet to $name within 60 seconds..."
   if {$::tcl_interactive} {vwait ::done}
}
proc test3_disc {sock why} {
   set ::done now
}
proc test3_conn {csock ssock} {
   sock::Log test3_conn "Incoming connection from [sock::Info $csock remote ip:port]"
   puts $csock "Hello and good bye!"
   sock::Close $csock
   sock::Close $ssock
   set ::done now
}
test3

EDIT: here's another one
Code:
# This one requires Eggdrop
# DCC chat with temporary password to prevent hijacking by port scanners
# After checking nick+password, control is handed over to the
# "onData" code passed to the dccchat proc.
proc dccchat {nick onData} {
   set pass [string trimleft [expr {rand()}] 0.]
   set sock [::sock::Listen 0 onConn [list dccchat_A $nick $pass $onData]]
   foreach {ip port} [::sock::Info $sock local "ip port"] break
   set longip [format %u [eval format 0x%02x%02x%02x%02x [split $ip .]]]
   putserv "NOTICE $nick :Your temporary password is: $pass"
   putserv "PRIVMSG $nick :\001DCC CHAT chat $longip $port\001"
}
proc dccchat_A {nick pass onData sock ssock} {
   ::sock::Close $ssock
   ::sock::Set $sock timeout 20000
   ::sock::Puts $sock "nick?"
   ::sock::Set $sock onData [list dccchat_B $nick $pass $onData]
}
proc dccchat_B {nick pass onData sock answer} {
   if {[string eq -nocase $nick $answer]} {
      ::sock::Puts $sock "pass?"
      ::sock::Set $sock timeout 20000
      ::sock::Set $sock onData [list dccchat_C $nick $pass $onData]
   } {
      ::sock::Puts $sock "Go away!"
      ::sock::Close $sock
   }
}
proc dccchat_C {nick pass onData sock answer} {
   if {[string eq $pass $answer]} {
      ::sock::Puts $sock "Correct. $onData will handle your input from now on."
      ::sock::Set $sock timeout 0
      ::sock::Set $sock onData $onData
   } {
      ::sock::Puts $sock "WRONG!"
      ::sock::Close $sock
   }
}

proc dccecho {sock data} {
   ::sock::Puts $sock $data
}
# Load this into your egg, then try:
# .tcl dccchat YourNick dccecho

_________________
Have you ever read "The Manual"?
Back to top
View user's profile Send private message
sKy
Op


Joined: 14 Apr 2005
Posts: 194
Location: Germany

PostPosted: Wed Jul 04, 2007 1:32 am    Post subject: Reply with quote

This is very interesting and promising.

Code:
proc test_server { } {
   set sock [sock::Listen 35189]
   sock::Set $sock onAll [list test_server_all]
   return $sock
}

proc test_server_all { args } {
   putlog "test_server_all: $args"
}

proc test_connect { } {
   set sock [::sock::Connect 127.0.0.1 35189]
   sock::Set $sock onAll [list test_connect_all]
   return $sock
}

proc test_connect_all { args } {
   putlog "test_connect_all: $args"
}

Tcl error: couldn't open socket: connection refused
Can you tell me please what`s wrong?
_________________
socketapi | Code less, create more.
Back to top
View user's profile Send private message
user
 


Joined: 18 Mar 2003
Posts: 1452
Location: Norway

PostPosted: Wed Jul 04, 2007 3:32 am    Post subject: Reply with quote

Looks like you're not listening on 127.0.0.1 ... try
Code:
sock::Listen 35189 -myaddr 127.0.0.1
or
Code:
sock::Connect [info host] 35189
or change/remove the default listening host
_________________
Have you ever read "The Manual"?
Back to top
View user's profile Send private message
sKy
Op


Joined: 14 Apr 2005
Posts: 194
Location: Germany

PostPosted: Wed Jul 04, 2007 5:59 am    Post subject: Re: socket api - nonblocking tcp made easy Reply with quote

user wrote:
This is an attempt to make the built in sockets even more user friendly.

You can`t imagine how much this decreases my amount of time to write socket related stuff.

user wrote:
I just started coding this thing, so please help me find bugs/suggest new features/tell me what you think Smile

Bugs so far none, but I will use this always now and guaranteed that I would report them. Smile

Suggestions:
- I wish to have -timeout 0 for unlimited (long lived connections), check internal if the connection is still alive and send some ping/pong packages if this is not already done by tcp.
- provide this as package
- try to get this into tcl standardlib

Edit:
I have a great new idea. Would be awesome if you could include optional symmetric encryption (also also authentication though the password, readable = authenticated, not readable = unauthenticard), though using aes.

Like ::sock::Set $sock symencr "password"

Not all transmissions need to be encrypted. Just everything send with ::sock::Puts and incoming though onData.

It`s quite complicated to implement an encryption. If you encrypt and send you need to use -translation/-encoding binary because many chars from all encoding types will be used. But the target can`t use the encrypted stream so easy, because he is getting in in binary mode he can`t find a new line, even if you are already using flush.
_________________
socketapi | Code less, create more.
Back to top
View user's profile Send private message
user
 


Joined: 18 Mar 2003
Posts: 1452
Location: Norway

PostPosted: Fri Aug 03, 2007 9:13 am    Post subject: Re: socket api - nonblocking tcp made easy Reply with quote

sKy wrote:
I wish to have -timeout 0 for unlimited (long lived connections),

That's already implemented (and even used in my last example).

sKy wrote:
check internal if the connection is still alive and send some ping/pong packages if this is not already done by tcp.

That's better handled by the code using this api IMO, as it would intercept traffic that might be part of the data you expect to recieve .
sKy wrote:
provide this as package

Just add "package provide whatever 0.1" to the end of the script Razz
sKy wrote:
I have a great new idea. Would be awesome if you could include optional symmetric encryption (also also authentication though the password, readable = authenticated, not readable = unauthenticard), though using aes.

Like ::sock::Set $sock symencr "password"

Not all transmissions need to be encrypted. Just everything send with ::sock::Puts and incoming though onData.

It`s quite complicated to implement an encryption. If you encrypt and send you need to use -translation/-encoding binary because many chars from all encoding types will be used. But the target can`t use the encrypted stream so easy, because he is getting in in binary mode he can`t find a new line, even if you are already using flush.


Again, I think this is better handled outside the api... eg.
Code:
proc putsEncrypted {sock data} {
   sock::Puts $sock [encrypt $data]
}

proc onEncryptedData {sock data} {
   onDataExpectingUnencryptedData $sock [decrypt $data]
}

The code added is minimal and the users can pick what ever encryption algorithm they want/have access to.
_________________
Have you ever read "The Manual"?
Back to top
View user's profile Send private message
sparc317
Voice


Joined: 23 Jan 2008
Posts: 11

PostPosted: Mon Apr 07, 2008 2:30 pm    Post subject: Reply with quote

Thanks so much for this, saves so much hassle Smile

I was wondering if you could tell me how it is possible to "address" an individual socket, using the following example:

Code:

proc connection_handler {host port type sock {arg ""}} {
   switch -- $type {
      "onConn" {
         sock::Set $sock mode binary
         sock::Set $sock timeout 0
         putlog "Connected to $host"
      }
      "onData" {
                       putlog "$arg"
       }
      }
      "onDisc" {
                       putlog "lost connection to $host"
                       
       }
   }
}

# Opens a connection to a server

proc connectionOpen {host port} {
  set sock [sock::Connect $host $port onAll [list connection_handler $host $port]]
}

# Servers to connect to

connectionOpen 1.2.3.4 10000
connectionOpen 1.2.3.4 20000
connectionOpen 1.2.3.4 30000


So, what I want to do here is within "onDisc" tell the specific socket that was disconnected, to reconnect.

I would be grateful for any ideas.
Back to top
View user's profile Send private message
user
 


Joined: 18 Mar 2003
Posts: 1452
Location: Norway

PostPosted: Mon Apr 07, 2008 5:31 pm    Post subject: Reply with quote

sparc317 wrote:
So, what I want to do here is within "onDisc" tell the specific socket that was disconnected, to reconnect.

You could create a new connection to the same destination... It would not be the same socket (that's not possible using tcl's socket command), but I don't think it makes any difference to you...
Code:
"onDisc" {
   putlog "lost connection to $host - reconnecting..."
   connectionOpen $host $port
}

_________________
Have you ever read "The Manual"?
Back to top
View user's profile Send private message
Ofloo
Owner


Joined: 13 May 2003
Posts: 952
Location: Belguim

PostPosted: Mon Nov 09, 2009 2:58 pm    Post subject: Reply with quote

I was wondering, ..

if i just made regular socket connection which is blocking and without the async and once it's active i would fconfigure socket -blocking 0 and fconfigure socket -buffering line .. would that make it a non blocking socket cause i don't see it block anymore, my point is, can anyone tell me the difference and is it worth going through all that fileevent crap with vwait ... instead wouldn't it be easier just to use fconfigure?

ofcourse if you don't mind the connecting of the socket to be blocking..
_________________
XplaiN but think of me as stupid
Back to top
View user's profile Send private message Visit poster's website
nml375
Revered One


Joined: 04 Aug 2006
Posts: 2829

PostPosted: Mon Nov 09, 2009 5:50 pm    Post subject: Reply with quote

The big issue/difference is the blocking behaviour of the connection...
For accepted and refused connection attempts, that's not a big deal, but for dropped connections (like a lot of "stealth" firewalls these days do it), that means your script will block for quite some time, until the kernel figures the connection attempt got lost somewhere and times it out...
_________________
NML_375, idling at #eggdrop@IrcNET
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    egghelp.org community Forum Index -> Tcl FAQ All times are GMT - 4 Hours
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Forum hosting provided by Reverse.net

Powered by phpBB © 2001, 2005 phpBB Group
subGreen style by ktauber