Monday, October 21, 2013

Xmonad Tweaks

Just a quickie to share a tweak I had to make to my xmonad.hs. Not sure if there's a better way to do this, but hey.

The goal was to finally, actually get working hibernation on my laptop. I usually use it in short bursts, so I just got used to shutting it down between sessions. However, I recently started using a work laptop running Windows 7 and hibernation has been useful there[1], and I'll be damned if the non-free shitbox is going to have a mildly useful feature that my machine doesn't.

The way you get a Debian machine to hibernate or suspend is with the appropriately named pm-hibernate and pm-suspend commands[2], so I figured this would be a fairly easy key binding

...
, ("C-t C-<Delete>", spawn "pm-suspend")
, ("C-t <Delete>", spawn "pm-hibernate")
...

Unfortunately, the pm-* are root user commands. And Xmonad doesn't automatically prompt for a password when you do something like su -c pm-suspend. And, unlike with sudo, you can't pass a password into su. So that approach is right out.

I googled around for alternatives for a little while, but What I ended up doing was finally adding myself to the sudo group, and defining this function for my own nefarious purposes

sudoSpawn command = withPrompt "Password" $ run command
  where run command password = spawn $ concat ["echo ", password, " | sudo -S ", command]

withPrompt is another little utility piece I had written for some desktop changers; it's defined as

withPrompt prompt fn = inputPrompt xpConf prompt ?+ fn

The above defined, I can now bind super-user commands to Xmonad keystrokes

...
, ("C-t C-<Delete>", sudoSpawn "pm-suspend")
, ("C-t <Delete>", sudoSpawn "pm-hibernate")
...

with the caveat that I need to enter my password each time I invoke these. I'll see if that's too annoying. Worst case scenario, I'll pull some trickery to cache it the first time I enter it.

Just in case you care, my complete xmonad.hs now looks like:

import System.Directory
import XMonad
import XMonad.Actions.CycleWS
import XMonad.Actions.CycleWindows
import XMonad.Actions.WindowGo
import XMonad.Actions.GridSelect
import XMonad.Prompt
import XMonad.Prompt.Input
import XMonad.Util.EZConfig
import XMonad.Util.CustomKeys

import qualified XMonad.StackSet as S

main = xmonad $ conf
       `additionalKeysP`
       [ ("C-t C-d C-b", withFilePrompt "Pic: " bgFolder setDesktopBackground)
       , ("<Print>", withFilePrompt "Name: " screenshotFolder capToFile)
         
       , ("C-t C-<Delete>", sudoSpawn "pm-suspend")
       , ("C-t <Delete>", sudoSpawn "pm-hibernate")
         
       , ("C-t p", spawn "dmenu_run")
       , ("C-t C-p", spawn "dmenu_run")
       , ("C-t <Return>", spawn "xterm")
       , ("C-t e", runOrRaise "emacs" (className =? "Emacs"))
       , ("C-t C-e", runOrRaise "emacs" (className =? "Emacs"))
       , ("C-t b", spawn "chromium --proxy-server=\"socks://localhost:9050\" --incognito")
       , ("C-t C-b", spawn "chromium --proxy-server=\"socks://localhost:9050\" --user-agent=\"Mozilla/5.0 (Windows NT 5.1) AppleWebKit/537.4 (KHTML, like Gecko) Chrome/22.0.1229.94 Safari/537.4\"")
         
       , ("C-t s", nextWS)
       , ("C-t C-s", prevWS)
       , ("C-t w", toggleWS)
       , ("C-t C-w", toggleWS)
       , ("C-t C-t", windowSwap)
       , ("C-t t", windows S.swapDown)
       , ("C-t C-j", windows S.swapDown)
       , ("C-t j", windows S.focusDown)
       , ("C-t k", windows S.focusUp)
       , ("C-t C-k", windows S.swapUp)
       , ("C-t g", goToSelected defaultGSConfig)
         
       , ("C-t C-<Space>", sendMessage NextLayout)
       , ("C-t C-h", sendMessage Shrink)
       , ("C-t C-l", sendMessage Expand)
         
       ]
  where conf = defaultConfig { XMonad.startupHook = onStartup, modMask = mod4Mask }

