examples/client-server.tcl

   1 proc bgerror {msg} {
   2         puts "bgerror: $msg"
   3         #exit 0
   4 }
   5
   6 proc verbose {msg} {
   7         puts $msg
   8 }
   9
  10 if {[os.fork] == 0} {
  11         verbose "child: waiting a bit"
  12
  13         # This will be our client
  14
  15         sleep .1
  16
  17         set f [socket stream localhost:9876]
  18         fconfigure $f -buffering line
  19
  20         set done 0
  21
  22         proc onread {f} {
  23                 if {[$f gets buf] > 0} {
  24                         verbose "child: read response '$buf'"
  25                 } else {
  26                         verbose "child: read got eof"
  27                         set ::done 1
  28                 }
  29         }
  30
  31         proc onwrite {f} {
  32                 verbose "child: sending request"
  33                 $f puts -nonewline "GET / HTTP/1.0\r\n\r\n"
  34                 $f writable {}
  35         }
  36
  37         $f writable [list onwrite $f]
  38         $f readable [list onread $f]
  39
  40         alarm 10
  41         catch -signal {
  42                 verbose "child: in event loop"
  43                 vwait done
  44                 verbose "child: done event loop"
  45         }
  46         alarm 0
  47         $f close
  48         exit 0
  49 }
  50
  51 verbose "parent: opening socket"
  52 set done 0
  53
  54 # This will be our server
  55 set f [socket stream.server 0.0.0.0:9876]
  56
  57 proc server_onread {f} {
  58         verbose "parent: onread (server) got connection on $f"
  59         set cfd [$f accept]
  60         verbose "parent: onread accepted $cfd"
  61
  62         verbose "parent: read request '[string trim [$cfd gets]]'"
  63
  64         $cfd puts "Thanks for the request"
  65         $cfd close
  66
  67         verbose "parent: sent response"
  68
  69         incr ::done
  70 }
  71
  72 $f readable [list server_onread $f]
  73
  74 alarm 10
  75 catch -signal {
  76         vwait done
  77 }
  78 alarm 0
  79 $f close
  80
  81 sleep .5
  82
  83 return "ok"