! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
USING: channels concurrency.distributed help.markup help.syntax
-io.servers.connection ;
+io.servers ;
IN: channels.remote
HELP: <remote-channel>
USING: tools.test concurrency.distributed kernel io.files
io.files.temp io.directories arrays io.sockets system calendar
combinators threads math sequences concurrency.messaging
-continuations accessors prettyprint io.servers.connection ;
+continuations accessors prettyprint io.servers ;
FROM: concurrency.messaging => receive send ;
IN: concurrency.distributed.tests
test-node-client "thread-a" <remote-thread> send
100 seconds receive-timeout
] unit-test
-] with-threaded-server
\ No newline at end of file
+] with-threaded-server
! Copyright (C) 2005 Chris Double. All Rights Reserved.
! See http://factorcode.org/license.txt for BSD license.
USING: serialize sequences concurrency.messaging threads io
-io.servers.connection io.encodings.binary assocs init
+io.servers io.encodings.binary assocs init
arrays namespaces kernel accessors ;
FROM: io.sockets => host-name <inet> with-client ;
IN: concurrency.distributed
USING: calendar ftp.server io.encodings.ascii io.files
io.files.unique namespaces threads tools.test kernel
-io.servers.connection ftp.client accessors urls
+io.servers ftp.client accessors urls
io.pathnames io.directories sequences fry io.backend
continuations ;
FROM: ftp.client => ftp-get ;
destructors ftp io io.directories io.encodings
io.encodings.8-bit.latin1 io.encodings.binary io.encodings.utf8
io.files io.files.info io.files.types io.pathnames
-io.servers.connection io.sockets io.streams.string io.timeouts
+io.servers io.sockets io.streams.string io.timeouts
kernel logging math math.bitwise math.parser namespaces
sequences simple-tokenizer splitting strings threads
tools.files unicode.case ;
USING: tools.test http furnace.sessions furnace.actions\r
http.server http.server.responses math namespaces make kernel\r
-accessors io.sockets io.servers.connection prettyprint\r
+accessors io.sockets io.servers prettyprint\r
io.streams.string io.files io.files.temp io.directories\r
splitting destructors sequences db db.tuples db.sqlite\r
continuations urls math.parser furnace furnace.utilities ;\r
! Live-fire exercise
USING: http.server.static furnace.sessions furnace.alloy
furnace.actions furnace.auth furnace.auth.login furnace.db
-io.servers.connection io.files io.files.temp io.directories io
+io.servers io.files io.files.temp io.directories io
threads
http.server.responses http.server.redirection furnace.redirection
http.server.dispatchers db.tuples ;
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces assocs kernel io.servers.connection ;
+USING: namespaces assocs kernel io.servers ;
IN: http.server.remapping
SYMBOL: port-remapping
USING: help.markup help.syntax io.streams.string quotations strings urls
-http vocabs.refresh math io.servers.connection assocs ;
+http vocabs.refresh math io.servers assocs ;
IN: http.server
HELP: trivial-responder
} ;
ARTICLE: "http.server" "HTTP server"
-"The " { $vocab-link "http.server" } " vocabulary implements an HTTP and HTTPS server on top of " { $vocab-link "io.servers.connection" } "."
+"The " { $vocab-link "http.server" } " vocabulary implements an HTTP and HTTPS server on top of " { $vocab-link "io.servers" } "."
{ $subsections
"http.server.responders"
"http.server.requests"
io.streams.limited
io.streams.string
io.streams.throwing
-io.servers.connection
+io.servers
io.timeouts
io.crlf
fry logging logging.insomniac calendar urls urls.encoding
--- /dev/null
+Slava Pestov
+++ /dev/null
-Slava Pestov
+++ /dev/null
-USING: calendar classes concurrency.semaphores help.markup
-help.syntax io io.sockets io.sockets.secure math quotations ;
-IN: io.servers.connection
-
-ARTICLE: "server-config" "Threaded server configuration"
-"The " { $link threaded-server } " tuple has a variety of slots which can be set before starting the server with " { $link start-server } "."
-{ $subsections
- "server-config-logging"
- "server-config-listen"
- "server-config-limit"
- "server-config-stream"
- "server-config-handler"
-} ;
-
-ARTICLE: "server-config-logging" "Logging connections"
-"The " { $snippet "name" } " slot of a threaded server instance should be set to a string naming the logging service name to use. See " { $link "logging" } " for details." ;
-
-ARTICLE: "server-config-listen" "Setting ports to listen on"
-"The " { $snippet "insecure" } " slot of a threaded server instance contains an integer, an address specifier, or a sequence of address specifiers. Integer port numbers are interpreted as an " { $link inet4 } "/" { $link inet6 } " pair listening on all interfaces for given port number. All other address specifiers are interpeted as per " { $link "network-addressing" } "."
-$nl
-"The " { $snippet "secure" } " slot of a threaded server instance is interpreted in the same manner as the " { $snippet "insecure" } " slot, except that secure encrypted connections are then allowed. If this slot is set, the " { $snippet "secure-config" } " slot should also be set to a " { $link secure-config } " instance containing SSL server configuration. See " { $link "ssl-config" } " for details."
-$nl
-"Two utility words for producing address specifiers:"
-{ $subsections
- local-server
- internet-server
-} ;
-
-ARTICLE: "server-config-limit" "Limiting connections"
-"The " { $snippet "max-connections" } " slot is initially set to " { $link f } ", which disables connection limiting, but can be set to an integer specifying the maximum number of simultaneous connections."
-$nl
-"Another method to limit connections is to set the " { $snippet "semaphore" } " slot to a " { $link semaphore } ". The server will hold the semaphore while servicing the client connection."
-$nl
-"Setting the " { $snippet "max-connections" } " slot is equivalent to storing a semaphore with this initial count in the " { $snippet "semaphore" } " slot. The " { $snippet "semaphore" } " slot is useful for enforcing a maximum connection count shared between multiple threaded servers. See " { $link "concurrency.semaphores" } " for details." ;
-
-ARTICLE: "server-config-stream" "Client stream parameters"
-"The " { $snippet "encoding" } " and " { $snippet "timeout" } " slots of the threaded server can be set to an encoding descriptor or a " { $link duration } ", respectively. See " { $link "io.encodings" } " and " { $link "io.timeouts" } " for details." ;
-
-ARTICLE: "server-config-handler" "Client handler quotation"
-"The " { $snippet "handler" } " slot of a threaded server instance should be set to a quotation which handles client connections. Client handlers are run in their own thread, with the following variables rebound:"
-{ $list
- { $link input-stream }
- { $link output-stream }
- { $link local-address }
- { $link remote-address }
- { $link threaded-server }
-}
-"An alternate way to implement client handlers is to subclass " { $link threaded-server } ", and define a method on " { $link handle-client* } "."
-$nl
-"The two methods are equivalent, representing a functional versus an object-oriented approach to the problem." ;
-
-ARTICLE: "server-examples" "Threaded server examples"
-"The " { $vocab-link "time-server" } " vocabulary implements a simple threaded server which sends the current time to the client. The " { $vocab-link "concurrency.distributed" } ", " { $vocab-link "ftp.server" } ", and " { $vocab-link "http.server" } " vocabularies demonstrate more complex usage of the threaded server library." ;
-
-ARTICLE: "io.servers.connection" "Threaded servers"
-"The " { $vocab-link "io.servers.connection" } " vocabulary implements a generic server abstraction for " { $link "network-connection" } ". A set of threads listen for connections, and additional threads are spawned for each client connection. In addition to this basic functionality, it provides some advanced features such as logging, connection limits and secure socket support."
-{ $subsections "server-examples" }
-"Creating threaded servers with client handler quotations:"
-{ $subsections <threaded-server> }
-"Client handlers can also be implemented by subclassing a threaded server; see " { $link "server-config-handler" } " for details:"
-{ $subsections
- threaded-server
- new-threaded-server
- handle-client*
-}
-"The server must be configured before it can be started."
-{ $subsections "server-config" }
-"Starting the server:"
-{ $subsections start-server }
-"Stopping the server:"
-{ $subsections stop-server }
-"Waiting for the server to stop:"
-{ $subsections wait-for-server }
-"Combinator for running a server:"
-{ $subsections with-threaded-server }
-"From within the dynamic scope of a client handler, several words can be used to interact with the threaded server:"
-{ $subsections
- stop-this-server
- secure-port
- insecure-port
-}
-"Additionally, the " { $link local-address } " and "
-{ $subsections remote-address } " variables are set, as in " { $link with-client } "." ;
-
-ABOUT: "io.servers.connection"
-
-HELP: threaded-server
-{ $var-description "In client handlers, stores the current threaded server instance." }
-{ $class-description "The class of threaded servers. New instances are created with " { $link <threaded-server> } ". This class may be subclassed, and instances of subclasses should be created with " { $link new-threaded-server } ". See " { $link "server-config" } " for slot documentation." } ;
-
-HELP: new-threaded-server
-{ $values { "encoding" "an encoding descriptor" } { "class" class } { "threaded-server" threaded-server } }
-{ $description "Creates a new instance of a subclass of " { $link threaded-server } ". Subclasses can implement the " { $link handle-client* } " generic word." } ;
-
-HELP: <threaded-server>
-{ $values { "encoding" "an encoding descriptor" } { "threaded-server" threaded-server } }
-{ $description "Creates a new threaded server with streams encoded " { $snippet "encoding" } ". Its slots should be filled in as per " { $link "server-config" } ", before " { $link start-server } " is called to begin waiting for connections." } ;
-
-HELP: remote-address
-{ $var-description "Variable holding the address specifier of the current client connection. See " { $link "network-addressing" } "." } ;
-
-HELP: handle-client*
-{ $values { "threaded-server" threaded-server } }
-{ $contract "Handles a client connection. Default implementation calls quotation stored in the " { $snippet "handler" } " slot of the threaded server." } ;
-
-HELP: start-server
-{ $values { "threaded-server" threaded-server } }
-{ $description "Starts a threaded server and returns after the server is fully running. Throws an error if any of the ports cannot be aquired." }
-{ $notes "Use " { $link stop-server } " or " { $link stop-this-server } " to stop the server." } ;
-
-HELP: stop-server
-{ $values { "threaded-server" threaded-server } }
-{ $description "Stops a threaded server, preventing it from accepting any more connections. All client connections which have already been opened continue to be serviced." } ;
-
-HELP: wait-for-server
-{ $values { "threaded-server" threaded-server } }
-{ $description "Waits for a threaded server to stop serving new connections." } ;
-
-HELP: stop-this-server
-{ $description "Stops the current threaded server, preventing it from accepting any more connections. All client connections which have already been opened continue to be serviced." } ;
-
-HELP: with-threaded-server
-{ $values
- { "threaded-server" threaded-server } { "quot" quotation }
-}
-{ $description "Runs a server and calls a quotation, stopping the server once the quotation returns." } ;
-
-HELP: secure-port
-{ $values { "n/f" { $maybe integer } } }
-{ $description "Outputs one of the port numbers on which the current threaded server accepts secure socket connections. Outputs " { $link f } " if the current threaded server does not accept secure socket connections." }
-{ $notes "Can only be used from the dynamic scope of a " { $link handle-client* } " call." } ;
-
-HELP: insecure-port
-{ $values { "n/f" { $maybe integer } } }
-{ $description "Outputs one of the port numbers on which the current threaded server accepts ordinary socket connections. Outputs " { $link f } " if the current threaded server does not accept ordinary socket connections." }
-{ $notes "Can only be used from the dynamic scope of a " { $link handle-client* } " call." } ;
+++ /dev/null
-USING: accessors calendar concurrency.promises fry io
-io.encodings.ascii io.servers.connection
-io.servers.connection.private io.sockets kernel namespaces
-sequences threads tools.test ;
-IN: io.servers.connection
-
-[ t ] [ ascii <threaded-server> listen-on empty? ] unit-test
-
-[ f ] [
- ascii <threaded-server>
- 25 internet-server >>insecure
- listen-on
- empty?
-] unit-test
-
-[ t ] [
- T{ inet4 f "1.2.3.4" 1234 } T{ inet4 f "1.2.3.5" 1235 }
- [ log-connection ] 2keep
- [ remote-address get = ] [ local-address get = ] bi*
- and
-] unit-test
-
-[ ] [ ascii <threaded-server> init-server drop ] unit-test
-
-[ 10 ] [
- ascii <threaded-server>
- 10 >>max-connections
- init-server semaphore>> count>>
-] unit-test
-
-[ "Hello world." ] [
- ascii <threaded-server>
- 5 >>max-connections
- 0 >>insecure
- [ "Hello world." write stop-this-server ] >>handler
- [
- "localhost" insecure-port <inet> ascii <client> drop stream-contents
- ] with-threaded-server
-] unit-test
-
-[ ] [
- ascii <threaded-server>
- 5 >>max-connections
- 0 >>insecure
- start-server [ '[ _ wait-for-server ] in-thread ] [ stop-server ] bi
-] unit-test
+++ /dev/null
-! Copyright (C) 2003, 2010 Slava Pestov, Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays calendar combinators
-combinators.short-circuit concurrency.combinators
-concurrency.count-downs concurrency.flags
-concurrency.semaphores continuations debugger destructors fry
-io io.sockets io.sockets.secure io.streams.duplex io.styles
-io.timeouts kernel logging make math math.parser namespaces
-present prettyprint random sequences sets strings threads ;
-FROM: namespaces => set ;
-IN: io.servers.connection
-
-TUPLE: threaded-server < identity-tuple
-name
-log-level
-secure
-insecure
-secure-config
-servers
-max-connections
-semaphore
-timeout
-encoding
-handler
-server-stopped
-secure-context ;
-
-SYMBOL: running-servers
-running-servers [ HS{ } clone ] initialize
-
-ERROR: server-already-running threaded-server ;
-
-ERROR: server-not-running threaded-server ;
-
-<PRIVATE
-
-: must-be-running ( threaded-server -- threaded-server )
- dup running-servers get in? [ server-not-running ] unless ;
-
-: must-not-be-running ( threaded-server -- threaded-server )
- dup running-servers get in? [ server-already-running ] when ;
-
-: add-running-server ( threaded-server -- )
- must-not-be-running
- running-servers get adjoin ;
-
-: remove-running-server ( threaded-server -- )
- must-be-running
- running-servers get delete ;
-
-PRIVATE>
-
-: local-server ( port -- addrspec ) "localhost" swap <inet> ;
-
-: internet-server ( port -- addrspec ) f swap <inet> ;
-
-: new-threaded-server ( encoding class -- threaded-server )
- new
- "server" >>name
- DEBUG >>log-level
- <secure-config> >>secure-config
- 1 minutes >>timeout
- [ "No handler quotation" throw ] >>handler
- swap >>encoding ;
-
-: <threaded-server> ( encoding -- threaded-server )
- threaded-server new-threaded-server ;
-
-GENERIC: handle-client* ( threaded-server -- )
-
-<PRIVATE
-
-GENERIC: >insecure ( obj -- obj )
-
-M: inet >insecure 1array ;
-M: inet4 >insecure 1array ;
-M: inet6 >insecure 1array ;
-M: local >insecure 1array ;
-M: integer >insecure internet-server 1array ;
-M: string >insecure internet-server 1array ;
-M: array >insecure [ >insecure ] map ;
-M: f >insecure ;
-
-: >secure ( addrspec -- addrspec' )
- >insecure
- [ dup secure? [ <secure> ] unless ] map ;
-
-: listen-on ( threaded-server -- addrspecs )
- [ secure>> >secure ] [ insecure>> >insecure ] bi append
- [ resolve-host ] map concat ;
-
-: accepted-connection ( remote local -- )
- [
- [ "remote: " % present % ", " % ]
- [ "local: " % present % ]
- bi*
- ] "" make
- \ accepted-connection NOTICE log-message ;
-
-: log-connection ( remote local -- )
- [ accepted-connection ]
- [ [ remote-address set ] [ local-address set ] bi* ]
- 2bi ;
-
-M: threaded-server handle-client* handler>> call( -- ) ;
-
-: handle-client ( client remote local -- )
- '[
- _ _ log-connection
- threaded-server get
- [ timeout>> timeouts ] [ handle-client* ] bi
- ] with-stream ;
-
-\ handle-client NOTICE add-error-logging
-
-: client-thread-name ( addrspec -- string )
- [ threaded-server get name>> ] dip
- unparse-short " connection from " glue ;
-
-: (accept-connection) ( server -- )
- [ accept ] [ addr>> ] bi
- [ '[ _ _ _ handle-client ] ]
- [ drop client-thread-name ] 2bi
- spawn drop ;
-
-: accept-connection ( server -- )
- threaded-server get semaphore>>
- [ [ (accept-connection) ] with-semaphore ]
- [ (accept-connection) ]
- if* ;
-
-: with-existing-secure-context ( threaded-server quot -- )
- [ secure-context>> secure-context ] dip with-variable ; inline
-
-: accept-loop ( server -- )
- [ accept-connection ] [ accept-loop ] bi ;
-
-: start-accept-loop ( threaded-server server -- )
- '[ _ accept-loop ] with-existing-secure-context ;
-
-\ start-accept-loop NOTICE add-error-logging
-
-: create-secure-context ( threaded-server -- threaded-server )
- dup secure>> [
- dup secure-config>> <secure-context> >>secure-context
- ] when ;
-
-: init-server ( threaded-server -- threaded-server )
- create-secure-context
- <flag> >>server-stopped
- dup semaphore>> [
- dup max-connections>> [
- <semaphore> >>semaphore
- ] when*
- ] unless ;
-
-ERROR: no-ports-configured threaded-server ;
-
-: (make-servers) ( theaded-server addrspecs -- servers )
- swap encoding>>
- '[ [ _ <server> |dispose ] map ] with-destructors ;
-
-: set-servers ( threaded-server -- threaded-server )
- dup [
- dup dup listen-on [ no-ports-configured ] [ (make-servers) ] if-empty
- >>servers
- ] with-existing-secure-context ;
-
-: server-thread-name ( threaded-server addrspec -- string )
- [ name>> ] [ addr>> present ] bi* " server on " glue ;
-
-PRIVATE>
-
-: start-server ( threaded-server -- threaded-server )
- init-server
- [
- dup threaded-server [
- [ ] [ name>> ] bi
- [
- set-servers
- dup add-running-server
- dup servers>>
- [
- [ '[ _ _ [ start-accept-loop ] with-disposal ] ]
- [ server-thread-name ] 2bi spawn drop
- ] with each
- ] with-logging
- ] with-variable
- ] keep ;
-
-: server-running? ( threaded-server -- ? )
- server-stopped>> [ value>> not ] [ f ] if* ;
-
-: stop-server ( threaded-server -- )
- dup server-running? [
- [ remove-running-server ]
- [
- [
- [ secure-context>> [ &dispose drop ] when* ]
- [ [ f ] change-servers drop dispose-each ] bi
- ] with-destructors
- ]
- [ server-stopped>> raise-flag ] tri
- ] [
- drop
- ] if ;
-
-: stop-this-server ( -- )
- threaded-server get stop-server ;
-
-: wait-for-server ( threaded-server -- )
- server-stopped>> wait-for-flag ;
-
-: with-threaded-server ( threaded-server quot -- )
- [ start-server ] dip over
- '[
- [ _ threaded-server _ with-variable ]
- [ _ stop-server ]
- [ ] cleanup
- ] call ; inline
-
-<PRIVATE
-
-: first-port ( quot -- n/f )
- [ threaded-server get servers>> ] dip
- filter [ f ] [ first addr>> port>> ] if-empty ; inline
-
-PRIVATE>
-
-: secure-port ( -- n/f ) [ addr>> secure? ] first-port ;
-
-: insecure-port ( -- n/f ) [ addr>> secure? not ] first-port ;
-
-: secure-addr ( -- inet )
- threaded-server get servers>> [ addr>> secure? ] filter random ;
-
-: insecure-addr ( -- inet )
- threaded-server get servers>> [ addr>> secure? not ] filter random addr>> ;
-
-: server. ( threaded-server -- )
- [ [ "=== " write name>> ] [ ] bi write-object nl ]
- [ servers>> [ addr>> present print ] each ] bi ;
-
-: all-servers ( -- sequence )
- running-servers get-global members ;
-
-: get-servers-named ( string -- sequence )
- [ all-servers ] dip '[ name>> _ = ] filter ;
-
-: servers. ( -- )
- all-servers [ server. ] each ;
-
-: stop-all-servers ( -- )
- all-servers [ stop-server ] each ;
+++ /dev/null
-Multi-threaded TCP/IP servers
--- /dev/null
+USING: calendar classes concurrency.semaphores help.markup
+help.syntax io io.sockets io.sockets.secure math quotations ;
+IN: io.servers
+
+ARTICLE: "server-config" "Threaded server configuration"
+"The " { $link threaded-server } " tuple has a variety of slots which can be set before starting the server with " { $link start-server } "."
+{ $subsections
+ "server-config-logging"
+ "server-config-listen"
+ "server-config-limit"
+ "server-config-stream"
+ "server-config-handler"
+} ;
+
+ARTICLE: "server-config-logging" "Logging connections"
+"The " { $snippet "name" } " slot of a threaded server instance should be set to a string naming the logging service name to use. See " { $link "logging" } " for details." ;
+
+ARTICLE: "server-config-listen" "Setting ports to listen on"
+"The " { $snippet "insecure" } " slot of a threaded server instance contains an integer, an address specifier, or a sequence of address specifiers. Integer port numbers are interpreted as an " { $link inet4 } "/" { $link inet6 } " pair listening on all interfaces for given port number. All other address specifiers are interpeted as per " { $link "network-addressing" } "."
+$nl
+"The " { $snippet "secure" } " slot of a threaded server instance is interpreted in the same manner as the " { $snippet "insecure" } " slot, except that secure encrypted connections are then allowed. If this slot is set, the " { $snippet "secure-config" } " slot should also be set to a " { $link secure-config } " instance containing SSL server configuration. See " { $link "ssl-config" } " for details."
+$nl
+"Two utility words for producing address specifiers:"
+{ $subsections
+ local-server
+ internet-server
+} ;
+
+ARTICLE: "server-config-limit" "Limiting connections"
+"The " { $snippet "max-connections" } " slot is initially set to " { $link f } ", which disables connection limiting, but can be set to an integer specifying the maximum number of simultaneous connections."
+$nl
+"Another method to limit connections is to set the " { $snippet "semaphore" } " slot to a " { $link semaphore } ". The server will hold the semaphore while servicing the client connection."
+$nl
+"Setting the " { $snippet "max-connections" } " slot is equivalent to storing a semaphore with this initial count in the " { $snippet "semaphore" } " slot. The " { $snippet "semaphore" } " slot is useful for enforcing a maximum connection count shared between multiple threaded servers. See " { $link "concurrency.semaphores" } " for details." ;
+
+ARTICLE: "server-config-stream" "Client stream parameters"
+"The " { $snippet "encoding" } " and " { $snippet "timeout" } " slots of the threaded server can be set to an encoding descriptor or a " { $link duration } ", respectively. See " { $link "io.encodings" } " and " { $link "io.timeouts" } " for details." ;
+
+ARTICLE: "server-config-handler" "Client handler quotation"
+"The " { $snippet "handler" } " slot of a threaded server instance should be set to a quotation which handles client connections. Client handlers are run in their own thread, with the following variables rebound:"
+{ $list
+ { $link input-stream }
+ { $link output-stream }
+ { $link local-address }
+ { $link remote-address }
+ { $link threaded-server }
+}
+"An alternate way to implement client handlers is to subclass " { $link threaded-server } ", and define a method on " { $link handle-client* } "."
+$nl
+"The two methods are equivalent, representing a functional versus an object-oriented approach to the problem." ;
+
+ARTICLE: "server-examples" "Threaded server examples"
+"The " { $vocab-link "time-server" } " vocabulary implements a simple threaded server which sends the current time to the client. The " { $vocab-link "concurrency.distributed" } ", " { $vocab-link "ftp.server" } ", and " { $vocab-link "http.server" } " vocabularies demonstrate more complex usage of the threaded server library." ;
+
+ARTICLE: "io.servers" "Threaded servers"
+"The " { $vocab-link "io.servers" } " vocabulary implements a generic server abstraction for " { $link "network-connection" } ". A set of threads listen for connections, and additional threads are spawned for each client connection. In addition to this basic functionality, it provides some advanced features such as logging, connection limits and secure socket support."
+{ $subsections "server-examples" }
+"Creating threaded servers with client handler quotations:"
+{ $subsections <threaded-server> }
+"Client handlers can also be implemented by subclassing a threaded server; see " { $link "server-config-handler" } " for details:"
+{ $subsections
+ threaded-server
+ new-threaded-server
+ handle-client*
+}
+"The server must be configured before it can be started."
+{ $subsections "server-config" }
+"Starting the server:"
+{ $subsections start-server }
+"Stopping the server:"
+{ $subsections stop-server }
+"Waiting for the server to stop:"
+{ $subsections wait-for-server }
+"Combinator for running a server:"
+{ $subsections with-threaded-server }
+"From within the dynamic scope of a client handler, several words can be used to interact with the threaded server:"
+{ $subsections
+ stop-this-server
+ secure-port
+ insecure-port
+}
+"Additionally, the " { $link local-address } " and "
+{ $subsections remote-address } " variables are set, as in " { $link with-client } "." ;
+
+ABOUT: "io.servers"
+
+HELP: threaded-server
+{ $var-description "In client handlers, stores the current threaded server instance." }
+{ $class-description "The class of threaded servers. New instances are created with " { $link <threaded-server> } ". This class may be subclassed, and instances of subclasses should be created with " { $link new-threaded-server } ". See " { $link "server-config" } " for slot documentation." } ;
+
+HELP: new-threaded-server
+{ $values { "encoding" "an encoding descriptor" } { "class" class } { "threaded-server" threaded-server } }
+{ $description "Creates a new instance of a subclass of " { $link threaded-server } ". Subclasses can implement the " { $link handle-client* } " generic word." } ;
+
+HELP: <threaded-server>
+{ $values { "encoding" "an encoding descriptor" } { "threaded-server" threaded-server } }
+{ $description "Creates a new threaded server with streams encoded " { $snippet "encoding" } ". Its slots should be filled in as per " { $link "server-config" } ", before " { $link start-server } " is called to begin waiting for connections." } ;
+
+HELP: remote-address
+{ $var-description "Variable holding the address specifier of the current client connection. See " { $link "network-addressing" } "." } ;
+
+HELP: handle-client*
+{ $values { "threaded-server" threaded-server } }
+{ $contract "Handles a client connection. Default implementation calls quotation stored in the " { $snippet "handler" } " slot of the threaded server." } ;
+
+HELP: start-server
+{ $values { "threaded-server" threaded-server } }
+{ $description "Starts a threaded server and returns after the server is fully running. Throws an error if any of the ports cannot be aquired." }
+{ $notes "Use " { $link stop-server } " or " { $link stop-this-server } " to stop the server." } ;
+
+HELP: stop-server
+{ $values { "threaded-server" threaded-server } }
+{ $description "Stops a threaded server, preventing it from accepting any more connections. All client connections which have already been opened continue to be serviced." } ;
+
+HELP: wait-for-server
+{ $values { "threaded-server" threaded-server } }
+{ $description "Waits for a threaded server to stop serving new connections." } ;
+
+HELP: stop-this-server
+{ $description "Stops the current threaded server, preventing it from accepting any more connections. All client connections which have already been opened continue to be serviced." } ;
+
+HELP: with-threaded-server
+{ $values
+ { "threaded-server" threaded-server } { "quot" quotation }
+}
+{ $description "Runs a server and calls a quotation, stopping the server once the quotation returns." } ;
+
+HELP: secure-port
+{ $values { "n/f" { $maybe integer } } }
+{ $description "Outputs one of the port numbers on which the current threaded server accepts secure socket connections. Outputs " { $link f } " if the current threaded server does not accept secure socket connections." }
+{ $notes "Can only be used from the dynamic scope of a " { $link handle-client* } " call." } ;
+
+HELP: insecure-port
+{ $values { "n/f" { $maybe integer } } }
+{ $description "Outputs one of the port numbers on which the current threaded server accepts ordinary socket connections. Outputs " { $link f } " if the current threaded server does not accept ordinary socket connections." }
+{ $notes "Can only be used from the dynamic scope of a " { $link handle-client* } " call." } ;
--- /dev/null
+USING: accessors calendar concurrency.promises fry io
+io.encodings.ascii io.servers
+io.servers.private io.sockets kernel namespaces
+sequences threads tools.test ;
+IN: io.servers
+
+[ t ] [ ascii <threaded-server> listen-on empty? ] unit-test
+
+[ f ] [
+ ascii <threaded-server>
+ 25 internet-server >>insecure
+ listen-on
+ empty?
+] unit-test
+
+[ t ] [
+ T{ inet4 f "1.2.3.4" 1234 } T{ inet4 f "1.2.3.5" 1235 }
+ [ log-connection ] 2keep
+ [ remote-address get = ] [ local-address get = ] bi*
+ and
+] unit-test
+
+[ ] [ ascii <threaded-server> init-server drop ] unit-test
+
+[ 10 ] [
+ ascii <threaded-server>
+ 10 >>max-connections
+ init-server semaphore>> count>>
+] unit-test
+
+[ "Hello world." ] [
+ ascii <threaded-server>
+ 5 >>max-connections
+ 0 >>insecure
+ [ "Hello world." write stop-this-server ] >>handler
+ [
+ "localhost" insecure-port <inet> ascii <client> drop stream-contents
+ ] with-threaded-server
+] unit-test
+
+[ ] [
+ ascii <threaded-server>
+ 5 >>max-connections
+ 0 >>insecure
+ start-server [ '[ _ wait-for-server ] in-thread ] [ stop-server ] bi
+] unit-test
--- /dev/null
+! Copyright (C) 2003, 2010 Slava Pestov, Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays calendar combinators
+combinators.short-circuit concurrency.combinators
+concurrency.count-downs concurrency.flags
+concurrency.semaphores continuations debugger destructors fry
+io io.sockets io.sockets.secure io.streams.duplex io.styles
+io.timeouts kernel logging make math math.parser namespaces
+present prettyprint random sequences sets strings threads ;
+FROM: namespaces => set ;
+IN: io.servers
+
+TUPLE: threaded-server < identity-tuple
+name
+log-level
+secure
+insecure
+secure-config
+servers
+max-connections
+semaphore
+timeout
+encoding
+handler
+server-stopped
+secure-context ;
+
+SYMBOL: running-servers
+running-servers [ HS{ } clone ] initialize
+
+ERROR: server-already-running threaded-server ;
+
+ERROR: server-not-running threaded-server ;
+
+<PRIVATE
+
+: must-be-running ( threaded-server -- threaded-server )
+ dup running-servers get in? [ server-not-running ] unless ;
+
+: must-not-be-running ( threaded-server -- threaded-server )
+ dup running-servers get in? [ server-already-running ] when ;
+
+: add-running-server ( threaded-server -- )
+ must-not-be-running
+ running-servers get adjoin ;
+
+: remove-running-server ( threaded-server -- )
+ must-be-running
+ running-servers get delete ;
+
+PRIVATE>
+
+: local-server ( port -- addrspec ) "localhost" swap <inet> ;
+
+: internet-server ( port -- addrspec ) f swap <inet> ;
+
+: new-threaded-server ( encoding class -- threaded-server )
+ new
+ "server" >>name
+ DEBUG >>log-level
+ <secure-config> >>secure-config
+ 1 minutes >>timeout
+ [ "No handler quotation" throw ] >>handler
+ swap >>encoding ;
+
+: <threaded-server> ( encoding -- threaded-server )
+ threaded-server new-threaded-server ;
+
+GENERIC: handle-client* ( threaded-server -- )
+
+<PRIVATE
+
+GENERIC: >insecure ( obj -- obj )
+
+M: inet >insecure 1array ;
+M: inet4 >insecure 1array ;
+M: inet6 >insecure 1array ;
+M: local >insecure 1array ;
+M: integer >insecure internet-server 1array ;
+M: string >insecure internet-server 1array ;
+M: array >insecure [ >insecure ] map ;
+M: f >insecure ;
+
+: >secure ( addrspec -- addrspec' )
+ >insecure
+ [ dup secure? [ <secure> ] unless ] map ;
+
+: listen-on ( threaded-server -- addrspecs )
+ [ secure>> >secure ] [ insecure>> >insecure ] bi append
+ [ resolve-host ] map concat ;
+
+: accepted-connection ( remote local -- )
+ [
+ [ "remote: " % present % ", " % ]
+ [ "local: " % present % ]
+ bi*
+ ] "" make
+ \ accepted-connection NOTICE log-message ;
+
+: log-connection ( remote local -- )
+ [ accepted-connection ]
+ [ [ remote-address set ] [ local-address set ] bi* ]
+ 2bi ;
+
+M: threaded-server handle-client* handler>> call( -- ) ;
+
+: handle-client ( client remote local -- )
+ '[
+ _ _ log-connection
+ threaded-server get
+ [ timeout>> timeouts ] [ handle-client* ] bi
+ ] with-stream ;
+
+\ handle-client NOTICE add-error-logging
+
+: client-thread-name ( addrspec -- string )
+ [ threaded-server get name>> ] dip
+ unparse-short " connection from " glue ;
+
+: (accept-connection) ( server -- )
+ [ accept ] [ addr>> ] bi
+ [ '[ _ _ _ handle-client ] ]
+ [ drop client-thread-name ] 2bi
+ spawn drop ;
+
+: accept-connection ( server -- )
+ threaded-server get semaphore>>
+ [ [ (accept-connection) ] with-semaphore ]
+ [ (accept-connection) ]
+ if* ;
+
+: with-existing-secure-context ( threaded-server quot -- )
+ [ secure-context>> secure-context ] dip with-variable ; inline
+
+: accept-loop ( server -- )
+ [ accept-connection ] [ accept-loop ] bi ;
+
+: start-accept-loop ( threaded-server server -- )
+ '[ _ accept-loop ] with-existing-secure-context ;
+
+\ start-accept-loop NOTICE add-error-logging
+
+: create-secure-context ( threaded-server -- threaded-server )
+ dup secure>> [
+ dup secure-config>> <secure-context> >>secure-context
+ ] when ;
+
+: init-server ( threaded-server -- threaded-server )
+ create-secure-context
+ <flag> >>server-stopped
+ dup semaphore>> [
+ dup max-connections>> [
+ <semaphore> >>semaphore
+ ] when*
+ ] unless ;
+
+ERROR: no-ports-configured threaded-server ;
+
+: (make-servers) ( theaded-server addrspecs -- servers )
+ swap encoding>>
+ '[ [ _ <server> |dispose ] map ] with-destructors ;
+
+: set-servers ( threaded-server -- threaded-server )
+ dup [
+ dup dup listen-on [ no-ports-configured ] [ (make-servers) ] if-empty
+ >>servers
+ ] with-existing-secure-context ;
+
+: server-thread-name ( threaded-server addrspec -- string )
+ [ name>> ] [ addr>> present ] bi* " server on " glue ;
+
+PRIVATE>
+
+: start-server ( threaded-server -- threaded-server )
+ init-server
+ [
+ dup threaded-server [
+ [ ] [ name>> ] bi
+ [
+ set-servers
+ dup add-running-server
+ dup servers>>
+ [
+ [ '[ _ _ [ start-accept-loop ] with-disposal ] ]
+ [ server-thread-name ] 2bi spawn drop
+ ] with each
+ ] with-logging
+ ] with-variable
+ ] keep ;
+
+: server-running? ( threaded-server -- ? )
+ server-stopped>> [ value>> not ] [ f ] if* ;
+
+: stop-server ( threaded-server -- )
+ dup server-running? [
+ [ remove-running-server ]
+ [
+ [
+ [ secure-context>> [ &dispose drop ] when* ]
+ [ [ f ] change-servers drop dispose-each ] bi
+ ] with-destructors
+ ]
+ [ server-stopped>> raise-flag ] tri
+ ] [
+ drop
+ ] if ;
+
+: stop-this-server ( -- )
+ threaded-server get stop-server ;
+
+: wait-for-server ( threaded-server -- )
+ server-stopped>> wait-for-flag ;
+
+: with-threaded-server ( threaded-server quot -- )
+ [ start-server ] dip over
+ '[
+ [ _ threaded-server _ with-variable ]
+ [ _ stop-server ]
+ [ ] cleanup
+ ] call ; inline
+
+<PRIVATE
+
+: first-port ( quot -- n/f )
+ [ threaded-server get servers>> ] dip
+ filter [ f ] [ first addr>> port>> ] if-empty ; inline
+
+PRIVATE>
+
+: secure-port ( -- n/f ) [ addr>> secure? ] first-port ;
+
+: insecure-port ( -- n/f ) [ addr>> secure? not ] first-port ;
+
+: secure-addr ( -- inet )
+ threaded-server get servers>> [ addr>> secure? ] filter random ;
+
+: insecure-addr ( -- inet )
+ threaded-server get servers>> [ addr>> secure? not ] filter random addr>> ;
+
+: server. ( threaded-server -- )
+ [ [ "=== " write name>> ] [ ] bi write-object nl ]
+ [ servers>> [ addr>> present print ] each ] bi ;
+
+: all-servers ( -- sequence )
+ running-servers get-global members ;
+
+: get-servers-named ( string -- sequence )
+ [ all-servers ] dip '[ name>> _ = ] filter ;
+
+: servers. ( -- )
+ all-servers [ server. ] each ;
+
+: stop-all-servers ( -- )
+ all-servers [ stop-server ] each ;
--- /dev/null
+Multi-threaded TCP/IP servers
{ { $link inet4 } " - a TCP/IP connection to an IPv4 address and port number; no name lookup is performed" }
{ { $link inet6 } " - a TCP/IP connection to an IPv6 address and port number; no name lookup is performed" }
}
-"The " { $vocab-link "io.servers.connection" } " library defines high-level wrappers around " { $link <server> } " which makes it easy to listen for IPv4, IPv6 and secure socket connections simultaneously, perform logging, and optionally only allow connections from the loopback interface."
+"The " { $vocab-link "io.servers" } " library defines high-level wrappers around " { $link <server> } " which makes it easy to listen for IPv4, IPv6 and secure socket connections simultaneously, perform logging, and optionally only allow connections from the loopback interface."
$nl
"The " { $vocab-link "io.sockets.secure" } " vocabulary implements secure, encrypted sockets via SSL and TLS." ;
{ $code "f 1234 <inet> resolve-host" }
"To start a server which listens for connections from the loopback interface only, use an address specifier returned by the following code, where 1234 is the desired port number:"
{ $code "\"localhost\" 1234 <inet> resolve-host" }
- "Since " { $link resolve-host } " can return multiple address specifiers, your server code must listen on them all to work properly. The " { $vocab-link "io.servers.connection" } " vocabulary can be used to help with this."
+ "Since " { $link resolve-host } " can return multiple address specifiers, your server code must listen on them all to work properly. The " { $vocab-link "io.servers" } " vocabulary can be used to help with this."
$nl
"To start a TCP/IP server which listens for connections on a randomly-assigned port, set the port number in the address specifier to 0, and then read the " { $snippet "addr" } " slot of the server instance to obtain the actual port number it is listening on:"
{ $unchecked-example
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs continuations fry http.server io
io.encodings.ascii io.files io.files.unique
-io.servers.connection io.streams.duplex io.streams.string
+io.servers io.streams.duplex io.streams.string
kernel math.ranges mime.multipart multiline namespaces random
sequences strings threads tools.test ;
IN: mime.multipart.tests
] each
USING: http.client http.server http.server.dispatchers
-http.server.responses http.server.static io.servers.connection ;
+http.server.responses http.server.static io.servers ;
SINGLETON: quit-responder
! Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors debugger io io.encodings.utf8 io.servers.connection
+USING: accessors debugger io io.encodings.utf8 io.servers
kernel listener math namespaces ;
-
IN: fuel.remote
<PRIVATE
}
{ $slide "Example: time server"
{ $vocab-link "time-server" }
- { "Demonstrates " { $vocab-link "io.servers.connection" } " vocabulary, threads" }
+ { "Demonstrates " { $vocab-link "io.servers" } " vocabulary, threads" }
}
{ $slide "Example: what is my IP?"
{ $vocab-link "webapps.ip" }
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs calendar continuations destructors io
-io.encodings.binary io.servers.connection io.sockets
+io.encodings.binary io.servers io.sockets
io.streams.duplex fry kernel locals math math.ranges multiline
namespaces prettyprint random sequences sets splitting threads
tools.continuations ;
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors calendar calendar.format io io.encodings.ascii
-io.servers.connection kernel threads ;
+io.servers kernel threads ;
IN: time-server
: handle-time-client ( -- )
-USING: listener io.servers.connection io.encodings.utf8
-accessors kernel ;
+USING: listener io.servers io.encodings.utf8 accessors kernel ;
IN: tty-server
: <tty-server> ( port -- )
furnace.boilerplate furnace.redirection html.forms http.server
http.server.dispatchers kernel namespaces site-watcher site-watcher.db
site-watcher.private urls validators io.sockets.secure.unix.debug
-io.servers.connection io.files.temp db db.tuples sequences
+io.servers io.files.temp db db.tuples sequences
webapps.site-watcher.common webapps.site-watcher.watching
webapps.site-watcher.spidering ;
QUALIFIED: assocs
furnace.auth.features.deactivate-user
db.sqlite
furnace.alloy
-io.servers.connection
+io.servers
io.sockets.secure ;
: <login-config> ( responder -- responder' )
! Copyright (c) 2008, 2010 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel sequences assocs io.files io.pathnames
-io.sockets io.sockets.secure io.servers.connection
+io.sockets io.sockets.secure io.servers
namespaces db db.tuples db.sqlite smtp urls
logging.insomniac
html.templates.chloe
projects / factor.git / commitdiff