---------- Config Options
bgFolder = "/home/inaimathi/pictures/backgrounds/"
screenshotFolder = "/home/inaimathi/pictures/screenshots/"

onStartup :: X ()
onStartup = do
  spawn "set-monitors"
  spawn "pmount /dev/mmcblk0p1"
  setDesktopBackground "edge-of-the-world.jpg"

---------- Helper Functions
setDesktopBackground :: MonadIO m => String -> m ()
setDesktopBackground pic = spawn $ concat ["feh --no-xinerama --bg-fill ", bgFolder, pic]
        
capToFile :: MonadIO m => String -> m ()
capToFile picName = spawn $ concat ["import ", screenshotFolder, picName]

sudoSpawn command = withPrompt "Password" $ run command
  where run command password = spawn $ concat ["echo ", password, " | sudo -S ", command]

---------- Utility
windowSwap = do
  windows S.focusDown
  windows S.swapUp

xpConf = defaultXPConfig { position = Top }

withPrompt prompt fn = inputPrompt xpConf prompt ?+ fn

withCompletingPrompt prompt completions fn = 
  inputPromptWithCompl xpConf prompt comp ?+ fn
  where comp = mkComplFunFromList completions

withFilePrompt prompt directory fn = do
  files <- liftIO $ getDirectoryContents directory
  let fs = filter relevant files
      relevant f = '.' /= head f
  withCompletingPrompt prompt fs fn

Footnotes

1 - [back] - Granted, because the boot time on that machine is something like 5 minutes instead of the 12 seconds I'm used to waiting, Hibernate is a goddamn necessity, but I digress.

2 - [back] - Ideally, I'd just be using hibernate, but there are some issues. I've upgraded my ram since installing the OS, which means that my swap partition isn't big enough to store a memory dump, and I can't seem to resize it with gparted, with or without swapoff/swapon magic. Luckily, I've had a larger hard drive waiting for me to crack open the box and configure it to my liking, so I'll just do that this week rather than procrastinating. In the meantime though, I'm suspending instead.

Saturday, October 19, 2013

defsetf Examples

Have you ever defined a custom class with hash components? Something like, say, a session?

