commit c9cf16740ab44baaacbc9cda8b5b9aa7f64c6ce9
Author: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date:   Tue Sep 13 17:07:27 2016 -0400

    Initial commit

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..07bac82
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,2 @@
+compiled/
+htmldocs/
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..c1a817e
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,44 @@
+PACKAGENAME=unix-signals
+COLLECTS=unix-signals
+
+all: setup
+
+clean:
+	find . -name compiled -type d | xargs rm -rf
+	rm -rf unix-signals/doc
+	rm -rf htmldocs
+
+setup:
+	raco setup $(COLLECTS)
+
+link:
+	raco pkg install --link -n $(PACKAGENAME) $$(pwd)
+
+unlink:
+	raco pkg remove $(PACKAGENAME)
+
+htmldocs:
+	raco scribble \
+		--html \
+		--dest htmldocs \
+		--dest-name index \
+		++main-xref-in \
+		--redirect-main http://docs.racket-lang.org/ \
+		\
+		unix-signals/unix-signals.scrbl
+
+pages:
+	@(git branch -v | grep -q gh-pages || (echo local gh-pages branch missing; false))
+	@echo
+	@git branch -av | grep gh-pages
+	@echo
+	@(echo 'Is the branch up to date? Press enter to continue.'; read dummy)
+	git clone -b gh-pages . pages
+
+publish: htmldocs pages
+	rm -rf pages/*
+	cp -r htmldocs/. pages/.
+	(cd pages; git add -A)
+	-(cd pages; git commit -m "Update $$(date +%Y%m%d%H%M%S)")
+	(cd pages; git push)
+	rm -rf pages
diff --git a/info.rkt b/info.rkt
new file mode 100644
index 0000000..e2adcfc
--- /dev/null
+++ b/info.rkt
@@ -0,0 +1,5 @@
+#lang setup/infotab
+(define collection 'multi)
+(define deps '("base" "rackunit-lib"))
+(define build-deps '("racket-doc" "scribble-lib"))
+(define homepage "https://github.com/tonyg/racket-unix-signals")
diff --git a/unix-signals/info.rkt b/unix-signals/info.rkt
new file mode 100644
index 0000000..88b0cf5
--- /dev/null
+++ b/unix-signals/info.rkt
@@ -0,0 +1,4 @@
+#lang setup/infotab
+(define scribblings '(("unix-signals.scrbl" ())))
+(define pre-install-collection "private/install.rkt")
+(define compile-omit-files '("private/install.rkt"))
diff --git a/unix-signals/main.rkt b/unix-signals/main.rkt
new file mode 100644
index 0000000..0b9156a
--- /dev/null
+++ b/unix-signals/main.rkt
@@ -0,0 +1,48 @@
+#lang racket/base
+
+(provide next-signal-evt
+         read-signal
+         lookup-signal-number
+         lookup-signal-name
+         capture-signal!
+         ignore-signal!
+         release-signal!
+         getpid
+         send-signal!)
+
+(require (only-in racket/os getpid))
+(require "private/unix-signals-extension.rkt")
+
+(define signal-fd (get-signal-fd))
+
+(define next-signal-evt
+  (handle-evt signal-fd (lambda (_) (read-signal))))
+
+(define (read-signal) (read-byte signal-fd))
+
+(define signals-by-name (get-signal-names))
+(define signals-by-number
+  (for/hash [((name number) (in-hash signals-by-name))] (values number name)))
+
+(define (lookup-signal-number sym) (hash-ref signals-by-name sym #f))
+(define (lookup-signal-name num) (hash-ref signals-by-number num #f))
+
+(define (name->signum who n)
+  (cond
+    [(symbol? n) (or (lookup-signal-number n)
+                     (error who "Unknown signal name ~a" n))]
+    [(fixnum? n) n]
+    [else (error who "Expects signal name symbol or signal number; got ~v" n)]))
+
+(define (capture-signal! sig)
+  (set-signal-handler! (name->signum 'capture-signal! sig) 0))
+
+(define (ignore-signal! sig)
+  (set-signal-handler! (name->signum 'capture-signal! sig) 1))
+
+(define (release-signal! sig)
+  (set-signal-handler! (name->signum 'capture-signal! sig) 2))
+
+(define (send-signal! pid sig)
+  (when (not (fixnum? pid)) (error 'send-signal! "Expected fixnum pid; got ~v" pid))
+  (lowlevel-send-signal! pid (name->signum 'send-signal! sig)))
diff --git a/unix-signals/private/install.rkt b/unix-signals/private/install.rkt
new file mode 100644
index 0000000..3d61ba4
--- /dev/null
+++ b/unix-signals/private/install.rkt
@@ -0,0 +1,19 @@
+#lang racket/base
+
+(require make/setup-extension)
+
+(provide pre-installer)
+
+(define (pre-installer collections-top-path our-path)
+  (pre-install our-path
+	       (build-path our-path "private")
+	       "unix-signals-extension.c"
+	       "."
+	       '()
+	       '()
+	       '()
+	       '()
+	       '()
+	       '()
+	       (lambda (thunk) (thunk))
+	       #t))
diff --git a/unix-signals/private/unix-signals-extension.c b/unix-signals/private/unix-signals-extension.c
new file mode 100644
index 0000000..ddf50d9
--- /dev/null
+++ b/unix-signals/private/unix-signals-extension.c
@@ -0,0 +1,204 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <stdint.h>
+
+#include <fcntl.h>
+#include <unistd.h>
+#include <signal.h>
+
+#include <sys/types.h>
+
+#include "escheme.h"
+
+/* This implementation uses djb's "self-pipe trick".
+ * See http://cr.yp.to/docs/selfpipe.html. */
+
+static int self_pipe_initialized = 0;
+static int self_pipe_read_end = -1;
+static int self_pipe_write_end = -1;
+
+static int setup_self_pipe(void) {
+  {
+    int pipefd[2];
+    if (pipe(pipefd) == -1) {
+      perror("unix-signals-extension pipe(2)");
+      goto error;
+    }
+    self_pipe_read_end = pipefd[0];
+    self_pipe_write_end = pipefd[1];
+  }
+
+  {
+    int flags = fcntl(self_pipe_write_end, F_GETFL, 0);
+    if (flags == -1) {
+      perror("unix-signals-extension F_GETFL");
+      goto error;
+    }
+    if (fcntl(self_pipe_write_end, F_SETFL, flags | O_NONBLOCK) == -1) {
+      perror("unix-signals-extension F_SETFL");
+      goto error;
+    }
+  }
+
+  return 0;
+
+ error:
+  if (self_pipe_write_end != -1) {
+    int tmp = self_pipe_write_end;
+    self_pipe_write_end = -1;
+    close(tmp);
+  }
+  if (self_pipe_read_end != -1) {
+    int tmp = self_pipe_read_end;
+    self_pipe_read_end = -1;
+    close(tmp);
+  }
+  return -1;
+}
+
+static void signal_handler_fn(int signum) {
+  if (self_pipe_write_end == -1) {
+    return;
+  }
+
+  {
+    uint8_t b;
+    b = (uint8_t) (signum & 0xff);
+    if (write(self_pipe_write_end, &b, 1) == -1) {
+      perror("unix-signals-extension write");
+    }
+  }
+}
+
+Scheme_Object *prim_get_signal_fd(int argc, Scheme_Object **argv) {
+  if (self_pipe_read_end == -1) {
+    return scheme_false;
+  } else {
+    return scheme_make_fd_input_port(self_pipe_read_end, scheme_intern_symbol("signal-fd"), 0, 0);
+  }
+}
+
+Scheme_Object *prim_get_signal_names(int argc, Scheme_Object **argv) {
+  Scheme_Hash_Table *ht;
+
+  ht = scheme_make_hash_table(SCHEME_hash_ptr);
+
+#define ADD_SIGNAL_NAME(n) scheme_hash_set(ht, scheme_intern_symbol(#n), scheme_make_integer(n))
+
+  /* POSIX.1-1990 */
+  ADD_SIGNAL_NAME(SIGHUP);
+  ADD_SIGNAL_NAME(SIGINT);
+  ADD_SIGNAL_NAME(SIGQUIT);
+  ADD_SIGNAL_NAME(SIGILL);
+  ADD_SIGNAL_NAME(SIGABRT);
+  ADD_SIGNAL_NAME(SIGFPE);
+  ADD_SIGNAL_NAME(SIGKILL);
+  ADD_SIGNAL_NAME(SIGSEGV);
+  ADD_SIGNAL_NAME(SIGPIPE);
+  ADD_SIGNAL_NAME(SIGALRM);
+  ADD_SIGNAL_NAME(SIGTERM);
+  ADD_SIGNAL_NAME(SIGUSR1);
+  ADD_SIGNAL_NAME(SIGUSR2);
+  ADD_SIGNAL_NAME(SIGCHLD);
+  ADD_SIGNAL_NAME(SIGCONT);
+  ADD_SIGNAL_NAME(SIGSTOP);
+  ADD_SIGNAL_NAME(SIGTSTP);
+  ADD_SIGNAL_NAME(SIGTTIN);
+  ADD_SIGNAL_NAME(SIGTTOU);
+
+  /* Not POSIX.1-1990, but SUSv2 and POSIX.1-2001 */
+  ADD_SIGNAL_NAME(SIGBUS);
+  ADD_SIGNAL_NAME(SIGPOLL);
+  ADD_SIGNAL_NAME(SIGPROF);
+  ADD_SIGNAL_NAME(SIGSYS);
+  ADD_SIGNAL_NAME(SIGTRAP);
+  ADD_SIGNAL_NAME(SIGURG);
+  ADD_SIGNAL_NAME(SIGVTALRM);
+  ADD_SIGNAL_NAME(SIGXCPU);
+  ADD_SIGNAL_NAME(SIGXFSZ);
+
+  /* Misc, that we hope are widely-supported enough not to have to
+     bother with a feature test. */
+  ADD_SIGNAL_NAME(SIGIO);
+  ADD_SIGNAL_NAME(SIGWINCH);
+
+#undef ADD_SIGNAL_NAME
+
+  return (Scheme_Object *) ht;
+}
+
+Scheme_Object *prim_capture_signal(int argc, Scheme_Object **argv) {
+  int signum = SCHEME_INT_VAL(argv[0]);
+  int code = SCHEME_INT_VAL(argv[1]);
+  switch (code) {
+    case 0:
+      if (signal(signum, signal_handler_fn) == SIG_ERR) {
+        perror("unix-signals-extension signal(2) install");
+        return scheme_false;
+      }
+      break;
+    case 1:
+      if (signal(signum, SIG_IGN) == SIG_ERR) {
+        perror("unix-signals-extension signal(2) ignore");
+        return scheme_false;
+      }
+      break;
+    case 2:
+      if (signal(signum, SIG_DFL) == SIG_ERR) {
+        perror("unix-signals-extension signal(2) default");
+        return scheme_false;
+      }
+      break;
+    default:
+      return scheme_false;
+  }
+  return scheme_true;
+}
+
+Scheme_Object *prim_send_signal(int argc, Scheme_Object **argv) {
+  pid_t pid = SCHEME_INT_VAL(argv[0]);
+  int sig = SCHEME_INT_VAL(argv[1]);
+  if (kill(pid, sig) == -1) {
+    perror("unix-signals-extension kill(2)");
+    return scheme_false;
+  }
+  return scheme_true;
+}
+
+Scheme_Object *scheme_reload(Scheme_Env *env) {
+  Scheme_Env *module_env;
+  Scheme_Object *proc;
+
+  if (!self_pipe_initialized) {
+    if (setup_self_pipe() == -1) {
+      return scheme_false;
+    }
+    self_pipe_initialized = 1;
+  }
+
+  module_env = scheme_primitive_module(scheme_intern_symbol("unix-signals-extension"), env);
+
+  proc = scheme_make_prim_w_arity(prim_get_signal_fd, "get-signal-fd", 0, 0);
+  scheme_add_global("get-signal-fd", proc, module_env);
+
+  proc = scheme_make_prim_w_arity(prim_get_signal_names, "get-signal-names", 0, 0);
+  scheme_add_global("get-signal-names", proc, module_env);
+
+  proc = scheme_make_prim_w_arity(prim_capture_signal, "set-signal-handler!", 2, 2);
+  scheme_add_global("set-signal-handler!", proc, module_env);
+
+  proc = scheme_make_prim_w_arity(prim_send_signal, "lowlevel-send-signal!", 2, 2);
+  scheme_add_global("lowlevel-send-signal!", proc, module_env);
+
+  scheme_finish_primitive_module(module_env);
+  return scheme_void;
+}
+
+Scheme_Object *scheme_initialize(Scheme_Env *env) {
+  return scheme_reload(env);
+}
+
+Scheme_Object *scheme_module_name() {
+  return scheme_intern_symbol("unix-signals-extension");
+}
diff --git a/unix-signals/unix-signals.scrbl b/unix-signals/unix-signals.scrbl
new file mode 100644
index 0000000..696cf15
--- /dev/null
+++ b/unix-signals/unix-signals.scrbl
@@ -0,0 +1,89 @@
+#lang scribble/manual
+
+@(require scriblib/footnote
+	  (for-label racket unix-signals racket/os))
+
+@title{unix-signals}
+@author[(author+email "Tony Garnock-Jones" "tonyg@leastfixedpoint.com")]
+
+If you find that this library lacks some feature you need, or you have
+a suggestion for improving it, please don't hesitate to
+@link["mailto:tonyg@leastfixedpoint.com"]{get in touch with me}!
+
+@section{Introduction}
+
+This library provides a means of sending and receiving Unix signals to
+Racket programs.
+
+Be warned that attempting to receive certain signals used by the
+Racket runtime is dangerous, as the code here will conflict with the
+code in Racket itself.
+
+@section{What to require}
+
+All the functionality below can be accessed with a single
+@racket[require]:
+
+@(defmodule unix-signals)
+
+@subsection{Mapping between signal names and signal numbers}
+
+This library represents signal names as symbols all in upper-case;
+for example, @racket['SIGUSR1] and @racket['SIGKILL].
+
+@defproc[(lookup-signal-number [sym symbol?]) (opt/c fixnum?)]{
+Returns a fixnum if the symbol name is defined, or @racket[#f] if not. }
+
+@defproc[(lookup-signal-name [num fixnum?]) (opt/c symbol?)]{ Returns
+a symbol naming the given signal number, if one is defined, or
+@racket[#f] if not. Note that in cases where multiple C identifiers
+map to a given signal number, an arbitrary choice among the
+possibilities is returned. }
+
+@subsection{Waiting for a signal}
+
+To receive Unix signals using this library, call
+@racket[capture-signal!] once for each signal of interest, and then
+use @racket[next-signal-evt] or @racket[read-signal]. Use
+@racket[ignore-signal!] and @racket[release-signal!] to ignore a
+signal (@tt{SIG_IGN}) or to install the default
+signal-handler (@tt{SIG_DFL}), respectively.
+
+Calls to @racket[capture-signal!] and friends have @emph{global} effect
+within the Racket process. Likewise, use of @racket[next-signal-evt]
+and @racket[read-signal] have global side-effects on the state of the
+Racket process.
+
+@defproc[(capture-signal! [sig (or/c fixnum? symbol?)]) boolean?]{
+Installs a signal handler for the given signal. When the given signal
+is received by the process, its signal number will be returned by uses
+of @racket[next-signal-evt] and/or @racket[read-signal]. }
+
+@defproc[(ignore-signal! [sig (or/c fixnum? symbol?)]) boolean?]{
+Causes the given signal to be ignored (@tt{SIG_IGN}) by the process. }
+
+@defproc[(release-signal! [sig (or/c fixnum? symbol?)]) boolean?]{
+Installs the default handler (@tt{SIG_DFL}) for the given signal. }
+
+@defthing[next-signal-evt evt?]{ @tech[#:doc
+'(lib "scribblings/reference/reference.scrbl")]{Synchronizable event} which
+becomes ready when a signal previously registered with
+@racket[capture-signal!] is received, at which point it returns the
+number of the received signal as its synchronization result by
+yielding the result of a call to @racket[read-signal]. }
+
+@defproc[(read-signal) fixnum?]{ Blocks until a signal previously
+registered with @racket[capture-signal!] is received. Returns the
+number of the received signal. Signals are buffered internally using
+the @link["http://cr.yp.to/docs/selfpipe.html"]{self-pipe trick}, and
+are therefore delivered in order of receipt. }
+
+@subsection{Sending a signal}
+
+This library provides @racket[getpid] from @racketmodname[racket/os]
+for convenience.
+
+@defproc[(send-signal! [pid fixnum?] [sig (or/c fixnum? symbol?)])
+boolean?]{ Calls @tt{kill(2)} to deliver the given signal to the
+given process ID. All special cases for @racket[pid] from the
+@tt{kill(2)} manpage apply. }