1 # Wrappers around socket primitives that are easier to test.
  2 
  3 # To test server operations, just run a real client against localhost.
  4 scenario example-server-test [
  5   local-scope
  6   # test server without a fake on a random (real) port
  7   # that way repeatedly running the test will give ports time to timeout and
  8   # close before reusing them
  9   make-random-nondeterministic
 10   port:num <- random-in-range 0/real-random-numbers, 8000, 8100
 11   run [
 12   ¦ socket:num <- $open-server-socket port
 13   ¦ assert socket, [ 
 14 F - example-server-test: $open-server-socket failed]
 15   ¦ handler-routine:number <- start-running serve-one-request socket, example-handler
 16   ]
 17   source:&:source:char <- start-reading-from-network 0/real-resources, [localhost/], port
 18   response:text <- drain source
 19   10:@:char/raw <- copy *response
 20   memory-should-contain [
 21   ¦ 10:array:character <- [abc]
 22   ]
 23   socket <- $close-socket socket
 24 ]
 25 # helper just for this scenario
 26 def example-handler query:text -> response:text [
 27   local-scope
 28   load-inputs
 29   return [abc]
 30 ]
 31 
 32 # To test client operations, use 'assume-resources' with a filename that
 33 # begins with a hostname. (Filenames starting with '/' are assumed to be
 34 # local.)
 35 scenario example-client-test [
 36   local-scope
 37   assume-resources [
 38   ¦ [example.com/] <- [
 39   ¦ ¦ |abc|
 40   ¦ ]
 41   ]
 42   run [
 43   ¦ source:&:source:char <- start-reading-from-network resources, [example.com/]
 44   ]
 45   contents:text <- drain source
 46   10:@:char/raw <- copy *contents
 47   memory-should-contain [
 48   ¦ 10:array:character <- [abc
 49 ]
 50   ]
 51 ]
 52 
 53 type request-handler = (recipe text -> text)
 54 
 55 def serve-one-request socket:num, request-handler:request-handler -> socket:num [
 56   local-scope
 57   load-inputs
 58   session:num <- $accept socket
 59   assert session, [ 
 60 F - example-server-test: $accept failed]
 61   contents:&:source:char, sink:&:sink:char <- new-channel 30
 62   start-running receive-from-socket session, sink
 63   query:text <- drain contents
 64   response:text <- call request-handler, query
 65   write-to-socket session, response
 66   session <- $close-socket session
 67 ]
 68 
 69 def start-reading-from-network resources:&:resources, uri:text -> contents:&:source:char [
 70   local-scope
 71   load-inputs
 72   {
 73   ¦ port:num, port-found?:boolean <- next-input
 74   ¦ break-if port-found?
 75   ¦ port <- copy 80/http-port
 76   }
 77   {
 78   ¦ break-unless resources
 79   ¦ # fake network
 80   ¦ contents <- start-reading-from-fake-resource resources, uri
 81   ¦ return
 82   }
 83   # real network
 84   host:text, path:text <- split-at uri, 47/slash
 85   socket:num <- $open-client-socket host, port
 86   assert socket, [contents]
 87   req:text <- interpolate [GET _ HTTP/1.1], path
 88   request-socket socket, req
 89   contents:&:source:char, sink:&:sink:char <- new-channel 10000
 90   start-running receive-from-client-socket-and-close socket, sink
 91 ]
 92 
 93 def request-socket socket:num, s:text -> socket:num [
 94   local-scope
 95   load-inputs
 96   write-to-socket socket, s
 97   $write-to-socket socket, 13/cr
 98   $write-to-socket socket, 10/lf
 99   # empty line to delimit request
100   $write-to-socket socket, 13/cr
101   $write-to-socket socket, 10/lf
102 ]
103 
104 def receive-from-socket socket:num, sink:&:sink:char -> sink:&:sink:char, socket:num [
105   local-scope
106   load-inputs
107   {
108   ¦ +next-attempt
109   ¦ c:char, found?:bool, eof?:bool, error:num <- $read-from-socket socket
110   ¦ break-if eof?
111   ¦ break-if error
112   ¦ {
113   ¦ ¦ break-unless found?
114   ¦ ¦ sink <- write sink, c
115   ¦ }
116   ¦ {
117   ¦ ¦ break-if found?
118   ¦ ¦ switch
119   ¦ }
120   ¦ loop
121   }
122   sink <- close sink
123 ]
124 
125 def receive-from-client-socket-and-close socket:num, sink:&:sink:char -> sink:&:sink:char, socket:num [
126   local-scope
127   load-inputs
128   sink <- receive-from-socket socket, sink
129   socket <- $close-socket socket
130 ]
131 
132 def write-to-socket socket:num, s:text [
133   local-scope
134   load-inputs
135   len:num <- length *s
136   i:num <- copy 0
137   {
138   ¦ done?:bool <- greater-or-equal i, len
139   ¦ break-if done?
140   ¦ c:char <- index *s, i
141   ¦ $write-to-socket socket, c
142   ¦ i <- add i, 1
143   ¦ loop
144   }
145 ]
146 
147 # like split-first, but don't eat the delimiter
148 def split-at text:text, delim:char -> x:text, y:text [
149   local-scope
150   load-inputs
151   # empty text? return empty texts
152   len:num <- length *text
153   {
154   ¦ empty?:bool <- equal len, 0
155   ¦ break-unless empty?
156   ¦ x:text <- new []
157   ¦ y:text <- new []
158   ¦ return
159   }
160   idx:num <- find-next text, delim, 0
161   x:text <- copy-range text, 0, idx
162   y:text <- copy-range text, idx, len
163 ]
164 
165 scenario text-split-at [
166   local-scope
167   x:text <- new [a/b]
168   run [
169   ¦ y:text, z:text <- split-at x, 47/slash
170   ¦ 10:@:char/raw <- copy *y
171   ¦ 20:@:char/raw <- copy *z
172   ]
173   memory-should-contain [
174   ¦ 10:array:character <- [a]
175   ¦ 20:array:character <- [/b]
176   ]
177 ]