(defclass session ()
  ((started :reader started :initform (get-universal-time))
   (last-poked :accessor last-poked :initform (get-universal-time))
   (token :reader token :initarg :token)
   (session-values :reader session-values :initform (make-hash-table :test 'equal))))

If you have, you probably also figured it would be better to define some sugar for look-ups rather than doing (gethash foo (session-values bar)) every damn time. Something like

(defmethod lookup (key (session session))
  (gethash key (session-values session)))

And if you've gotten that far, you probably noticed that you can't just go ahead and say (setf (lookup :test foo) new-val), because if you tried, you'd get this

The function (COMMON-LISP:SETF COMMON-LISP-USER::LOOKUP) is undefined.
   [Condition of type UNDEFINED-FUNCTION]

Restarts:
 0: [RETRY] Retry SLIME REPL evaluation request.
 1: [*ABORT] Return to SLIME's top level.
 2: [ABORT] Abort thread (#<THREAD "repl-thread" RUNNING {10047D0113}>)

There are two ways of fixing this.

If You Don't Need CLOS Support

For instance, if your lookup is a function rather than a method, you can get away with doing something like this

(defsetf lookup (key session) (new-value)
  `(setf (gethash ,key (session-values ,session)) ,new-value))

or, annotated

(defsetf [name-of-lookup-function] (&rest [lookip-function-args]) (new-value)
  [macro-body])

Once you've defined that as appropriate, you can just

CL-USER> (lookup :test foo)
NIL
NIL
CL-USER> (setf (lookup :test foo) 'new-val)
NEW-VAL
CL-USER> (lookup :test foo)
NEW-VAL
T
CL-USER> 

This isn't satisfying if the lookup abstraction you've defined is a method though. Because then you get into this problem

CL-USER> (defmethod lookup (key (session session))
  (gethash key (session-values session)))

(defmethod lookup (key (hash hash-table))
  (gethash key hash))
STYLE-WARNING: Implicitly creating new generic function LOOKUP.
#<STANDARD-METHOD LOOKUP (T HASH-TABLE) {1005048E03}>
CL-USER> (defsetf lookup (key session) (new-value)
  `(setf (gethash ,key (session-values ,session)) ,new-value))
LOOKUP
CL-USER> (defparameter foo (make-instance 'session))
FOO
CL-USER> (defparameter bar (make-hash-table))
BAR
CL-USER> (lookup :test foo)
NIL
NIL
CL-USER> (lookup :test bar)
NIL
NIL
CL-USER> (setf (lookup :test foo) 'one)
ONE
CL-USER> (setf (lookup :test bar) 'two)

There is no applicable method for the generic function
  #<STANDARD-GENERIC-FUNCTION SESSION-VALUES (1)>
when called with arguments
  (#<HASH-TABLE :TEST EQL :COUNT 0 {10051DC633}>).
   [Condition of type SIMPLE-ERROR]

Restarts:
 0: [RETRY] Retry calling the generic function.
 1: [RETRY] Retry SLIME REPL evaluation request.
 2: [*ABORT] Return to SLIME's top level.
 3: [ABORT] Abort thread (#<THREAD "repl-thread" RUNNING {10047D0113}>)

Backtrace:
  0: ((SB-PCL::FAST-METHOD NO-APPLICABLE-METHOD (T)) #<unused argument> #<unused argument> #<STANDARD-GENERIC-FUNCTION SESSION-VALUES (1)> #<HASH-TABLE :TEST EQL :COUNT 0 {10051DC633}>)
  1: (SB-PCL::CALL-NO-APPLICABLE-METHOD #<STANDARD-GENERIC-FUNCTION SESSION-VALUES (1)> (#<HASH-TABLE :TEST EQL :COUNT 0 {10051DC633}>))
  2: (#:EVAL-THUNK)
  ...

If You Need CLOS Support

Then you'll need to define a setf generic. In the example we've been using, you could do the following:

(defgeneric (setf lookup) (new-value key session)
  (:documentation "Setter for lookup methods"))

(defmethod (setf lookup) (new-value key (session session))
  (setf (gethash key (session-values session)) new-value))

(defmethod (setf lookup) (new-value key (hash hash-table))
  (setf (gethash key hash) new-value))

Which would then let you polymorphically use setf exactly the way you'd expect.

CL-USER> (defparameter foo (make-instance 'session))
FOO
CL-USER> (defparameter bar (make-hash-table))
BAR
CL-USER> (list (lookup :test foo) (lookup :test bar))
(NIL NIL)
CL-USER> (setf (lookup :test foo) 'session (lookup :test bar) 'hash)
HASH
CL-USER> (list (lookup :test foo) (lookup :test bar))
(SESSION HASH)
CL-USER>

There. Hopefully the next person who searches for "defsetf examples" will find something more useful than I did.

Tuesday, October 15, 2013

Deal Journal - Interlude Three -- Being a Brief Musing on Session Mechanisms and Their Implementation

I'm going to get to the reflections piece eventually, I swear. Or maybe I won't. Fuck I don't know.

Anyhow, sessions are things you'll need to deal with if you want to build any kind of stateful application on top of HTTP. Because an HTTP conversation is stateless by default. When you send an HTTP request out, as a general rule there's nothing in it that could let the server positively identify you. Which means that if you make two serial requests to the same site, they usually can't be absolutely sure that both of the requests you just sent came from you. They'll get data on your user agent[1], operating system, and your IP[2]. And that's it. Now, granted, if you're me, it's fairly easy for the server to point out the Debian Jessie/Conkeror user originating at IP foo, but that's not something a server operator can normally rely on.

What they have to do is hand you some piece of data, and ask you to hand it back to them every time you visit. Usually this takes the form of a cookie, and if they've done their job sufficiently well, they can now take any bunch of requests they got with the same cookie and reasonably assume that it came from the same user.

How Well is "Sufficiently"?

Something should be obvious there. First, unless you're using SSL, that piece of state you've been handed is trivially sniffable. Which means that if you have a habit of logging into a server that doesn't make you use https, well, I hope you're not keeping anything really secret there. Second, unless your session state is pretty hard to guess, someone who wants to impersonate you probably can.

From a server operators' perspective, the https thing is easy. Just use SSL[3]. As for guessability, we want the following properties:

  • each active user should have a unique session token, unless they choose to share it
  • knowing any number of previous tokens shouldn't give you any edge in guessing others[4].
  • knowing how the tokens are generated shouldn't give you any edge in guessing others[5]

And that's close enough to the specification of a CSPRNG that if we had one, we could just use it. The absolute simplest way to do that is to use a secure block cipher on a randomly initialized counter. As it happens, Common Lisp Has That©™.

Generating Session Tokens with Ironclad

So, basically what we need is for our server to generate a secret key[6], then use that to encrypt the output of a counter, starting at some random point or possibly just modified by a random number.

In other words, if I'm understanding the proposition[7], you can do that like this

(ql:quickload (list :ironclad :cl-base64))
(setf *random-state* (make-random-state t))

(defmethod sha256 ((message integer))
  (ironclad:digest-sequence
   :sha256 (ironclad:integer-to-octets message)))

(defmethod aes ((message string) (key array))
  (let ((cipher (ironclad:make-cipher :aes :mode :ecb :key key))
        (msg (ironclad:ascii-string-to-byte-array message)))
    (ironclad:encrypt-in-place cipher msg)
    msg))

(defun new-session-token ()
  (cl-base64:usb8-array-to-base64-string
   (aes (format nil "~a::~a::~a"
                (gensym) (random (expt 2 128)) (get-universal-time))
        (sha256 (random (expt 2 128))))
   :uri t))

It's probably not necessary to generate a new key for each session, but it doesn't seem to be too expensive, so I'll spring for it.

sha256 is a thin wrapper around a particular digest-sequence call, and it produces a 32-element vector of octets representing the digested number. We feed that to an aes cipher as a key, along with a (gensym), random number and the current time in milliseconds. aes is itself just a call to a set of ironclad functions that return a vector of octets representing the AES-encrypted message described above. That result is itself then fed through cl-base64:usb8-array-to-base64-string, which gives us a string we can use as a reasonably secure session token, provided we're using SSL. Here's a sample

CL-USER> (new-session-token)
"LIAez844JJyKYuvOD9YGJ2rGlzTbVHzd-705gOB4FjSvJyNcw95BigdiC9vE_W5TMDo6MzU5MDg3MTU4Ng.."
CL-USER> (new-session-token)
"Sb455jzLxXHf0i_hALnowAd8JY-GC2aJJ9UekKPlj6AdlxnvpKGELJERnuugWLxWMjo6MzU5MDg3MTU4Ng.."
CL-USER> (new-session-token)
"fgwnkKaxqUfj2GHn_VcR0tBnasfzYOMeFQECAelV3vPc-7VAOxjs3nqm3wGTh9dLNzo6MzU5MDg3MTU4Nw.."
CL-USER> (new-session-token)
"MfCTWUJ0IavpPXY551xpmdTC-MHssRluqwTRsdetNI1bnOqXyoddl73CE8fQ2hAMOjM1OTA4NzE1ODg."
CL-USER> (new-session-token)
"zckWhe4EJk8hrvVl-y8UeoC0Zqfb5nZAJtyhof66hAlzAN2OkHoCXgR9iTJhcKLVOjM1OTA4NzE1ODk."
CL-USER> (new-session-token)
"_kQaKM6Ck8GiaRY1ZO4Y_gj0o6LuQT54oSXYSrCIMMORe5hazv0uz5TGPiod4m3NMzo6MzU5MDg3MTU5MA.."
CL-USER> 

And, just to make sure,

CL-USER> (loop repeat 1000000 do (new-session-token))
  seconds  |     gc     |     consed    |   calls   |  sec/call  |  name  
---------------------------------------------------------------
    27.586 |      0.692 | 5,610,325,328 | 1,000,000 |   0.000028 | NEW-SESSION-TOKEN
---------------------------------------------------------------
    27.586 |      0.692 | 5,610,325,328 | 1,000,000 |            | Total

estimated total profiling overhead: 1.79 seconds
overhead estimation parameters:
  1.6000001e-8s/call, 1.7919999e-6s total profiling, 7.4400003e-7s internal profiling
NIL
CL-USER> 

the profiler says session generation probably isn't going to be my bottleneck. Though I could probably tune it if I liked, not that I could see the gains offsetting the readability hit we'd take. If I had to start cutting somewhere, I'd make sure to only generate one key per server session, and figure out a more efficient way than format to put the key content together.

Actually, that gensym+rand-call+get-universal-time method strikes me as programming by superstition. Even more-so than the Hunchentoot session mechanism, which also includes the target IP/user-agent and validates these against the incoming request[8]. If we were implementing the real requirements as I understand them, we'd just need

(setf *random-state* (make-random-state t))

(defmethod sha256 ((message integer))
  (ironclad:digest-sequence
   :sha256 (ironclad:integer-to-octets message)))

(let ((cipher (ironclad:make-cipher :aes :key (sha256 (random (expt 2 1024))) :mode :ecb))
      (counter (random (expt 2 512))))
  (defun new-session-token ()
    (let ((raw (ironclad:integer-to-octets (incf counter))))
      (ironclad:encrypt-in-place cipher raw)
      (cl-base64:usb8-array-to-base64-string raw :uri t))))

Random key, check. Counter starting at a random number, check. And this should coincidentally perform much better too.

CL-USER> (loop repeat 1000000 do (new-session-token))
measuring PROFILE overhead..done
  seconds  |     gc     |     consed    |   calls   |  sec/call  |  name  
---------------------------------------------------------------
     8.637 |      0.644 | 5,423,965,408 | 1,000,000 |   0.000009 | NEW-SESSION-TOKEN
---------------------------------------------------------------
     8.637 |      0.644 | 5,423,965,408 | 1,000,000 |            | Total

estimated total profiling overhead: 1.82 seconds
overhead estimation parameters:
  8.000001e-9s/call, 1.816e-6s total profiling, 7.92e-7s internal profiling
NIL
CL-USER> 

Yup.

Of course, I still don't have enough confidence in my own assessment to just run with all this, so I'll be asking questions first.

EDIT:

It turns out that :ironclad has a built-in CSPRNG option that implements Fortuna. If we use that, our implementation gets much simpler, but mildly slower[9].

(ql:quickload (list :ironclad :cl-base64))

(let ((prng (ironclad:make-prng :fortuna)))
  (defun new-session-token ()
    (cl-base64:usb8-array-to-base64-string
     (ironclad:random-data 32 prng) :uri t)))

That's it.

No encryption, no fiddling with random, no assigning results of make-random-state calls. Just initialize a :fortuna instnce, and collect random output in batches of 32.

Wed, 16 Oct, 2013

Other than that, what's left is putting together a session table with its own lock to store session information indexed by these IDs. Oh, and also sending them out to the client. I guess that's kind of important. Both are waiting for next time though, or this will quickly cease being "brief".


Footnotes

1 - [back] - Unless you've spoofed it, as I often do to access the many "IE only" pages built by the legion of typing monkeys in my current companies' HR department.

2 - [back] - Unless you're behind a proxy, or a dynamic IP.

3 - [back] -I'm not implementing this myself, obviously. The current plan is still to hide behind nginx for static file serving, so we can have it handle SSL certificates for us to. It's not even terribly difficult.

4 - [back] - Except in the trivial sense that each active user should have a unique one, so if as an attacker you write a script to grab a few thousand keys, you can be sure that other people aren't using those specific ones.

5 - [back] - Except in the trivial sense that you can avoid guessing short dictionary words, or dates or something.

6 - [back] - That key, incidentally, should have similar properties to session tokens. It should be difficult to guess no matter how many of them you've seen, and running your own copy of Deal to extract a bunch of keys should give you no advantage when guessing another servers' secret key.

7 - [back] - And that's not a certainty. I'm not exactly a math guy, so it's entirely possible that I'm misunderstanding the requirement at some step of this process. I'll certainly keep you up to date on any revelations.

8 - [back] - When you think about it, all that can possibly do is make it slightly harder for attackers who've guessed a currently active session token, and if you've picked a Sufficiently Large©™ key space, the possibility of a guess seems to drop to negligible levels. Attackers who rely on sniffing get all the associated data you'll be including along with the session token, so they can still easily impersonate your users. Meanwhile, this method of guarding requires you to decrypt and validate a session token on each request you make. Not sure it's the right trade-off, but like I said, I'll keep you posted on revelations.

9 - [back] - Also, the runtime of ironclad:make-prng is extremely inconsistent. It takes between 8 and 76 hippopotomi to complete, and I'm not entirely sure what plays into that. Possibly entropy shortages in the underlying OS? Which also reminds me; this version isn't Windows friendly. So if you were planning to run Deal on Windows, I'm deeply sorry for you.

Sunday, October 13, 2013

Deal Journal - Interlude Two -- Being The Thoughts on Implementation Minutia of Custom HTTP Servers

On the Mechanisms of Stopping A Server...

The last prototype I posted had a laughably mis-named stop function

(defun stop ()
  (when *socket-handle*
    (loop while (socket-close *socket-handle*))
    (setf *socket-handle* nil
          *channel* nil)))

See, because the server I'm putting together is single-threaded, you need to C-c C-c out of it to get back to the REPL. Except, that still leaves the socket-server listening on the specified TCP port. The half-assed solution I'd come up with involved setting a handle into which I'd put the listener so that I could close the process and kill the listener externally later.

(defvar *socket-handle* nil)

(defun start (port &optional (log-stream *standard-output*))
  (stop)  
  (setf *socket-handle* (socket-listen "127.0.0.1" port :reuse-address t))
  (let ((conns (list *socket-handle*))
        (buffers (make-hash-table)))
    (loop (loop for ready in (wait-for-input conns :ready-only t)
                do (if (typep ready 'stream-server-usocket)
                       (push (socket-accept ready) conns)
                     (let ((buf (gethash ready buffers (make-instance 'buffer))))
                       (buffered-read! (socket-stream ready) buf)
                       (when (starts-with? (list #\newline #\return #\newline #\return)
                                           (contents buf))
                         (format log-stream "COMPLETE ~s~%"
                                 (coerce (reverse (contents buf)) 'string))
                         (setf conns (remove ready conns))
                         (remhash ready buffers)
                         (let ((parsed (parse buf)))
                           (format log-stream "PARSED: ~s~%" parsed)
                           (handle-request ready (parse buf))))))))))

The much more elegant way of solving this is by using unwind-protect:

(defun start (port &optional (log-stream *standard-output*))
  (let ((conns (list (socket-listen usocket:*wildcard-host* port :reuse-address t)))
        (buffers (make-hash-table)))
    (unwind-protect
         (loop (loop for ready in (wait-for-input conns :ready-only t)
                  do (if (typep ready 'stream-server-usocket)
                         (push (socket-accept ready) conns)
                         (let ((buf (gethash ready buffers (make-instance 'buffer))))
                           (buffered-read! (socket-stream ready) buf)
                           (when (starts-with? (list #\newline #\return #\newline #\return)
                                               (contents buf))
                             (format log-stream "COMPLETE ~s~%"
                                     (coerce (reverse (contents buf)) 'string))
                             (setf conns (remove ready conns))
                             (remhash ready buffers)
                             (let ((parsed (parse buf)))
                               (format log-stream "PARSED: ~s~%" parsed)
                               (handle-request ready (parse buf))))))))
      (loop for c on conns do (loop while (socket-close c)))
      (setf *channel* nil))))

That'll automatically clean up on any kind of error, including an Emacs interrupt, and it completely removes the need for stop and *socket-handle*. The above also uses usocket:*wildcard-host* instead of "127.0.0.1", but that's a tiny change.

On The Mechanism for Listening to Sockets

There's a less obvious place that I wanted to figure something out for. Here's the above server with elided chunklets, just so we can focus in on the relevant details

(defun start (port &optional (log-stream *standard-output*))
  (let ((conns (list (socket-listen usocket:*wildcard-host* port :reuse-address t)))
        ...)
    (unwind-protect
         (loop (loop for ready in (wait-for-input conns :ready-only t)
                  do (if (typep ready 'stream-server-usocket)
                         (push (socket-accept ready) conns)
                         (let (...)
                           (buffered-read! (socket-stream ready) buf)
                           (when ...
                             ...
                             (setf conns (remove ready conns))
                             ...)))))
      ...)))

The point I've been thinking about in particular is that bit that says (wait-for-input conns ...), and the associated places where I either remove things from, or add things to conns. As written up there, it's a list. Which is to say, a singly linked list. And that means that adding a thing to it is O1, but removing a thing from it is On, and since we're doing that (setf conns (remove ready conns)) inside of a loop, this version of startstart is effectively an On^2 procedure in the worst case. Not horrible, I guess, but I think I can do better.

The challenge here is that no matter what data structure we use to store connections, wait-for-input needs either a socket, or a list of sockets. Here's one attempt to do somewhat better

(defun start (port &optional (log-stream *standard-output*))
  (let ((server (socket-listen usocket:*wildcard-host* port :reuse-address t))
        (conns (make-hash-table))
        ...)
    (unwind-protect
         (loop (loop for ready in (wait-for-input (cons server (hash-keys conns)) :ready-only t)
                  do (if (typep ready 'stream-server-usocket)
                         (setf (gethash (socket-accept ready) conns) :in)
                         (let (...)
                           (buffered-read! (socket-stream ready) buf)
                           (when ...
                             ...
                             (remhash ready conns)
                             ...)))))
      ...)))

If we represent conns as a hash table, we can effectively pay some memory and some best-case time to mitigate worst-case time. Seems worth it, I'd say, but I'm not at all sure. New connection insertion now takes the form of (setf (gethash (socket-accept ready) conns) :in), and connection removal is written as (remhash ready conns), both of which are O1. The thing that gets markedly worse, ironically is the wait-for-input call itself. Unlike the original, which just passed the raw conns, we now have to pass (cons server (hash-keys conns)), which requires not only the consing of an entirely new list each time through, but also a full traversal of conns. Since the interface of wait-for-input demands an actual list, and not a generator or similar, the best you can do on the implementation of hash-keys is something like (loop for k being the hash-keys of conns collect k). Which works, but isn't exactly stellar.

To its credit though, it does save us time in the worst case. As a result of this representation change, start now has On performance in both the worst and the best case. I get the feeling we could save some constants by opening up usocket and twiddling with wait-for-input, but a glance at the relevant files tells me that it's implemented something like four times, sometimes in expected configurations I can't easily test.

Ah well. The naive hash is a good enough improvement for now, and I am in the middle of reading through notes about Berkeley Sockets and their uses. Hopefully, when I get to work I can convince one of my co-workers to take me through the nuts and bolts of the implementation in C. Maybe that will give me enough insight to write something that solves this problem in a satisfactory fashion.