From 58c9986f8755d366fb9da0e831032e556ce6f92b Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jobim.local>
Date: Fri, 29 May 2009 11:20:40 -0500
Subject: [PATCH] add managed-server to extra/

---
 extra/managed-server/authors.txt           |  1 +
 extra/managed-server/chat/authors.txt      |  1 +
 extra/managed-server/chat/chat.factor      | 23 ++++++++
 extra/managed-server/managed-server.factor | 63 ++++++++++++++++++++++
 4 files changed, 88 insertions(+)
 create mode 100644 extra/managed-server/authors.txt
 create mode 100644 extra/managed-server/chat/authors.txt
 create mode 100644 extra/managed-server/chat/chat.factor
 create mode 100644 extra/managed-server/managed-server.factor

diff --git a/extra/managed-server/authors.txt b/extra/managed-server/authors.txt
new file mode 100644
index 0000000000..b4bd0e7b35
--- /dev/null
+++ b/extra/managed-server/authors.txt
@@ -0,0 +1 @@
+Doug Coleman
\ No newline at end of file
diff --git a/extra/managed-server/chat/authors.txt b/extra/managed-server/chat/authors.txt
new file mode 100644
index 0000000000..b4bd0e7b35
--- /dev/null
+++ b/extra/managed-server/chat/authors.txt
@@ -0,0 +1 @@
+Doug Coleman
\ No newline at end of file
diff --git a/extra/managed-server/chat/chat.factor b/extra/managed-server/chat/chat.factor
new file mode 100644
index 0000000000..7cd4db58f7
--- /dev/null
+++ b/extra/managed-server/chat/chat.factor
@@ -0,0 +1,23 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs fry io kernel managed-server
+namespaces sequences ;
+IN: managed-server.chat
+
+TUPLE: chat-server < managed-server ;
+
+: <chat-server> ( port -- managed-server )
+    "chat-server" chat-server new-managed-server ;
+
+M: chat-server handle-managed-client*
+    clients>>
+    readln dup empty? [
+        2drop
+    ] [
+        '[
+            nip output-stream>>
+            [
+                client get username>> ": " _ 3append print flush
+            ] with-output-stream*
+        ] assoc-each
+    ] if ;
diff --git a/extra/managed-server/managed-server.factor b/extra/managed-server/managed-server.factor
new file mode 100644
index 0000000000..2a9df2ae8a
--- /dev/null
+++ b/extra/managed-server/managed-server.factor
@@ -0,0 +1,63 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs calendar continuations io
+io.encodings.binary io.servers.connection io.sockets
+io.streams.duplex kernel locals math math.ranges multiline
+namespaces prettyprint random sequences sets splitting threads
+tools.continuations ;
+IN: managed-server
+
+SYMBOL: client
+
+TUPLE: managed-server < threaded-server clients ;
+
+TUPLE: managed-client input-stream output-stream local-address
+remote-address username ;
+
+GENERIC: login ( managed-server -- username )
+GENERIC: handle-managed-client* ( threaded-server -- )
+
+ERROR: already-logged-in username ;
+ERROR: bad-login username ;
+
+<PRIVATE
+
+: <managed-client> ( username -- managed-client )
+    managed-client new
+        swap >>username
+        input-stream get >>input-stream
+        output-stream get >>output-stream
+        local-address get >>local-address
+        remote-address get >>remote-address ;
+
+: check-logged-in ( username -- username )
+    dup threaded-server get clients>> key? [ already-logged-in ] when ;
+
+: add-managed-client ( managed-client -- )
+    dup username>>
+    threaded-server get clients>> set-at ;
+
+: delete-managed-client ( -- )
+    client get username>>
+    threaded-server get clients>> delete-at ;
+
+: handle-managed-client ( -- )
+    [ [ threaded-server get handle-managed-client* t ] loop ]
+    [ delete-managed-client ]
+    [ ] cleanup ;
+
+PRIVATE>
+
+M: managed-server login drop readln ;
+
+M: managed-server handle-client*
+    login <managed-client>
+    [ client set ] [ add-managed-client ] bi
+    handle-managed-client ;
+
+: new-managed-server ( port name class -- server )
+    new-threaded-server
+        swap >>name
+        swap >>insecure
+        f >>timeout
+        H{ } clone >>clients ; inline