chiark / gitweb /
Bump version to 7.0.1~iwj0 master
authorIan Jackson <ijackson@chiark.greenend.org.uk>
Mon, 22 Aug 2022 18:08:42 +0000 (19:08 +0100)
committerIan Jackson <ijackson@chiark.greenend.org.uk>
Mon, 22 Aug 2022 18:08:42 +0000 (19:08 +0100)
Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>
31 files changed:
.gitignore
cprogs/Makefile
cprogs/acctdump.8
cprogs/cgi-fcgi-interp.c
cprogs/common.c
cprogs/common.h
cprogs/mcastsoundd.c
cprogs/prefork-interp.c [new file with mode: 0644]
cprogs/prefork.c [new file with mode: 0644]
cprogs/prefork.h [new file with mode: 0644]
cprogs/really.c
cprogs/timespeccmp.h [new file with mode: 0644]
debian/changelog
debian/chiark-really.lintian-overrides [new file with mode: 0644]
debian/chiark-scripts.lintian-overrides [new file with mode: 0644]
debian/compat
debian/control
debian/copyright
debian/rules
debian/source/format [new file with mode: 0644]
fishdescriptor/py/fishdescriptor/fish.py
fishdescriptor/py/fishdescriptor/indonor.py
scripts/Makefile
scripts/Proc/Prefork/Interp.pm [new file with mode: 0644]
scripts/expire-iso8601
scripts/git-branchmove
scripts/git-cache-proxy
scripts/hexterm
scripts/prefork-interp-test [new file with mode: 0755]
settings.make
sync-accounts/sync-accounts

index 874ffa570537782225e718b9b31e813ad7f6406c..6eeaa10a7fbcb8772458454b08459d8fa76dab02 100644 (file)
@@ -20,6 +20,10 @@ cprogs/rcopy-repeatedly.txt
 cprogs/acctdump
 cprogs/cgi-fcgi-interp
 cprogs/cgi-fcgi-interp.txt
+cprogs/prefork-interp
+cprogs/prefork-interp.txt
+
+scripts/git-branchmove.1
 
 debian/tmp
 debian/sv-*
index 0e60a4feff0be08ce41214754b4e9b99a3b92843..127c1fcf4910aba9501748c9158349f1e46864ea 100644 (file)
@@ -29,13 +29,13 @@ RWBUFFER_SIZE_MB=16
 
 PROGRAMS=              readbuffer writebuffer with-lock-ex xbatmon-simple \
                        summer watershed rcopy-repeatedly xduplic-copier \
-                       cgi-fcgi-interp
+                       prefork-interp cgi-fcgi-interp
 SUIDSBINPROGRAMS=      really
 DAEMONS=               trivsoundd
 MAN1PAGES=             readbuffer.1 writebuffer.1 with-lock-ex.1 \
                        xduplic-copier.1 summer.1
 MAN8PAGES=             trivsoundd.8 really.8
-SEDDERYDOCS=           watershed.txt cgi-fcgi-interp.txt \
+SEDDERYDOCS=           watershed.txt prefork-interp.txt cgi-fcgi-interp.txt \
                        xbatmon-simple.txt rcopy-repeatedly.txt
 BUILTTXTDOCS=          $(SEDDERYDOCS)
 TXTDOCS=               $(BUILTTXTDOCS)
@@ -62,6 +62,7 @@ really:                               really.o myopt.o
 acctdump:                      acctdump.o      myopt.o
 
 acctdump.o really.o myopt.o rcopy-repeatedly.o: myopt.h
+cgi-cfgi-interp.o prefork.o: myopt.h prefork.h timespeccmp.h
 readbuffer.o writebuffer.o rwbuffer.o wrbufcore.o trivsoundd.o:        rwbuffer.h
 
 xbatmon-simple: LDLIBS += -lX11 -lm
@@ -79,9 +80,12 @@ rcopy-repeatedly: LDLIBS += -lm -lrt
 watershed:     watershed.o common.o
 watershed:     LDLIBS += -lnettle -lgmp
 
-cgi-fcgi-interp:       cgi-fcgi-interp.o       myopt.o common.o
+cgi-fcgi-interp:       cgi-fcgi-interp.o prefork.o myopt.o common.o
 cgi-fcgi-interp:       LDLIBS += -lnettle
 
+prefork-interp:                prefork-interp.o prefork.o myopt.o common.o
+prefork-interp:                LDLIBS += -lnettle -luv
+
 $(SEDDERYDOCS): %.txt: %.c
                sed '/^$$/,$$d' <$^ >$@.new && mv -f $@.new $@
 
index 9a93f4b180bd581c01ab92ff4ae5546986aabf63..d76ad6f9ab85ee368a7710263492a5ae90489ec8 100644 (file)
@@ -1,4 +1,4 @@
-.TH acctdump 1 2014-10-06 chiark-utils-bin
+.TH acctdump 8 2014-10-06 chiark-utils-bin
 .SH NAME
 acctdump \- accounting data dump utility
 .SH SYNOPSIS
index 63db94b35fed7a1d3afb3f11c96858a31d3c70d7..6ea886e0f101ea1dcaf4ce5d826d284e0919f40c 100644 (file)
@@ -1,7 +1,11 @@
 /*
  * "Interpreter" that you can put in #! like this
  *   #!/usr/bin/cgi-fcgi-interp [<options>] <interpreter>
- *   #!/usr/bin/cgi-fcgi-interp [<options>],<interpreter>
+ *
+ * Usages:
+ *   cgi-fcgi-interp  [<option> ..] <interpreter>  <script> [<ignored> ...]
+ *   cgi-fcgi-interp  [<option>,..],<interpreter>  <script> [<ignored> ...]
+ *   cgi-fcgi-interp '[<option> ..] <interpreter>' <script> [<ignored> ...]
  */
 /*
  * cgi-fcgi-interp.[ch] - Convenience wrapper for cgi-fcgi
  *      kill process group (at second iteration)
  */
 
-#include "common.h"
-
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <errno.h>
-#include <stdbool.h>
-#include <assert.h>
-#include <limits.h>
-
-#include <sys/types.h>
-#include <sys/stat.h>
-#include <sys/utsname.h>
-#include <sys/socket.h>
-#include <sys/un.h>
-#include <sys/file.h>
-#include <unistd.h>
-#include <fcntl.h>
-#include <pwd.h>
-#include <time.h>
-#include <signal.h>
-#include <sys/wait.h>
-#include <syslog.h>
-       
-#include <nettle/sha.h>
-
-#include "myopt.h"
-
-#define MINHEXHASH 33
-#define STAGE2_VAR "CHIARKUTILS_CGIFCGIINTERP_STAGE2"
+#include "prefork.h"
+#include "timespeccmp.h"
 
-static const char *interp, *ident;
-static int numservers=4, debugmode;
-static int check_interval=300;
-
-static struct sha256_ctx identsc;
+#define STAGE2_VAR "CHIARKUTILS_CGIFCGIINTERP_STAGE2"
 
-static bool logging;
 static const char *stage2;
 
-static void vmsgcore(int estatus, int errnoval, const char *fmt, va_list al) {
-  int r;
-
-  if (logging) {
-    const char *fmt_use = fmt;
-    char *fmt_free = 0;
-    if (errnoval) {
-      r = asprintf(&fmt_free, "%s: %%m", fmt);
-      if (r) {
-       fmt_free = 0;
-      } else {
-       fmt_use = fmt_free;
-      }
-    }
-    vsyslog(LOG_ERR, fmt_use, al);
-    free(fmt_free);
-  } else {
-    fputs("cgi-fcgi-interp: ",stderr);
-    vfprintf(stderr,fmt,al);
-    if (errnoval!=-1) fprintf(stderr,": %s",strerror(errnoval));
-    fputc('\n',stderr);
-  }
-  if (estatus) exit(estatus);
-}
-
-#define DEF_MSG(func, attrs, estatus, errnoval, after) \
-  static void func(const char *fmt, ...)               \
-    __attribute__((format(printf,1,2))) attrs;         \
-  static void func(const char *fmt, ...) {             \
-    va_list al;                                                \
-    va_start(al,fmt);                                  \
-    vmsgcore(estatus,errnoval,fmt,al);                 \
-    after                                              \
-  }
-
-DEF_MSG(warninge, /*empty*/, 0, errno, { });
-DEF_MSG(warning , /*empty*/, 0, 0,     { });
-
-#define DEF_DIE(func, errnoval) \
-  DEF_MSG(func, __attribute__((noreturn)), 127, errnoval, { abort(); })
-
-DEF_DIE(diee, errno)
-DEF_DIE(die,  0)
-
-void common_diee(const char *m) { diee("%s", m); }
-void common_die (const char *m) { die ("%s", m); }
-
-static void fusagemessage(FILE *f) {
-  fprintf(f, "usage: #!/usr/bin/cgi-fcgi-interp [<options>]\n");
-}
-
-void usagemessage(void) { fusagemessage(stderr); }
-
-static void of_help(const struct cmdinfo *ci, const char *val) {
-  fusagemessage(stdout);
-  if (ferror(stdout)) diee("write usage message to stdout");
-  exit(0);
-}
-
-static void of_iassign(const struct cmdinfo *ci, const char *val) {
-  long v;
-  char *ep;
-  errno= 0; v= strtol(val,&ep,10);
-  if (!*val || *ep || errno || v<INT_MIN || v>INT_MAX)
-    badusage("bad integer argument `%s' for --%s",val,ci->olong);
-  *ci->iassignto = v;
-}
+const char our_name[] = "cgi-fcgi-interp";
 
-static void ident_addstring(const struct cmdinfo *ci, const char *string) {
-  /* ci may be 0 and is provided so this can be .call */
-  sha256_update(&identsc,strlen(string)+1,string);
-}
-
-static void off_ident_addenv(const struct cmdinfo *ci, const char *name) {
-  const char *val = getenv(name);
-  if (val) {
-    sha256_update(&identsc,strlen(name),name); /* no nul */
-    sha256_update(&identsc,1,"=");
-    ident_addstring(0,val);
-  } else {
-    ident_addstring(0,name);
-  }
-}
-
-#define MAX_OPTS 5
+static int numservers=4, debugmode;
+static int check_interval=300;
 
-static const struct cmdinfo cmdinfos[]= {
-  { "help",   0, .call=of_help                                         },
-  { 0, 'g',   1,                    .sassignto= &ident                 },
-  { 0, 'G',   1, .call= ident_addstring                                },
-  { 0, 'E',   1, .call= off_ident_addenv                               },
+const struct cmdinfo cmdinfos[]= {
+  PREFORK_CMDINFOS
   { 0, 'M',   1, .call=of_iassign,  .iassignto= &numservers            },
   { 0, 'D',   0,                    .iassignto= &debugmode,    .arg= 1 },
   { 0, 'c',   1, .call=of_iassign,  .iassignto= &check_interval        },
   { 0 }
 };
 
-static uid_t us;
-static const char *run_base, *script, *socket_path;
-static const char *run_base_mkdir_p;
-static int stderr_copy;
-
-static bool find_run_base_var_run(void) {
-  struct stat stab;
-  char *try;
-  int r;
-
-  try = m_asprintf("%s/%lu", "/var/run/user", us);
-  r = lstat(try, &stab);
-  if (r<0) {
-    if (errno == ENOENT ||
-       errno == ENOTDIR ||
-       errno == EACCES ||
-       errno == EPERM)
-      return 0; /* oh well */
-    diee("stat /var/run/user/UID");
-  }
-  if (!S_ISDIR(stab.st_mode)) {
-    warning("%s not a directory, falling back to ~\n", try);
-    return 0;
-  }
-  if (stab.st_uid != us) {
-    warning("%s not owned by uid %lu, falling back to ~\n", try,
-           (unsigned long)us);
-    return 0;
-  }
-  if (stab.st_mode & 0077) {
-    warning("%s writeable by group or other, falling back to ~\n", try);
-    return 0;
-  }
-  run_base = m_asprintf("%s/%s", try, "cgi-fcgi-interp");
-  return 1;
+void fusagemessage(FILE *f) {
+  fprintf(f, "usage: #!/usr/bin/cgi-fcgi-interp [<options>]\n");
 }
 
-static bool find_run_base_home(void) {
-  struct passwd *pw;
-  struct utsname ut;
-  char *dot, *try;
-  int r;
-
-  pw = getpwuid(us);  if (!pw) diee("getpwent(uid)");
+void ident_addinit(void) {
+}
 
-  r = uname(&ut);   if (r) diee("uname(2)");
-  dot = strchr(ut.nodename, '.');
-  if (dot) *dot = 0;
-  if (sizeof(ut.nodename) > 32)
-    ut.nodename[32] = 0;
+static int stderr_copy;
 
-  run_base_mkdir_p = m_asprintf("%s/%s", pw->pw_dir, ".cgi-fcgi-interp");
-  try = m_asprintf("%s/%s", run_base_mkdir_p, ut.nodename);
-  run_base = try;
-  return 1;
+static void make_stderr_copy(void) {
+  stderr_copy = dup(2);
+  if (stderr_copy < 0) diee("dup stderr (for copy for stage2)");
 }
 
-static void find_socket_path(void) {
-  struct sockaddr_un sun;
+static void prep_stage2(void) {
   int r;
-
-  us = getuid();  if (us==(uid_t)-1) diee("getuid");
-
-  find_run_base_var_run() ||
-    find_run_base_home() ||
-    (abort(),0);
-
-  int maxidentlen = sizeof(sun.sun_path) - strlen(run_base) - 10 - 2;
-
-  if (!ident) {
-    if (maxidentlen < MINHEXHASH)
-      die("base directory `%s'"
-         " leaves only %d characters for id hash"
-         " which is too little (<%d)",
-         run_base, maxidentlen, MINHEXHASH);
-
-    int identlen = maxidentlen > 64 ? 64 : maxidentlen;
-    char *hexident = xmalloc(identlen + 2);
-    unsigned char bbuf[32];
-    int i;
-
-    ident_addstring(0,interp);
-    ident_addstring(0,script);
-    sha256_digest(&identsc,sizeof(bbuf),bbuf);
-
-    for (i=0; i<identlen; i += 2)
-      sprintf(hexident+i, "%02x", bbuf[i/2]);
-
-    hexident[identlen] = 0;
-    ident = hexident;
-  }
-
-  if (strlen(ident) > maxidentlen)
-    die("base directory `%s' plus ident `%s' too long"
-       " (with spare) for socket (max ident %d)\n",
-       run_base, ident, maxidentlen);
-
-  r = mkdir(run_base, 0700);
-  if (r && errno==ENOENT && run_base_mkdir_p) {
-    r = mkdir(run_base_mkdir_p, 0700);
-    if (r) diee("mkdir %s (since %s was ENOENT)",run_base_mkdir_p,run_base);
-    r = mkdir(run_base, 0700);
-  }
-  if (r) {
-    if (!(errno == EEXIST))
-      diee("mkdir %s",run_base);
-  }
-
-  socket_path = m_asprintf("%s/s%s",run_base,ident);
-}  
-
-/*
- * Regarding the macro timespeccmp:
- *
- * Copyright (c) 1982, 1986, 1993
- *      The Regents of the University of California.  All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions
- * are met:
- * 1. Redistributions of source code must retain the above copyright
- *    notice, this list of conditions and the following disclaimer.
- * 2. Redistributions in binary form must reproduce the above copyright
- *    notice, this list of conditions and the following disclaimer in the
- *    documentation and/or other materials provided with the distribution.
- * 4. Neither the name of the University nor the names of its contributors
- *    may be used to endorse or promote products derived from this software
- *    without specific prior written permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
- * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
- * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
- * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
- * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
- * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
- * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
- * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
- * SUCH DAMAGE.
- *
- *      @(#)time.h      8.5 (Berkeley) 5/4/95
- * $FreeBSD: head/sys/sys/time.h 275985 2014-12-21 05:07:11Z imp $
- */
-#ifndef timespeccmp
-#define timespeccmp(tvp, uvp, cmp)                                      \
-        (((tvp)->tv_sec == (uvp)->tv_sec) ?                             \
-            ((tvp)->tv_nsec cmp (uvp)->tv_nsec) :                       \
-            ((tvp)->tv_sec cmp (uvp)->tv_sec))
-#endif /*timespeccmp*/
-
-
+  
+  const char *stage2_val = m_asprintf("%d", stderr_copy);
+  r = setenv(STAGE2_VAR, stage2_val, 1);
+  if (r) diee("set %s (to announce to stage2)", STAGE2_VAR);
+}
 
 #ifdef st_mtime
 
@@ -497,13 +253,7 @@ static void tidy_garbage(void) {
   int lockfd = -1;
   int r;
 
-  const char *lock_path = m_asprintf("%s/l%s",run_base,ident);
-
-  lockfd = open(lock_path, O_CREAT|O_RDWR, 0600);
-  if (lockfd<0) diee("create lock (%s)", lock_path);
-
-  r = flock(lockfd, LOCK_EX);
-  if (r) diee("lock lock (%s)", lock_path);
+  lockfd = acquire_lock();
 
   if (check_garbage()) {
     r = unlink(socket_path);
@@ -517,27 +267,6 @@ static void tidy_garbage(void) {
   if (r) diee("close lock (%s)", lock_path);
 }
 
-static void make_stderr_copy(void) {
-  stderr_copy = dup(2);
-  if (stderr_copy < 0) diee("dup stderr (for copy for stage2)");
-}
-
-static void prep_stage2(void) {
-  int r;
-  
-  const char *stage2_val = m_asprintf("%d", stderr_copy);
-  r = setenv(STAGE2_VAR, stage2_val, 1);
-  if (r) diee("set %s (to announce to stage2)", STAGE2_VAR);
-}
-
-static void shbang_opts(const char *const **argv_io,
-                       const struct cmdinfo *cmdinfos) {
-  myopt(argv_io, cmdinfos);
-
-  interp = *(*argv_io)++;
-  if (!interp) badusage("need interpreter argument");
-}
-
 /* stage2 predeclarations */
 static void record_baseline_time(void);
 static void become_pgrp(void);
@@ -547,8 +276,7 @@ static void queue_alarm(void);
 static void start_logging(void);
 static void await_something(void);
 
-int main(int argc, const char *const *argv) {
-  const char *smashedopt;
+int main(int unused_argc, const char *const *argv) {
   int r;
 
   stage2 = getenv(STAGE2_VAR);
@@ -568,41 +296,7 @@ int main(int argc, const char *const *argv) {
     if (r) diee("close saved stderr fd");
   }
 
-  sha256_init(&identsc);
-
-  if (argc>=2 &&
-      (smashedopt = argv[1]) &&
-      smashedopt[0]=='-' &&
-      (strchr(smashedopt,' ') || strchr(smashedopt,','))) {
-    /* single argument containg all the options and <interp> */
-    argv += 2; /* eat argv[0] and smashedopt */
-    const char *split_args[MAX_OPTS+1];
-    int split_argc = 0;
-    split_args[split_argc++] = argv[0];
-    for (;;) {
-      if (split_argc >= MAX_OPTS) die("too many options in combined arg");
-      split_args[split_argc++] = smashedopt;
-      if (smashedopt[0] != '-') /* never true on first iteration */
-       break;
-      char *delim = strchr(smashedopt,' ');
-      if (!delim) delim = strchr(smashedopt,',');
-      if (!delim) badusage("combined arg lacks <interpreter>");
-      *delim = 0;
-      smashedopt = delim+1;
-    }
-    assert(split_argc <= MAX_OPTS);
-    split_args[split_argc++] = 0;
-
-    const char *const *split_argv = split_args;
-
-    shbang_opts(&split_argv, cmdinfos);
-    /* sets interp */
-    if (!split_argv) badusage("combined arg too many non-option arguments");
-  } else {
-    shbang_opts(&argv, cmdinfos);
-  }
-
-  script = *argv++;
+  process_opts(&argv);
   if (!script) badusage("need script argument");
 
   if (!stage2) {
index b0542926a29085f660a7b653f3a1883452122281..e8efed6639801ea538a73551b89962bed6b52618 100644 (file)
@@ -41,3 +41,10 @@ void *xmalloc(size_t sz) {
   if (!r) common_diee("malloc");
   return r;
 }
+
+void nonblock(int fd) {
+  int r;
+  r= fcntl(fd,F_GETFL);  if (r<0) common_diee("nonblock fcntl F_GETFL");
+  r |= O_NONBLOCK;
+  r= fcntl(fd,F_SETFL,r);  if (r<0) common_diee("nonblock fcntl F_GETFL");
+}
index a7a2cdd79251a16ad81978f159aeedd1efb4cbd5..94a1a5eb1492d3c9bf4ecb61f6735374604928d3 100644 (file)
 
 #define _GNU_SOURCE
 
+#include <assert.h>
 #include <stdarg.h>
 #include <stdio.h>
 #include <stdlib.h>
+#include <fcntl.h>
 
 char *m_vasprintf(const char *fmt, va_list al);
 char *m_asprintf(const char *fmt, ...);
@@ -38,7 +40,12 @@ char *m_asprintf(const char *fmt, ...);
 /* to be provided by program: */
 void common_die(const char *what);
 void common_diee(const char *what); /* prints errno */
+void nonblock(int fd);
 
 void *xmalloc(size_t sz);
 
+#define FILLZERO(object) (memset((&object),0,sizeof(object)))
+
+extern char **environ; // no header file for this, srsly!
+
 #endif /*COMMON_H*/
index 8a8c67010de2c7bffb37f24e5a025e094d30210a..ead525fba84009fe1e99adee7dd9ec9c3ea8d121 100644 (file)
 
 #include <endian.h>
 #include <sys/types.h>
-#include <fcntl.h>
 #include <sys/socket.h>
 #include <netinet/in.h>
 #include <arpa/inet.h>
 
 #include "myopt.h"
+#include "common.h"
 
 typedef unsigned char Byte;
 
@@ -152,13 +152,6 @@ MARS
 
 /*---------- general stuff ----------*/
 
-static void nonblock(int fd) {
-  int r;
-  r= fcntl(fd,F_GETFL);  if (r<0) sysfail("nonblock fcntl F_GETFL");
-  r |= O_NONBLOCK;
-  r= fcntl(fd,F_SETFL,r);  if (r<0) sysfail("nonblock fcntl F_GETFL");
-}
-
 static void blocksignals(int how) {
   sigset_t set;
   int r;
diff --git a/cprogs/prefork-interp.c b/cprogs/prefork-interp.c
new file mode 100644 (file)
index 0000000..56d6040
--- /dev/null
@@ -0,0 +1,1058 @@
+/*
+ * "Interpreter" that you can put in #! like this
+ *   #!/usr/bin/prefork-interp [<options>] <interpreter>
+ * to amortise the startup time of a script.
+ *
+ * Usages:
+ *   prefork-interp  [<option> ..] <interpreter>  [<script> [<args> ...]]
+ *   prefork-interp  [<option>,..],<interpreter>   <script> [<args> ...]
+ *   prefork-interp '[<option> ..] <interpreter>'  <script> [<args> ...]
+ *
+ * The script must load a corresponding library (eg Proc::Prefork::Interp
+ * for Perl) and call its preform_initialisation_complete routine.
+ *
+ * Options must specify argument/environment mediation approach.
+ * Currently the only args/env mediation supported is:
+ *
+ *   -U    unlaundered: setup and executor both get all arguments and env vars
+ *         ident covers only env vars specified with -E
+ *         ident covers only two arguments: interpreter and (if present) script
+ *
+ * Options for setting the operation mode:
+ *
+ *   (none)     Default: start new server if needed, then run service
+ *   -f         Force a fresh service (old one is terminated)
+ *   --kill     Kill any existing service; do not actually run anything
+ *
+ * Options for controlling whether different invocations share a server:
+ *
+ *   -E VAR      ident includes env var VAR (or its absence)
+ *   -G STRING   ident includes string STRING
+ *   -g IDENT    use IDENT rather than hex(SHA256(... identity things ...))
+ *
+ * (Ordering of -E and -G options is relevant; invocations with different
+ * -E -G options are different even if the env var settings are the same)
+ */
+
+/*
+***************************************************************************
+\f
+  State during service execution, process parentage and key fds
+
+      CALLER
+        ||
+        ||
+        ||                               listen     watch-err/in
+        ||       call                 (accept) \     ,------2
+        || ,-----------------------------.     SERVER -----0 WATCHER(C)
+      CLIENT 2--=fdpassed>=---------.     \      || &&          |      &&
+       (C)  1--=fdpassed>=---------. \     \     ||           inotify
+           0--=fdpassed>=---------. \ \     \    ||           sockpath
+                                   \ \ \     \   ||
+                                   | | |\     |  ||
+                                   | | | \    |  ||
+                                   | \ |  \   \  ||
+                                    \ \ \  \   MONITOR &
+                                     \ \ \  `12  ||  |
+                                      \ \ \      ||  |
+                                       \ \ \     ||  |execterm
+                                        \ \ \    ||  |
+                                         \ \ \   ||  |
+                                          \ \ 2  ||  |
+                                           \ 1 EXECUTOR
+                                            0
+    ----      pipes, sockets
+    012       descriptors
+    -==-      fds shared
+    ||        process parentage
+    &&        session leader (daemon)
+    &         process group leader
+
+***************************************************************************
+\f
+ Control flow and causality
+
+      CALLER
+         |
+         |fork/exec
+         |
+      CLIENT
+         |
+      attempt to connect, and read greeting
+         |failure?                \success?
+         |                         \
+      tidy up stale /run entries    *1 (continue from send_fds, below)
+      acquire lock
+         |
+      retry attempt to connect, and read greeting
+         |failure?                \success?
+         |                         \
+      create listening socket     release lock
+         |                           \
+      fork/daemonise                  *1
+         |    `------------------.
+         |                      WATCHER(C) &&
+         |
+       make "fake" initial call socketpair                               (C)
+         |                                                    prefork-interp
+       fork/exec   #########################################################
+         |      `-------------.                                  application
+         |         #        SCRIPT (setup)
+         |         #          |
+         |         #       script initialisation
+         |         #          |                                  application
+         |         ###########|#############################################
+         |         #          |                               prefork-interp
+         |         #       identify fds from envirnment               (Perl)
+         |         #       open syslog
+         |         #          |
+         |         #       dzemonize
+         |   ,.....<....../   |
+      waitpid      #        fork for initial service
+         |         #          |child?       |parent?
+         |         #          |             |
+         |         #          |         SCRIPT [server] &&
+         |         #          |             |
+         |         #          |         ** accept / event loop **
+         |         #          |        accepted?    \      \ \
+         |         #          |            /         \ watch\ \idle
+         |         #          |        fork child     \stderr\ \timeout?
+         |         #          | _________/            |       | |
+         |         #          |/                      |read?  | |
+         |         #     SCRIPT [monitor]             |   eof?| |
+         |         #       setpgrpt &                 |       | |
+         |         #          |                     log msg   | |
+       read   ,....<.....send greeting                |       | |
+      greeting     #          |                    ___________________
+         |         #          |
+      release      #          |
+      lock    *1   #          |
+         |   /     #          |
+      send fds.....>....      |
+         |         #    \receive fds
+         |         #             |
+         |         #         fork for executor                        (Perl)
+         |         #          |parent?        \child?         prefork-interp
+         |         #          |          ######\############################
+         |         #          |          #  SCRIPT (executor)    application
+         |         #          |          #  execute service
+         |         #    wait for read    #       |
+         |         #      (select)       #   terminates
+         |         #        |   |        #       |
+         |         #            |        #    kernel closes execterm
+         |         #            | ,......<....../|
+         |         #      execterm?      #       |
+         |         #            |        #     zombie
+         |         #        |   | ,......<...../
+         |         #       waitpid       #  _______________
+         |         #          |          #
+         |    ,....<....,..send status   #
+    read status    #  ________________   #
+   _____________   #
+
+
+  ********** Or, if client is killed **********
+
+         |         #          |          #  execute service
+     terminates    #    wait for read    #       |
+         |         #      (select)       #       |
+      kernel       #        |   |        #       |
+     closes call   #        |            #       |
+                \..>......_ |            #       |
+   _____________   #       \|call?       #       |
+                   #        |            #       |
+                   #  kill whole pgrp... #    killled
+                   #        |            #     zombie
+                   #        |   | ,......<....../
+                   #       waitpid       #  _______________
+                   #          |          #
+                   #   send exit status  #
+                   #  _____SIGPIPE______ #
+
+    | - \ /    process control flow
+    ... < >    causes mediated by fds or other IPC etc.
+    &&         session leader (daemon)
+    &          process group leader
+    #          language/implementation boundary
+    *1         line continued elsewhere
+    event?     condition
+    ______     process termination (after reaping, if shown)
+
+***************************************************************************
+\f
+  Sequence of events and fd pluming.
+  NB INCOMPLETE - does not cover execterm, cleanup
+   client (C wrapper)        connects to server
+                               (including reading ack byte)
+                             if fails or garbage
+                             === acquires lock ===
+                             makes new listening socket
+                             makes watcher pipes
+                             forks watcher and awaits
+                             makes first-instance socketpair
+                             forks setup (script, sock fds indicated in env)
+                             fd0, fd1, fd2: from-outer
+                             other fd: call(client-end)(fake)
+                             reaps setup (and reports error)
+                             (implicitly releases lock)
+      watcher                fd[012]: watcher pipes
+                             starts watch on socket path
+                             sets stderr to line buffered
+                             sets stdin to nonblocking
+                             daemonises (one fork, becomes session leader)
+                             when socket stat changes, quit
+      setup (pre-exec)       fd0: null,
+                             fd[12]: fd2-from-outer
+                             env fds: listener, call(server-end)(fake),
+                                       watcher read, watcher write
+                             close fd: lockfile
+                             possibly clean env, argv
+      setup (script)         runs initialisation parts of the script
+                             at prefork establishment point:
+      setup (pm) [1]         opens syslog
+                             forks for server
+                 [2]         exits
+         server (pm) [1]     [fd0: null],
+                             [fd[12]: fd2-from-outer]
+                             setsid
+                             right away, forks init monitor
+                     [2]     closes outer caller fds and call(fake)
+         [server (pm)]       fd[012]: null
+                             other fds: listener, syslog
+                             runs in loop accepting and forking,
+                             reaping and limiting children (incl init monitor)
+                             reports failures of monitors to syslog
+   [client (C wrapper)]      if client connect succeeds:
+                             now fd: call(client-end)
+                                sends message with: cmdline, env
+                                sends fds
+         [server (script)]   accepts, forks subseq monitor
+           monitor [1]       [fd0: null]
+            (init            [fd[12]: init: fd2-from-outer; subseq: null]
+              or             errors: init: fd2; subseq: syslog
+             subseq)         other fds: syslog, call(server-end)
+                             sends ack byte
+                             receives args, env, fds
+                             forks executor
+             executor        sorts out fds:
+                             fd0, fd1, fd2: from-outer
+                             close fds: call(server-end)
+                             retained fds: syslog
+                             sets cmdline, env
+                             runs main part of script
+                             exits normally
+           [monitor]         [fd[012]: null]
+                             [fd[12]: init: fd2-from-outer; subseq: null]
+                             [errors: init: fd2; subseq: syslog]
+                             reaps executor
+                             reports status via socket
+     [client (C wrapper)]    [fd0, fd1, fd2: from-outer]
+                             [other fd: call(client-end)]
+                             receives status, exits appropriately
+                             (if was bad signal, reports to stderr, exits 127)
+
+***************************************************************************
+\f
+  Protocol, and functions of the script
+
+  1. Script interpreter will be spawned apparently as normal;
+     should run synchronously in the normal way until
+     "initialisation complete" point.  At initialisation complete:
+
+  2. Env var PREFORK_INTERP contains:
+
+         v1,SECS.NSECS[,...] LISTEN,CALL,WATCHE,WATCHI[,...][ ???]
+
+     To parse it: treat as bytes and split on ASCII space, taking
+     the first two words.  (There may or may not be
+     further "words"; and if there are they might be binary data.)
+     Then split each of the first two words (which will contain only
+     ASCII printing characters) on comma.  Take the first two items:
+
+        v1    Protocol version indicator - literal.  If something else,
+              fail (means installation is incompatible somehow).
+
+        SECS.NSECS
+              timestamp just before script started running, as a
+              decimal time_t.  NSECS is exactly 9 digits.
+              To be used for auto reloading (see below).
+
+     The 2nd word's items are file descriptors:
+
+        LISTEN   listening socket                 nonblocking
+        CALL     call socket for initial call     blocking
+        WATCHE   liveness watcher stderr          nonblocking
+        WATCHI   liveness sentinel                unspecified
+
+        (any further descriptors should be ignored, not closed)
+
+  3. Library should do the following:
+
+     1. Read and understand the PREFORK_INTERP env var.
+        If it is not set, initialisation complete should simply return.
+        (This allows simple synchronous operation.)
+
+     2. Open syslog
+     3. fork/exit (fork and have parent exit) (to make server)
+     4. setsid (to become session leader)
+     5. fork initial service (monitor) child, using CALL (see below)
+     6. Replace stdin/stdout/stderr with /dev/null,
+        and make a note to send all error messages to syslog
+     7. Enter select loop, looking for the following:
+
+        A. accept on LISTEN:
+            i. see if we need to reload: is any file forming part
+               of the program newer than the SECS.NSECS ?
+               If so, log at LOG_INFO, and exit immediately
+               (dropping CALL, LISTEN, WATCHI, etc.)
+            ii. see if we can reap any children, possibly waiting
+               for children if we are at our concurrency limit
+               (limit should be configured through library, default 4)
+               Report child exit status if not zero or SIGPIPE.
+            iii. fork service (monitor) child, using accepted fd
+
+        B. WATCHE is readable:
+            * EOF: log at LOG_INFO, and exit
+            * data to read: read what is available immediately;
+              it will be an error message: log it at LOG_ERR, and exit
+
+  4. service (monitor) child does the following:
+
+      1. close all of LISTEN, WATCHI, WATCHE
+      2. setpgrp
+      3. send a greeting (on CALL) "PFI\n\0\0\0\0" (8 bytes)
+      4. read a single byte, fail if it's not zero
+      5. three times, receive a single byte with a file descriptor
+         attached as ancillary data.  (These descriptors will be
+         service stdin, stdout, stderr.)
+      6. read a 4-byte big-endian length
+      7. read that many bytes, the initial service request message,
+         which contains the following nul-terminated strings:
+            * environment variable settings in the format NAME=value
+            * an empty string
+            * arguments NOT INCLUDING argv[0] or script filename
+         (not that this means the service request must end in a nul)
+      8. make a new pipe EXECTERM
+      9. fork for the service executor; in the child
+            i. redirect stdin/stdout/stderr to the recevied fds
+            ii. replace environment and arguments with those received,
+            iii. close descriptors: close the original received descriptors;
+                 close CALL; keep only the writing end of EXECTERM
+            iv. if the script programming language does things with SIGINT,
+                set it set back to default handling (immediate termination).
+            v. return back to script, now in the grandchild
+
+      10. in the parent, close EXECTERM writing end, and
+      11. select, looking for one of the following:
+           * CALL is readable
+           * EXECTERM reading end is readable
+          No need to actually read, since these shouldn't produce
+          spurious wakeups (but do loop on EINTR).
+      12. set SIGINT to ignored
+      13. send SIGINT to the entire process group
+      14. wait, blocking, for the executor child
+      15. write the wait status, in 32-bit big-endian, to CAL
+      16. exit 0
+
+     Errors detected in the service monitor should be sent to
+     syslog, or stderr, depending on whether this is the initial
+     service monitor (from part 3 step 5) or an accepted socket
+     service monitor (from part 4 step 9); this can be achieved
+     easily by having a global flag (set at part 3 step 6),
+     or perhaps using logger(8) and redirecting stderr (but
+     then be careful to ensure everyone gets only the necessary fds).
+
+     EOF on CALL, or EPIPE/SIGPIPE writing to it, are not errors.
+     In this case, exit zero or die with SIGPIPE, so parent
+     won't report error either (part 3 step 7(A)(ii)).
+
+***************************************************************************
+\f
+*/
+
+#include <arpa/inet.h>
+#include <sys/utsname.h>
+
+#include <uv.h>
+
+#include "prefork.h"
+
+const char our_name[] = "prefork-interp";
+
+static struct sockaddr_un sockaddr_sun;
+static FILE *call_sock;
+
+#define ACK_BYTE '\n'
+
+static const char *const *executor_argv;
+
+static const char header_magic[4] = "PFI\n";
+
+void fusagemessage(FILE *f) {
+  fprintf(f, "usage: #!/usr/bin/prefork-interp [<options>]\n");
+}
+
+#define MODE_NORMAL 0
+#define MODE_KILL   'k'
+#define MODE_FRESH  'f'
+
+#define MEDIATION_UNSPECIFIED 0
+#define MEDIATION_UNLAUNDERED 'U'
+
+static int mediation = MEDIATION_UNSPECIFIED;
+static int mode = MODE_NORMAL;
+static int max_sockets = 100; // maximum entries in the run dir is 2x this
+
+static struct stat initial_stab;
+
+const struct cmdinfo cmdinfos[]= {
+  PREFORK_CMDINFOS
+  { 0,         'U',   0, .iassignto= &mediation, .arg= MEDIATION_UNLAUNDERED },
+  { "kill",     0,    0, .iassignto= &mode,      .arg= MODE_KILL   },
+  { 0,         'f',   0, .iassignto= &mode,      .arg= MODE_FRESH  },
+  { 0 }
+};
+
+static void ident_add_stat(const char *path) {
+  struct stat stab;
+  int r = stat(path, &stab);
+  if (r) diee("failed to stat %s", path);
+
+  IDENT_ADD_OBJ(path[0], stab.st_dev);
+  IDENT_ADD_OBJ('i',     stab.st_ino);
+}
+
+void ident_addinit(void) {
+  ident_add_key_byte(1);
+
+  struct utsname uts = { };
+  size_t utslen = sizeof(uts);
+  int r = uname(&uts);
+  if (r) diee("uname failed!");
+  IDENT_ADD_OBJ('u', utslen);
+  IDENT_ADD_OBJ('u', uts);
+
+  ident_add_stat(".");
+  ident_add_stat("/");
+}
+
+static void propagate_exit_status(int status, const char *what) {
+  int r;
+
+  if (WIFEXITED(status)) {
+    _exit(WEXITSTATUS(status));
+  }
+
+  if (WIFSIGNALED(status)) {
+    int sig = WTERMSIG(status);
+    const char *signame = strsignal(sig);
+    if (signame == 0) signame = "unknown signal";
+
+    if (! WCOREDUMP(status) &&
+       (sig == SIGINT ||
+        sig == SIGTERM ||
+        sig == SIGHUP ||
+        sig == SIGPIPE ||
+        sig == SIGKILL)) {
+      struct sigaction sa;
+      FILLZERO(sa);
+      sa.sa_handler = SIG_DFL;
+      if (sig != SIGKILL) {
+        r = sigaction(sig, &sa, 0);
+        if (r) diee("failed to reset signal handler while propagating %s",
+                    signame);
+
+        sigset_t sset;
+        sigemptyset(&sset);
+        sigaddset(&sset, sig);
+        r = sigprocmask(SIG_UNBLOCK, &sset, 0);
+        if (r) diee("failed to reset signal block while propagating %s",
+                    signame);
+      }
+
+      raise(sig);
+      die("unexpectedly kept running after raising (to propagate) %s",
+         signame);
+    }
+
+    die("%s failed due to signal %d %s%s", what, sig, signame,
+       WCOREDUMP(status) ? " (core dumped)" : "");
+  }
+
+  die("%s failed with weird wait status %d 0x%x", what, status, status);
+}
+
+typedef struct {
+  char *name_hash;
+  time_t atime;
+} PrecleanEntry;
+
+static int preclean_entry_compar_name(const void *av, const void *bv) {
+  const PrecleanEntry *a = av;
+  const PrecleanEntry *b = bv;
+  return strcmp(a->name_hash, b->name_hash);
+}
+
+static int preclean_entry_compar_atime(const void *av, const void *bv) {
+  const PrecleanEntry *ae = av;  time_t a = ae->atime;
+  const PrecleanEntry *be = bv;  time_t b = be->atime;
+  return (a > b ? +1 :
+         a < b ? -1 : 0);
+}
+
+static time_t preclean_stat_atime(const char *s_path) {
+  struct stat stab;
+  int r= lstat(s_path, &stab);
+  if (r) {
+    if (errno!=ENOENT) diee("pre-cleanup: stat socket (%s)", s_path);
+    return 0;
+  }
+  return stab.st_atime;
+}
+
+static void preclean(void) {
+  DIR *dir = opendir(run_base);
+  if (!dir) {
+    if (errno == ENOENT) return;
+    diee("pre-cleanup: open run dir (%s)", run_base);
+  }
+
+  PrecleanEntry *entries=0;
+  size_t avail_entries=0;
+  size_t used_entries=0;
+
+  struct dirent *de;
+  while ((errno = 0, de = readdir(dir))) {
+    char c0 = de->d_name[0];
+    if (!(c0 == 'l' || c0 == 's')) continue;
+    char *name_hash = m_asprintf("%s", de->d_name+1);
+    char *s_path = m_asprintf("%s/s%s", run_base, name_hash);
+    time_t atime = preclean_stat_atime(s_path);
+
+    if (avail_entries == used_entries) {
+      assert(avail_entries < INT_MAX / 4 / sizeof(PrecleanEntry));
+      avail_entries <<= 1;
+      avail_entries += 10;
+      entries = realloc(entries, avail_entries * sizeof(PrecleanEntry));
+    }
+    entries[used_entries].name_hash = name_hash;
+    entries[used_entries].atime = atime;
+    used_entries++;
+  }
+  if (errno) diee("pre-cleanup: read run dir (%s)", run_base);
+
+  // First we dedupe (after sorting by path)
+  qsort(entries, used_entries, sizeof(PrecleanEntry),
+       preclean_entry_compar_name);
+  PrecleanEntry *p, *q;
+  for (p=entries, q=entries; p < entries + used_entries; p++) {
+    if (q > entries && !strcmp(p->name_hash, (q-1)->name_hash))
+      continue;
+    *q++ = *p;
+  }
+  used_entries = q - entries;
+
+  // Now maybe delete some things
+  //
+  // Actually this has an off-by-one error since we are about
+  // to create a socket, so the actual number of sockets is one more.
+  // But, *actually*, since there might be multiple of us running at once,
+  // we might have even more than that.  This doesn't really matter.
+  if (used_entries > max_sockets) {
+    qsort(entries, used_entries, sizeof(PrecleanEntry),
+         preclean_entry_compar_atime);
+    for (p=entries; p < entries + max_sockets; p++) {
+      char *l_path = m_asprintf("%s/l%s", run_base, p->name_hash);
+      char *s_path = m_asprintf("%s/s%s", run_base, p->name_hash);
+      int lock_fd = flock_file(l_path);
+      // Recheck atime - we might have raced!
+      time_t atime = preclean_stat_atime(s_path);
+      if (atime != p->atime) {
+       // Raced.  This will leave use deleting too few things.  Whatever.
+      } else {
+       int r= unlink(s_path);
+       if (r && errno!=ENOENT) diee("preclean: delete stale (%s)", s_path);
+       r= unlink(l_path);
+       if (r) diee("preclean: delete stale lock (%s)", s_path);
+       // NB we don't hold the lock any more now.
+      }
+      close(lock_fd);
+      free(l_path);
+      free(s_path);
+    }
+  }
+
+  for (p=entries; p < entries + used_entries; p++)
+    free(p->name_hash);
+  free(entries);
+}
+
+static __attribute((noreturn)) void die_data_overflow(void) {
+  die("cannot handle data with length >2^32");
+}
+
+static void prepare_data(size_t *len, char **buf,
+                        const void *data, size_t dl) {
+  if (len) {
+    if (dl >= SIZE_MAX - *len)
+      die_data_overflow();
+    *len += dl;
+  }
+  if (buf) {
+    memcpy(*buf, data, dl);
+    *buf += dl;
+  }
+}
+
+static void prepare_length(size_t *len, char **buf, size_t dl_sz) {
+  if (dl_sz > UINT32_MAX) die_data_overflow();
+  uint32_t dl = htonl(dl_sz);
+  prepare_data(len, buf, &dl, sizeof(dl));
+}
+
+static void prepare_string(size_t *len, char **buf, const char *s) {
+  size_t sl = strlen(s);
+  prepare_data(len, buf, s, sl+1);
+}
+
+static void prepare_message(size_t *len, char **buf) {
+  const char *s;
+
+  const char *const *p = (void*)environ;
+  while ((s = *p++)) {
+    if (strchr(s, '='))
+      prepare_string(len, buf, s);
+  }
+
+  prepare_string(len, buf, "");
+
+  p = executor_argv;
+  while ((s = *p++))
+    prepare_string(len, buf, s);
+}
+
+static void send_fd(int payload_fd) {
+  int via_fd = fileno(call_sock);
+
+  union {
+    struct cmsghdr align;
+    char buf[CMSG_SPACE(sizeof(payload_fd))];
+  } cmsg_buf;
+
+  struct msghdr msg;
+  FILLZERO(msg);
+  FILLZERO(cmsg_buf);
+
+  char dummy_byte = 0;
+  struct iovec iov;
+  FILLZERO(iov);
+  iov.iov_base = &dummy_byte;
+  iov.iov_len = 1;
+
+  msg.msg_name = 0;
+  msg.msg_iov = &iov;
+  msg.msg_iovlen = 1;
+  msg.msg_control = cmsg_buf.buf;
+  msg.msg_controllen = sizeof(cmsg_buf.buf);
+
+  struct cmsghdr *cmsg = CMSG_FIRSTHDR(&msg);
+  cmsg->cmsg_level = SOL_SOCKET;
+  cmsg->cmsg_type = SCM_RIGHTS;
+  cmsg->cmsg_len = CMSG_LEN(sizeof(payload_fd));
+  *(int*)CMSG_DATA(cmsg) = payload_fd;
+
+  msg.msg_controllen = sizeof(cmsg_buf.buf);
+
+  for (;;) {
+    ssize_t r = sendmsg(via_fd, &msg, 0);
+    if (r == -1) {
+      if (errno == EINTR) continue;
+      diee("send fd");
+    }
+    assert(r == 1);
+    break;
+  }
+}
+
+static void send_request(void) {
+  char ibyte= 0;
+  ssize_t sr = fwrite(&ibyte, 1, 1, call_sock);
+  if (sr != 1) diee("write signalling byte");
+
+  // Sending these before the big message makes it easier for the script to
+  // use buffered IO for the message.
+  send_fd(0);
+  send_fd(1);
+  send_fd(2);
+
+  size_t len = 0;
+  prepare_message(&len, 0);
+
+  size_t tlen = len + 4;
+  char *m = xmalloc(tlen);
+  char *p = m;
+  prepare_length(0, &p, len);
+  prepare_message(0, &p);
+  assert(p == m + tlen);
+
+  sr = fwrite(m, tlen, 1, call_sock);
+  if (sr != 1) diee("write request (buffer)");
+
+  if (fflush(call_sock)) diee("write request");
+}
+
+static FILE *call_sock_from_fd(int fd) {
+  int r;
+
+  FILE *call_sock = fdopen(fd, "r+");
+  if (!call_sock) diee("fdopen socket");
+
+  r = setvbuf(call_sock, 0, _IONBF, 0);
+  if (r) die("setvbuf socket");
+
+  return call_sock;
+}
+
+static bool was_eof(FILE *call_sock) {
+  return feof(call_sock) || errno==ECONNRESET;
+}
+
+// Returns -1 on EOF
+static int protocol_read_maybe(void *data, size_t sz) {
+  if (!sz) return 0;
+  size_t sr = fread(data, sz, 1, call_sock);
+  if (sr != 1) {
+    if (was_eof(call_sock)) return -1;
+    diee("read() on monitor call socket (%zd)", sz);
+  }
+  return 0;
+}
+
+static void protocol_read(void *data, size_t sz) {
+  if (protocol_read_maybe(data, sz) < 0)
+    die("monitor process quit unexpectedly");
+}
+
+// Returns 0 if OK, error msg if peer was garbage.
+static const char *read_greeting(void) {
+  char got_magic[sizeof(header_magic)];
+
+  if (protocol_read_maybe(&got_magic, sizeof(got_magic)) < 0)
+    return "initial monitor process quit"
+      " (maybe script didn't call preform_initialisation_complete?)";
+
+  if (memcmp(got_magic, header_magic, sizeof(header_magic)))
+    die("got unexpected protocol magic 0x%02x%02x%02x%02x",
+       got_magic[0], got_magic[1], got_magic[2], got_magic[3]);
+
+  uint32_t xdata_len;
+  protocol_read(&xdata_len, sizeof(xdata_len));
+  void *xdata = xmalloc(xdata_len);
+  protocol_read(xdata, xdata_len);
+
+  return 0;
+}
+
+// Returns: call(client-end), or 0 to mean "is garbage"
+// find_socket_path must have been called
+static FILE *connect_existing(void) {
+  int r;
+  int fd = -1;
+
+  if (mode != MODE_NORMAL) return 0;
+
+  fd = socket(AF_UNIX, SOCK_STREAM, 0);
+  if (fd==-1) diee("socket() for client");
+
+  socklen_t salen = sizeof(sockaddr_sun);
+  r = connect(fd, (const struct sockaddr*)&sockaddr_sun, salen);
+  if (r==-1) {
+    if (errno==ECONNREFUSED || errno==ENOENT) goto x_garbage;
+    diee("connect() %s", socket_path);
+  }
+
+  call_sock = call_sock_from_fd(fd);
+  fd = -1;
+
+  if (read_greeting())
+    goto x_garbage;
+
+  return call_sock;
+
+ x_garbage:
+  if (call_sock) { fclose(call_sock); call_sock=0; }
+  if (fd >= 0) close(fd);
+  return 0;
+}
+
+static void watcher_cb_stdin(uv_poll_t *handle, int status, int events) {
+  char c;
+  int r;
+
+  if ((errno = -status)) diee("watcher: poll stdin");
+  for (;;) {
+    r= read(0, &c, 1);
+    if (r!=-1) _exit(0);
+    if (!(errno==EINTR || errno==EWOULDBLOCK || errno==EAGAIN))
+      diee("watcher: read sentinel stdin");
+  }
+}
+
+static void watcher_cb_sockpath(uv_fs_event_t *handle, const char *filename,
+                               int events, int status) {
+  int r;
+  struct stat now_stab;
+
+  if ((errno = -status)) diee("watcher: poll stdin");
+  for (;;) {
+    r= stat(socket_path, &now_stab);
+    if (r==-1) {
+      if (errno==ENOENT) _exit(0);
+      if (errno==EINTR) continue;
+      diee("stat socket: %s", socket_path);
+    }
+    if (!stabs_same_inode(&now_stab, &initial_stab))
+      _exit(0);
+  }
+}
+
+// On entry, stderr is still inherited, but 0 and 1 are the pipes
+static __attribute__((noreturn))
+void become_watcher(void) {
+  uv_loop_t loop;
+  uv_poll_t uvhandle_stdin;
+  uv_fs_event_t uvhandle_sockpath;
+  int r;
+
+  nonblock(0);
+
+  errno= -uv_loop_init(&loop);
+  if (errno) diee("watcher: uv_loop_init");
+
+  errno= -uv_poll_init(&loop, &uvhandle_stdin, 0);
+  if (errno) diee("watcher: uv_poll_init");
+  errno= -uv_poll_start(&uvhandle_stdin,
+                       UV_READABLE | UV_WRITABLE | UV_DISCONNECT,
+                       watcher_cb_stdin);
+  if (errno) diee("watcher: uv_poll_start");
+
+  errno= -uv_fs_event_init(&loop, &uvhandle_sockpath);
+  if (errno) diee("watcher: uv_fs_event_init");
+
+  errno= -uv_fs_event_start(&uvhandle_sockpath, watcher_cb_sockpath,
+                           socket_path, 0);
+  if (errno) diee("watcher: uv_fs_event_start");
+
+  // OK everything is set up, let us daemonise
+  if (dup2(1,2) != 2) diee("watcher: set daemonised stderr");
+  r= setvbuf(stderr, 0, _IOLBF, BUFSIZ);
+  if (r) diee("watcher: setvbuf stderr");
+
+  pid_t child = fork();
+  if (child == (pid_t)-1) diee("watcher: fork");
+  if (child) _exit(0);
+
+  if (setsid() == (pid_t)-1) diee("watcher: setsid");
+
+  r= uv_run(&loop, UV_RUN_DEFAULT);
+  die("uv_run returned (%d)", r);
+}
+
+static __attribute__((noreturn))
+void become_setup(int sfd, int lockfd, int fake_pair[2],
+                 int watcher_stdin, int watcher_stderr) {
+  close(lockfd);
+  close(fake_pair[0]);
+  int call_fd = fake_pair[1];
+
+  int null_0 = open("/dev/null", O_RDONLY);  if (null_0 < 0) diee("open null");
+  if (dup2(null_0, 0)) diee("dup2 /dev/null onto stdin");
+  close(null_0);
+  if (dup2(2, 1) != 1) die("dup2 stderr onto stdout");
+
+  nonblock(sfd);
+
+  // Extension could work like this:
+  //
+  // We could advertise a new protocol (perhaps one which is nearly entirely
+  // different after the connect) by putting a name for it comma-separated
+  // next to "v1".  Simple extension can be done by having the script
+  // side say something about it in the ack xdata, which we currently ignore.
+  // Or we could add other extra data after v1.
+  putenv(m_asprintf("PREFORK_INTERP=v1,%jd.%09ld %d,%d,%d,%d",
+                    (intmax_t)initial_stab.st_mtim.tv_sec,
+                    (long)initial_stab.st_mtim.tv_nsec,
+                   sfd, call_fd, watcher_stdin, watcher_stderr));
+
+  execvp(executor_argv[0], (char**)executor_argv);
+  diee("execute %s", executor_argv[0]);
+}
+
+static void connect_or_spawn(void) {
+  int r;
+
+  call_sock = connect_existing();
+  if (call_sock) return;
+
+  // We're going to make a new one, so clean out old ones
+  preclean();
+
+  int lockfd = acquire_lock();
+
+  if (mode == MODE_KILL) {
+    r= unlink(socket_path);
+    if (r && errno != ENOENT) diee("remove socket %s", socket_path);
+
+    r= unlink(lock_path);
+    if (r) diee("rmeove lock %s", lock_path);
+    _exit(0);
+  }
+
+  call_sock = connect_existing();
+  if (call_sock) { close(lockfd); return; }
+
+  // We must start a fresh one, and we hold the lock
+
+  r = unlink(socket_path);
+  if (r<0 && errno!=ENOENT)
+    diee("failed to remove stale socket %s", socket_path);
+
+  int sfd = socket(AF_UNIX, SOCK_STREAM, 0);
+  if (sfd<0) diee("socket() for new listener");
+
+  socklen_t salen = sizeof(sockaddr_sun);
+  r= bind(sfd, (const struct sockaddr*)&sockaddr_sun, salen);
+  if (r<0) diee("bind() on new listener");
+
+  r= stat(socket_path, &initial_stab);
+  if (r<0) diee("stat() fresh socket");
+
+  // We never want callers to get ECONNREFUSED.  But:
+  // There is a race here: from my RTFM they may get ECONNREFUSED
+  // if they try between our bind() and listen().  But if they do, they'll
+  // acquire the lock (serialising with us) and retry, and then it will work.
+  r = listen(sfd, INT_MAX);
+  if (r<0) diee("listen() for new listener");
+
+  // Fork watcher
+
+  int watcher_stdin[2];
+  int watcher_stderr[2];
+  if (pipe(watcher_stdin) || pipe(watcher_stderr))
+    diee("pipe() for socket inode watcher");
+
+  pid_t watcher = fork();
+  if (watcher == (pid_t)-1) diee("fork for watcher");
+  if (!watcher) {
+    close(sfd);
+    close(lockfd);
+    close(watcher_stdin[1]);
+    close(watcher_stderr[0]);
+    if (dup2(watcher_stdin[0], 0) != 0 ||
+       dup2(watcher_stderr[1], 1) != 1)
+      diee("initial dup2() for watcher");
+    close(watcher_stdin[0]);
+    close(watcher_stderr[1]);
+    become_watcher();
+  }
+
+  close(watcher_stdin[0]);
+  close(watcher_stderr[1]);
+  nonblock(watcher_stderr[0]);
+
+  // Fork setup
+
+  int fake_pair[2];
+  r = socketpair(AF_UNIX, SOCK_STREAM, 0, fake_pair);
+  if (r<0) diee("socketpair() for fake initial connection");
+
+  pid_t setup_pid = fork();
+  if (setup_pid == (pid_t)-1) diee("fork for spawn setup");
+  if (!setup_pid) become_setup(sfd, lockfd, fake_pair,
+                              watcher_stdin[1], watcher_stderr[0]);
+  close(fake_pair[1]);
+  close(sfd);
+
+  call_sock = call_sock_from_fd(fake_pair[0]);
+
+  int status;
+  pid_t got = waitpid(setup_pid, &status, 0);
+  if (got == (pid_t)-1) diee("waitpid setup [%ld]", (long)setup_pid);
+  if (got != setup_pid) diee("waitpid setup [%ld] gave [%ld]!",
+                            (long)setup_pid, (long)got);
+  if (status != 0) propagate_exit_status(status, "setup");
+
+  const char *emsg = read_greeting();
+  if (emsg) die("setup failed: %s", emsg);
+
+  close(lockfd);
+  return;
+}
+
+static void make_executor_argv(const char *const *argv) {
+  switch (mediation) {
+  case MEDIATION_UNLAUNDERED: break;
+  default: die("need -U (specifying unlaundered argument handling)");
+  }
+
+  const char *arg;
+  #define EACH_NEW_ARG(EACH) {                 \
+    arg = interp; { EACH }                     \
+    if ((arg = script)) { EACH }               \
+    const char *const *walk = argv;            \
+    while ((arg = *walk++)) { EACH }           \
+  }
+
+  size_t count = 1;
+  EACH_NEW_ARG( (void)arg; count++; );
+
+  const char **out = calloc(count, sizeof(char*));
+  executor_argv = (const char* const*)out;
+  if (!executor_argv) diee("allocate for arguments");
+
+  EACH_NEW_ARG( *out++ = arg; );
+  *out++ = 0;
+}
+
+int main(int argc_unused, const char *const *argv) {
+  process_opts(&argv);
+
+  // Now we have
+  //  - possibly interp
+  //  - possibly script
+  //  - remaining args
+  // which ought to be passed on to the actual executor.
+  make_executor_argv(argv);
+
+  find_socket_path();
+  FILLZERO(sockaddr_sun);
+  sockaddr_sun.sun_family = AF_UNIX;
+  assert(strlen(socket_path) <= sizeof(sockaddr_sun.sun_path));
+  strncpy(sockaddr_sun.sun_path, socket_path, sizeof(sockaddr_sun.sun_path));
+
+  connect_or_spawn();
+
+  // We're committed now, send the request (or bail out)
+  send_request();
+
+  uint32_t status;
+  protocol_read(&status, sizeof(status));
+
+  status = ntohl(status);
+  if (status > INT_MAX) die("status 0x%lx does not fit in an int",
+                           (unsigned long)status);
+
+  propagate_exit_status(status, "invocation");
+}
diff --git a/cprogs/prefork.c b/cprogs/prefork.c
new file mode 100644 (file)
index 0000000..b8f4c8a
--- /dev/null
@@ -0,0 +1,285 @@
+/* common stuff for cgi-fcgi-interp and prefork-interp */
+/*
+ * Copyright 2016-2022 Ian Jackson and contributors to chiark-utils
+ * SPDX-License-Identifier: GPL-3.0-or-later
+ * There is NO WARRANTY.
+ */
+
+#include "prefork.h"
+
+const char *interp, *ident, *script, *socket_path, *lock_path;
+bool logging;
+struct sha256_ctx identsc;
+const char *run_base;
+
+static uid_t us;
+static const char *run_base_mkdir_p;
+
+void common_diee(const char *m) { diee("%s", m); }
+void common_die (const char *m) { die ("%s", m); }
+
+void vmsgcore(int estatus, int errnoval, const char *fmt, va_list al) {
+  int r;
+
+  if (logging) {
+    const char *fmt_use = fmt;
+    char *fmt_free = 0;
+    if (errnoval!=-1) {
+      r = asprintf(&fmt_free, "%s: %%m", fmt);
+      if (r) {
+       fmt_free = 0;
+      } else {
+       fmt_use = fmt_free;
+      }
+    }
+    vsyslog(LOG_ERR, fmt_use, al);
+    free(fmt_free);
+  } else {
+    fprintf(stderr, "%s: ", our_name);
+    vfprintf(stderr,fmt,al);
+    if (errnoval!=-1) fprintf(stderr,": %s",strerror(errnoval));
+    fputc('\n',stderr);
+  }
+  if (estatus) exit(estatus);
+}
+
+void usagemessage(void) { fusagemessage(stderr); }
+
+void of_help(const struct cmdinfo *ci, const char *val) {
+  fusagemessage(stdout);
+  if (ferror(stdout)) diee("write usage message to stdout");
+  exit(0);
+}
+
+void of_iassign(const struct cmdinfo *ci, const char *val) {
+  long v;
+  char *ep;
+  errno= 0; v= strtol(val,&ep,10);
+  if (!*val || *ep || errno || v<INT_MIN || v>INT_MAX)
+    badusage("bad integer argument `%s' for --%s",val,ci->olong);
+  *ci->iassignto = v;
+}
+
+void ident_add_key_byte(char key) {
+  sha256_update(&identsc,1,&key);
+}
+
+void ident_addstring(char key, const char *string) {
+  ident_add_key_byte(key);
+  sha256_update(&identsc,strlen(string)+1,string);
+}
+
+void off_ident_addstring(const struct cmdinfo *ci, const char *string) {
+  ident_addstring('G', string);
+}
+
+void off_ident_addenv(const struct cmdinfo *ci, const char *name) {
+  ident_addstring('E', name);
+  const char *val = getenv(name);
+  if (val) {
+    ident_addstring('v', val);
+  } else {
+    ident_add_key_byte(0);
+  }
+}
+
+bool stabs_same_inode(struct stat *a, struct stat *b) {
+  return (a->st_dev == b->st_dev &&
+         a->st_ino == b->st_ino);
+}
+
+bool find_run_base_var_run(void) {
+  struct stat stab;
+  char *try;
+  int r;
+
+  try = m_asprintf("%s/%lu", "/var/run/user", us);
+  r = lstat(try, &stab);
+  if (r<0) {
+    if (errno == ENOENT ||
+       errno == ENOTDIR ||
+       errno == EACCES ||
+       errno == EPERM)
+      return 0; /* oh well */
+    diee("stat /var/run/user/UID");
+  }
+  if (!S_ISDIR(stab.st_mode)) {
+    warning("%s not a directory, falling back to ~\n", try);
+    return 0;
+  }
+  if (stab.st_uid != us) {
+    warning("%s not owned by uid %lu, falling back to ~\n", try,
+           (unsigned long)us);
+    return 0;
+  }
+  if (stab.st_mode & 0077) {
+    warning("%s writeable by group or other, falling back to ~\n", try);
+    return 0;
+  }
+  run_base = m_asprintf("%s/%s", try, our_name);
+  return 1;
+}
+
+static bool find_run_base_home(void) {
+  struct passwd *pw;
+  struct utsname ut;
+  char *dot, *try;
+  int r;
+
+  pw = getpwuid(us);  if (!pw) diee("getpwent(uid)");
+
+  r = uname(&ut);   if (r) diee("uname(2)");
+  dot = strchr(ut.nodename, '.');
+  if (dot) *dot = 0;
+  if (sizeof(ut.nodename) > 32)
+    ut.nodename[32] = 0;
+
+  run_base_mkdir_p = m_asprintf("%s/.%s", pw->pw_dir, our_name);
+  try = m_asprintf("%s/%s", run_base_mkdir_p, ut.nodename);
+  run_base = try;
+  return 1;
+}
+
+void find_socket_path(void) {
+  struct sockaddr_un sun;
+  int r;
+
+  us = getuid();  if (us==(uid_t)-1) diee("getuid");
+
+  find_run_base_var_run() ||
+    find_run_base_home() ||
+    (abort(),0);
+
+  int maxidentlen = sizeof(sun.sun_path) - strlen(run_base) - 10 - 2;
+
+  if (!ident) {
+    if (maxidentlen < MINHEXHASH)
+      die("base directory `%s'"
+         " leaves only %d characters for id hash"
+         " which is too little (<%d)",
+         run_base, maxidentlen, MINHEXHASH);
+
+    int identlen = maxidentlen > 64 ? 64 : maxidentlen;
+    char *hexident = xmalloc(identlen + 2);
+    unsigned char bbuf[32];
+    int i;
+
+    ident_addstring('i', interp);
+    if (script)
+      ident_addstring('s', script);
+    sha256_digest(&identsc,sizeof(bbuf),bbuf);
+
+    for (i=0; i<identlen; i += 2)
+      sprintf(hexident+i, "%02x", bbuf[i/2]);
+
+    hexident[identlen] = 0;
+    ident = hexident;
+  }
+
+  if (strlen(ident) > maxidentlen)
+    die("base directory `%s' plus ident `%s' too long"
+       " (with spare) for socket (max ident %d)\n",
+       run_base, ident, maxidentlen);
+
+  r = mkdir(run_base, 0700);
+  if (r && errno==ENOENT && run_base_mkdir_p) {
+    r = mkdir(run_base_mkdir_p, 0700);
+    if (r) diee("mkdir %s (since %s was ENOENT)",run_base_mkdir_p,run_base);
+    r = mkdir(run_base, 0700);
+  }
+  if (r) {
+    if (!(errno == EEXIST))
+      diee("mkdir %s",run_base);
+  }
+
+  socket_path = m_asprintf("%s/s%s",run_base,ident);
+}  
+
+// Returns fd
+int flock_file(const char *lock_path) {
+  int r;
+  int lockfd = -1;
+  struct stat stab_fd;
+  struct stat stab_path;
+
+  for (;;) {
+    if (lockfd >= 0) { close(lockfd); lockfd = -1; }
+
+    lockfd = open(lock_path, O_CREAT|O_RDWR, 0600);
+    if (lockfd<0) diee("create lock (%s)", lock_path);
+
+    r = flock(lockfd, LOCK_EX);
+    if (r && errno == EINTR) continue;
+    if (r) diee("lock lock (%s)", lock_path);
+
+    r = fstat(lockfd, &stab_fd);
+    if (r) diee("fstat locked lock");
+
+    r = stat(lock_path, &stab_path);
+    if (!r) {
+      if (stabs_same_inode(&stab_path, &stab_fd)) break;
+    } else {
+      if (!(errno == ENOENT)) diee("re-stat locked lock (%s)", lock_path);
+    }
+  }
+
+  return lockfd;
+}
+
+// Returns fd
+int acquire_lock(void) {
+  lock_path = m_asprintf("%s/l%s",run_base,ident);
+  return flock_file(lock_path);
+}
+
+static void shbang_opts(const char *const **argv_io,
+                       const struct cmdinfo *cmdinfos) {
+  myopt(argv_io, cmdinfos);
+
+  interp = *(*argv_io)++;
+  if (!interp) badusage("need interpreter argument");
+}
+
+void process_opts(const char *const **argv_io) {
+  const char *smashedopt;
+
+  sha256_init(&identsc);
+  ident_addinit();
+
+  if ((*argv_io)[0] &&
+      (smashedopt = (*argv_io)[1]) &&
+      smashedopt[0]=='-' &&
+      (strchr(smashedopt,' ') || strchr(smashedopt,','))) {
+    /* single argument containg all the options and <interp> */
+    *argv_io += 2; /* eat argv[0] and smashedopt */
+    const char *split_args[MAX_OPTS+1];
+    int split_argc = 0;
+    split_args[split_argc++] = (*argv_io)[0];
+    for (;;) {
+      if (split_argc >= MAX_OPTS) die("too many options in combined arg");
+      split_args[split_argc++] = smashedopt;
+      if (smashedopt[0] != '-') /* never true on first iteration */
+       break;
+      char *delim = strchr(smashedopt,' ');
+      if (!delim) delim = strchr(smashedopt,',');
+      if (!delim) badusage("combined arg lacks <interpreter>");
+      *delim = 0;
+      smashedopt = delim+1;
+    }
+    assert(split_argc <= MAX_OPTS);
+    split_args[split_argc++] = 0;
+
+    const char *const *split_argv = split_args;
+
+    shbang_opts(&split_argv, cmdinfos);
+    /* sets interp */
+
+    if (!**argv_io)
+      badusage("no script argument (expected after combined #! options)");
+  } else {
+    shbang_opts(argv_io, cmdinfos);
+  }
+
+  if (**argv_io)
+    script = *(*argv_io)++;
+}
diff --git a/cprogs/prefork.h b/cprogs/prefork.h
new file mode 100644 (file)
index 0000000..49b4d90
--- /dev/null
@@ -0,0 +1,104 @@
+/* common stuff for cgi-fcgi-interp and prefork-interp */
+/*
+ * Copyright 2016-2022 Ian Jackson and contributors to chiark-utils
+ * SPDX-License-Identifier: GPL-3.0-or-later
+ * There is NO WARRANTY.
+ */
+
+#ifndef PREFORK_H
+#define PREFORK_H
+
+#include "common.h"
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <errno.h>
+#include <stdbool.h>
+#include <assert.h>
+#include <limits.h>
+
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <sys/utsname.h>
+#include <sys/socket.h>
+#include <sys/un.h>
+#include <sys/file.h>
+#include <unistd.h>
+#include <fcntl.h>
+#include <pwd.h>
+#include <time.h>
+#include <signal.h>
+#include <sys/wait.h>
+#include <syslog.h>
+       
+#include <nettle/sha.h>
+
+#include "myopt.h"
+
+#define MINHEXHASH 33
+
+extern const char *interp, *ident, *script, *socket_path, *lock_path;
+extern bool logging;
+extern struct sha256_ctx identsc;
+extern const char *run_base;
+
+extern const char our_name[];
+
+bool find_run_base_var_run(void);
+void find_socket_path(void);
+
+int acquire_lock(void);
+int flock_file(const char *lock_path);
+
+extern const struct cmdinfo cmdinfos[];
+#define PREFORK_CMDINFOS \
+  { "help",   0, .call=of_help                                         }, \
+  { 0, 'g',   1,                    .sassignto= &ident                 }, \
+  { 0, 'G',   1, .call= off_ident_addstring                            }, \
+  { 0, 'E',   1, .call= off_ident_addenv                               },
+
+void process_opts(const char *const **argv_io);
+
+void vmsgcore(int estatus, int errnoval, const char *fmt, va_list al);
+
+#define DEF_MSG(func, attrs, estatus, errnoval, after) \
+  static void func(const char *fmt, ...)               \
+    __attribute__((unused, format(printf,1,2))) attrs; \
+  static void func(const char *fmt, ...) {             \
+    va_list al;                                                \
+    va_start(al,fmt);                                  \
+    vmsgcore(estatus,errnoval,fmt,al);                 \
+    after                                              \
+  }
+
+DEF_MSG(warninge, /*empty*/, 0, errno, { });
+DEF_MSG(warning , /*empty*/, 0, -1,    { });
+
+#define DEF_DIE(func, errnoval) \
+  DEF_MSG(func, __attribute__((noreturn)), 127, errnoval, { abort(); })
+
+DEF_DIE(diee, errno)
+DEF_DIE(die,  -1)
+
+#define MAX_OPTS 5
+
+void fusagemessage(FILE *f);
+void usagemessage(void);
+void of_help(const struct cmdinfo *ci, const char *val);
+void of_iassign(const struct cmdinfo *ci, const char *val);
+void ident_addinit(void);
+bool stabs_same_inode(struct stat *a, struct stat *b);
+void ident_addstring(char key, const char *string);
+
+void off_ident_addstring(const struct cmdinfo *ci, const char *name);
+void off_ident_addenv(const struct cmdinfo *ci, const char *name);
+
+void ident_add_key_byte(char key);
+
+#define IDENT_ADD_OBJ(key, obj) do{                            \
+    ident_add_key_byte(key);                                   \
+    sha256_update(&identsc, sizeof((obj)), (void*)&obj);       \
+  }while(0)
+
+#endif /*PREFORK_H*/
index ef2fb64dcb94f23b3801b297f8d7b1b7666fd681..bd51acbf9a545d7a93ec4e5a6f8a8f5fd6d7ed23 100644 (file)
@@ -101,9 +101,14 @@ static const struct cmdinfo cmdinfos[]= {
 #ifdef REALLY_CHECK_FILE
 static int checkroot(void) {
   int r;
-  r= access(REALLY_CHECK_FILE,W_OK);
-  if (r) return -1;
-  return 0;
+  r= access(REALLY_CHECK_FILE,   W_OK);
+  if (!r) return 0;
+#ifdef REALLY_CHECK_FILE_2
+  r= access(REALLY_CHECK_FILE_2, W_OK);
+  if (!r) return 0;
+  /* If all fails we return the errno from file _2 */
+#endif /*REALLY_CHECK_FILE_2*/
+  return -1;
 }
 #endif
 #ifdef REALLY_CHECK_GID
diff --git a/cprogs/timespeccmp.h b/cprogs/timespeccmp.h
new file mode 100644 (file)
index 0000000..e0a4f07
--- /dev/null
@@ -0,0 +1,39 @@
+/*
+ * Regarding the macro timespeccmp:
+ *
+ * Copyright (c) 1982, 1986, 1993
+ *      The Regents of the University of California.  All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in the
+ *    documentation and/or other materials provided with the distribution.
+ * 4. Neither the name of the University nor the names of its contributors
+ *    may be used to endorse or promote products derived from this software
+ *    without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ *
+ *      @(#)time.h      8.5 (Berkeley) 5/4/95
+ * $FreeBSD: head/sys/sys/time.h 275985 2014-12-21 05:07:11Z imp $
+ */
+#ifndef timespeccmp
+#define timespeccmp(tvp, uvp, cmp)                                      \
+        (((tvp)->tv_sec == (uvp)->tv_sec) ?                             \
+            ((tvp)->tv_nsec cmp (uvp)->tv_nsec) :                       \
+            ((tvp)->tv_sec cmp (uvp)->tv_sec))
+#endif /*timespeccmp*/
index 2dbb90487bc8feff7034fc023a6abd67225339b4..5213fa9c52331b3c269ee0a341c9d67962d47c62 100644 (file)
@@ -1,3 +1,127 @@
+chiark-utils (7.0.1~iwj0) unstable; urgency=medium
+
+  * 
+
+ --
+
+chiark-utils (7.0.0) unstable; urgency=medium
+
+  New facility:
+  * prefork-interp, Proc::Prefork::Interp: new facility
+
+  Improvements:
+  * expire-iso8601: Replace with new implementation.  Closes:#862897.
+
+  Bugfixes:
+  * acctdump: Fix manual page section.
+  * git-cache-proxy: fix for new git.  Closes: #1006695.  [Anthony Perard]
+  * git-branchmove: install manpage..  Closes: #946364.  [Sean Whitton]
+  * hexterm: Update #! and Suggest tcl8.6.  Closes: #905474.
+
+  Build and packaging improvements:
+  * Fix cross build.  Closes: #951242.  [Helmut Grohne]
+  * copyright: Be clear that SPDX indications are licence grants
+  * Add lintian override for python dependency
+  * Add lintian override for chiark-really
+  * fix priority "extra" to "optional"
+  * Fix build-dependency on debhelper.
+  * Set source format to 3.0 (native)
+  * Add Vcs-* fields.
+  * Update Standards-Version
+  * timespeccmp.h: Move use to just cgi-fcgi-interp
+
+ -- Ian Jackson <ijackson@chiark.greenend.org.uk>  Mon, 22 Aug 2022 00:06:57 +0100
+
+chiark-utils (6.1.2+nmu1) unstable; urgency=medium
+
+  * Non-maintainer upload.
+    - Maintainer has approved this via personal communication.
+  * Bump debhelper compat to 13 (Closes: #965453).
+
+ -- Sean Whitton <spwhitton@spwhitton.name>  Tue, 21 Jul 2020 08:17:49 -0700
+
+chiark-utils (6.1.2) unstable; urgency=medium
+
+  * git-cache-proxy: Recheck gc timestamp after taking lock
+  * git-cache-proxy: Tolerate failure to write gc stamp
+  * git-cache-proxy: Do not update timestamp due to housekeeping gc
+
+ -- Ian Jackson <ijackson@chiark.greenend.org.uk>  Wed, 12 Feb 2020 16:10:02 +0000
+
+chiark-utils (6.1.2~citrix2~) unstable; urgency=medium
+
+  * git-cache-proxy: Move $SIG{ALRM} setting to global
+  * git-cache-proxy: Abandon fetch attempt if client disconnects
+  * git-cache-proxy: Use open-coded fork/exec for git gc
+
+ -- Ian Jackson <ian.jackson@citrix.com>  Tue, 11 Feb 2020 18:34:58 +0000
+
+chiark-utils (6.1.1) unstable; urgency=medium
+
+  * fishdescriptor: Use Python "errno" module
+  * git-cache-proxy: Periodically run `git gc --quiet'
+  * git-cache-proxy: Document some options in the head comment
+
+ -- Ian Jackson <ijackson@chiark.greenend.org.uk>  Tue, 11 Feb 2020 16:37:31 +0000
+
+chiark-utils (6.0.5~citrix1) unstable; urgency=medium
+
+  * fishdescriptor: Use Python "errno" module, not "os.errno"
+    (which is not in modern python3 apparently).
+
+ -- Ian Jackson <ian.jackson@citrix.com>  Fri, 20 Dec 2019 17:50:02 +0000
+
+chiark-utils (6.1.0~iwj1) unstable; urgency=medium
+
+  * really: Writeability of rc.local suffices, too.
+    (Non-sysvinit compatibility.)
+
+ -- Ian Jackson <ijackson@chiark.greenend.org.uk>  Mon, 12 Aug 2019 10:59:02 +0100
+
+chiark-utils (6.1.0) unstable; urgency=medium
+
+  * Non-maintainer upload.
+    - Maintainer has approved this via personal communication.
+  * git-branchmove: rewrite in perl (Closes: #914398, #914399)
+    - Add dependencies on libgit-wrapper-perl, libtry-tiny-perl to
+      bin:chiark-scripts.
+  * git-branchmove: new --detach feature.
+
+ -- Sean Whitton <spwhitton@spwhitton.name>  Sat, 07 Dec 2019 14:10:26 -0700
+
+chiark-utils (6.0.4) unstable; urgency=medium
+
+  * sync-accounts: Fix perl syntax error.  Closes:#865985.
+  * changelog: Document bug number for bugfix in 6.0.4~citrix1.
+
+ -- Ian Jackson <ijackson@chiark.greenend.org.uk>  Fri, 12 Apr 2019 11:48:00 +0100
+
+chiark-utils (6.0.4~citrix1) unstable; urgency=medium
+
+  * fishdescriptor: cast __errno_location correctly.  Closes:#926858.
+
+ -- Ian Jackson <ian.jackson@citrix.com>  Mon, 08 Apr 2019 17:03:47 +0100
+
+chiark-utils (6.0.3) unstable; urgency=medium
+
+  * Upload to Debian unstable.
+
+ -- Ian Jackson <ijackson@chiark.greenend.org.uk>  Tue, 20 Nov 2018 18:25:53 +0000
+
+chiark-utils (6.0.3~citrix1) unstable; urgency=medium
+
+  * git-branchmove: Avoid transporting tags about
+  * fishdescriptor: Cope if donor is in a chroot without /proc
+  * fishdescriptor: Cope if only donor has /run/user/UID
+
+ -- Ian Jackson <ian.jackson@citrix.com>  Mon, 19 Nov 2018 16:11:55 +0000
+
+chiark-utils (6.0.2) unstable; urgency=medium
+
+  * Rebuild with arch:all packages included in the upload.
+
+ -- Ian Jackson <ijackson@chiark.greenend.org.uk>  Mon, 11 Jun 2018 14:35:08 +0100
+
 chiark-utils (6.0.1) unstable; urgency=low
 
   fishdescriptor:
diff --git a/debian/chiark-really.lintian-overrides b/debian/chiark-really.lintian-overrides
new file mode 100644 (file)
index 0000000..bce6ebb
--- /dev/null
@@ -0,0 +1,2 @@
+# This is the point of this binary package.
+setuid-binary usr/sbin/really 4754 root/root
diff --git a/debian/chiark-scripts.lintian-overrides b/debian/chiark-scripts.lintian-overrides
new file mode 100644 (file)
index 0000000..766c2d0
--- /dev/null
@@ -0,0 +1,3 @@
+# Python 3 is needed for fishdescriptor; this is documented in
+# the Description and in the Suggests.
+python-package-missing-depends-on-python
index 7ed6ff82de6bcc2a78243fc9c54d3ef5ac14da69..b1bd38b62a0800a4f6a80c34e21c5acffae52c7e 100644 (file)
@@ -1 +1 @@
-5
+13
index 11e15594c29e4ad7b024df921291cb1c81aaba66..38c178f47438441cb218e870a465fb7391c14f30 100644 (file)
@@ -1,14 +1,16 @@
 Source: chiark-utils
 Section: admin
-Priority: extra
+Priority: optional
 Maintainer: Ian Jackson <ijackson@chiark.greenend.org.uk>
-Build-Depends: libx11-dev, libxmu-dev, nettle-dev, debhelper (>= 5),
-               libxdmcp-dev, libxau-dev, libice-dev, libsm-dev
-Standards-Version: 3.9.1
+Build-Depends: libx11-dev, libxmu-dev, nettle-dev, debhelper (>= 13),
+               libxdmcp-dev, libxau-dev, libice-dev, libsm-dev, libuv1-dev
+Standards-Version: 4.6.1.1
+Vcs-Browser: https://www.chiark.greenend.org.uk/ucgi/~ian/git/chiark-utils.git/
+Vcs-Git: https://www.chiark.greenend.org.uk/ucgi/~ian/githttp/chiark-utils.git
 
 Package: chiark-backup
 Section: utils
-Priority: extra
+Priority: optional
 Architecture: all
 Depends: chiark-rwbuffer, chiark-utils-bin, ${misc:Depends}
 Suggests: chiark-utils-bin (>= 4.1.14)
@@ -22,11 +24,12 @@ Description: backup system for small systems and networks
 
 Package: chiark-scripts
 Section: admin
-Priority: extra
+Priority: optional
 Conflicts: chiark-named-conf, sync-accounts
 Replaces: chiark-named-conf, sync-accounts
-Depends: ${misc:Depends}
-Suggests: tcl8.4, python3, gdb
+Depends: ${misc:Depends}, libgit-wrapper-perl, libtry-tiny-perl
+Recommends: libdatetime-format-strptime-perl, libio-fdpass-perl
+Suggests: tcl8.6, python3, gdb
 Architecture: all
 Description: chiark system administration scripts
  This package contains a number of small administration scripts used
@@ -43,6 +46,8 @@ Description: chiark system administration scripts
  zones are slaved from the right places, and to generate a
  configuration for BIND, from its own input file.
  .
+ prefork-interp Perl support (Proc::Prefork::Interp).
+ .
  sync-accounts: a simple but flexible account info synchroniser.
  sync-accounts is a tool for copying un*x account data from remote
  systems and installing it locally.  It is flexible and reasonably
@@ -65,14 +70,14 @@ Description: chiark system administration scripts
  .
  hexterm: connects to serial port and allows the user interact in
  ASCII and hex.  Ie, a hex "terminal" program which lets you speak a
- serial port protocol directly.  (Needs tcl8.4 to be installed.)
+ serial port protocol directly.  (Needs tcl8.6 to be installed.)
  .
  git-branchmove, random-word, remountresizereiserfs,
  summarise-mailbox-preserving-privacy
 
 Package: chiark-rwbuffer
 Section: utils
-Priority: extra
+Priority: optional
 Architecture: any
 Depends: ${shlibs:Depends}, ${misc:Depends}
 Description: readbuffer/writebuffer: prevents tape drive seesawing, etc.
@@ -86,7 +91,7 @@ Depends: ${shlibs:Depends}, ${misc:Depends}
 Recommends: ${shlibs:Recommends}
 Suggests: ${shlibs:Suggests}
 Section: utils
-Priority: extra
+Priority: optional
 Description: chiark system administration utilities
  This package contains a number of small administration scripts used
  by chiark.greenend.org.uk and other systems belonging to the Sinister
@@ -95,6 +100,9 @@ Description: chiark system administration utilities
  with-lock-ex: a simple tool for acquiring a lockfile before running
  another program or script.
  .
+ prefork-interp: Wrapper to speed up script startup;
+ requires scripting langauge module from chiark-scripts.
+ .
  summer: a tool for reporting complete details about a filesystem tree
  in a parseable format, including checksums.
  .
@@ -121,7 +129,7 @@ Description: chiark system administration utilities
 
 Package: chiark-really
 Section: admin
-Priority: extra
+Priority: optional
 Architecture: any
 Depends: ${shlibs:Depends}, ${misc:Depends}
 Description: really - a tool for gaining privilege (simple, realistic sudo)
index 5f44a809562a6aed13f2af9e5d375f5f8b963f87..bb2b76242c7795a9540b1701b462a63ce3b9dc7d 100644 (file)
@@ -67,10 +67,16 @@ palm-datebook-reminders: for mailing reminders about Palm PDA appointments
 acctdump: for reading process acounting files
  Copyright 1998,2001,2006 Ian Jackson <ian@chiark.greenend.org.uk>
 
+prefork-interp (and supporting Perl module), for amortising script startup
+ Copyright 2016-2022 Ian Jackson <ian@chiark.greenend.org.uk>
+
 random-word, remountresizereiserfs, summarise-mailbox-preserving-privacy
  Miscellaneous utilities.
  Copyright 2004,2006 Ian Jackson <ian@chiark.greenend.org.uk>
 
+cgi-fcgi-interp, a piece of glue to make #! work with fcgi utils
+ Copyright 2016-2022 Ian Jackson <ian@chiark.greenend.org.uk>
+
 nntpid
  Utility for finding usenet articles by messageid from an NNTP server
  Copyright -2011 Simon Tatham
@@ -91,6 +97,9 @@ with-lock-ex
 fishdescriptor
  Copyright 2018 Citrix
 
+git-branchmove
+ Copyright 2019 Sean Whitton <spwhitton@spwhitton.name>
+
 The chiark utilities are all free software; you can redistribute them
 and/or modify them under the terms of the GNU General Public License
 as published by the Free Software Foundation; either version 3 of the
@@ -107,3 +116,9 @@ with the chiark-utils source package as the file COPYING; if not,
 email me at one of the addresses above or consult the Free Software
 Foundation's website at www.fsf.org, or the GNU Project website at
 www.gnu.org.
+
+
+Some of the source files use the SPDX licence indication convention.
+For example, you may see:
+  SPDX-License-Identifier: GPL-3.0-or-later
+This should be read as a licence grant, as is conventional.
index cc926b8e147e35939c3d63fd0ea32fb177448997..403c7285ddb84a93c5cdee77844b2f7ae8a3e2e9 100755 (executable)
@@ -21,7 +21,7 @@ makebuildargs := OPTIMISE= DEBUG= \
 build:
        $(checkdir)
        set -e; for s in $(subdirs_build_arch); do \
-               $(MAKE) -C $$s all $(makebuildargs); \
+               dh_auto_build --sourcedirectory=$$s -- all $(makebuildargs); \
        done
        touch build
 
@@ -109,6 +109,7 @@ binary-one:
                cp debian/$p/$$f $t/$p/DEBIAN/$$f; \
                chmod u=rwX,go=rX $t/$p/DEBIAN/$$f; \
        done
+       dh_lintian -p$p -Pdebian/tmp/$p
        dh_link -p$p -Pdebian/tmp/$p
        dpkg-gencontrol -p$p -P$t/$p -Tdebian/sv-$p
        chown -R root.root debian/tmp
@@ -132,7 +133,7 @@ binary-arch:        checkroot build binary-prep
                case "$$f" in \
                */xbatmon-simple|*/xduplic-copier) \
                                        d=Suggests      ;; \
-               */watershed|*/summer|*/cgi-fcgi-interp) \
+               */watershed|*/summer|*/cgi-fcgi-interp|*/prefork-interp) \
                                        d=Recommends    ;; \
                *)                      d=Depends       ;; \
                esac; \
diff --git a/debian/source/format b/debian/source/format
new file mode 100644 (file)
index 0000000..89ae9db
--- /dev/null
@@ -0,0 +1 @@
+3.0 (native)
index b47ac3dbb6aeb493b56f86a33aed9ff1cbf72669..7588010d6833b976e0f255a1f1aa3f14f25c9d53 100644 (file)
@@ -29,6 +29,7 @@ import struct
 import tempfile
 import shutil
 import sys
+import errno
 
 def _shuffle_fd3():
     os.dup2(1,3)
@@ -111,12 +112,12 @@ class Donor():
             os.stat(path)
             return True
         except OSError as oe:
-            if oe.errno != os.errno.ENOENT: raise oe
+            if oe.errno != errno.ENOENT: raise oe
             return False
 
-    def _sock_dir(d, target_euid):
+    def _sock_dir(d, target_euid, target_root):
         run_dir = '/run/user/%d' % target_euid
-        if d._exists(run_dir):
+        if d._exists(target_root + run_dir):
             return run_dir + '/fishdescriptor'
 
         try:
@@ -133,16 +134,16 @@ class Donor():
     def fish(d, fds):
         # -> list of fds in our process
 
+        target_root = '/proc/%d/root' % d.pid
+        if not d._exists(target_root):
+            target_root = ''
+
         euid = d._geteuid()
-        sockdir = d._sock_dir(euid)
+        sockdir = d._sock_dir(euid, target_root)
         d.mkdir(sockdir)
 
         sockname = '%s/%s,%d' % (sockdir, os.uname().nodename, d.pid)
 
-        target_root = '/proc/%d/root' % d.pid
-        if not d._exists(target_root):
-            target_root = ''
-
         our_sockname = target_root + sockname
 
         s = None
@@ -157,7 +158,7 @@ class Donor():
             os.chmod(our_sockname, 666)
             s.listen(1)
 
-            ancil_len = d.donate(our_sockname, fds)
+            ancil_len = d.donate(sockname, fds)
             (s2, dummy) = s.accept()
             (msg, ancil, flags, sender) = s2.recvmsg(1, ancil_len)
 
index 20bc8071b6d0f7eb9b1223c8269e90e0c0a05ebe..d911bf85c52d772a10bf7e3ad9f715eba670149f 100644 (file)
@@ -27,6 +27,7 @@ import copy
 import os
 import sys
 import socket
+import errno
 
 def _string_bytearray(s):
     # gets us bytes in py2 and py3
@@ -142,7 +143,7 @@ class DonorImplementation():
         # in my browser).  Also the error is very nonspecific :-/.
         # This seems to happen on jessie, and is fixed in stretch.
         # Anyway:
-        return parse_eval(expr_pat % '(*((int (*)(void))__errno_location)())')
+        return parse_eval(expr_pat % '(*((int*(*)(void))__errno_location)())')
 
     # calling functions (need to cast the function name to the right
     # type in case maybe gdb doesn't know the type)
@@ -212,7 +213,7 @@ class DonorImplementation():
         )
         if r < 0:
             errnoval = di._parse_eval_errno('%s')
-            if errnoval != os.errno.EEXIST:
+            if errnoval != errno.EEXIST:
                 raise RuntimeError("mkdir %s failed: `%s'" %
                                    (repr(path), os.strerror(errnoval)))
             return 0
index 3ab02e74c2ad8ecbcb30bfbf1f1279bd6490e421..68c89b479e6b7227c1e0494dff27d124f85dbb11 100644 (file)
@@ -26,12 +26,13 @@ SCRIPTS=    palm-datebook-reminders random-word expire-iso8601 \
                cvs-repomove cvs-adjustroot remountresizereiserfs \
                hexterm summarise-mailbox-preserving-privacy \
                git-cache-proxy git-branchmove nntpid
-MANPAGES1=     palm-datebook-reminders
+
+MANPAGES1=     palm-datebook-reminders git-branchmove
 
 CSCRIPTS=      named-conf
 CMANPAGES8=    named-conf
 
-PERLMODULES=   Chiark/NNTP
+PERLMODULES=   Chiark/NNTP Proc/Prefork/Interp
 
 all:
 
@@ -46,16 +47,20 @@ install:
                        $(INSTALL_SHARE) $$f.pm $(perl5dir)/$$f.pm; done
 
 
-install-docs:
+install-docs: $(addsuffix .1,$(MANPAGES1))
                $(INSTALL_DIRECTORY) $(man1dir) $(man8dir)
                set -e; for f in $(MANPAGES1); do \
                        $(INSTALL_SHARE) $$f.1 $(man1dir)/$$f.1; done
                set -e; for f in $(CMANPAGES8); do \
                        $(INSTALL_SHARE) $$f.8 $(man8dir)/chiark-$$f.8; done
 
+git-branchmove.1: git-branchmove
+       pod2man git-branchmove >git-branchmove.1
+
 install-examples:
 
 clean:
                rm -f *~ ./#*#
+               rm -f git-branchmove.1
 
 distclean realclean:   clean
diff --git a/scripts/Proc/Prefork/Interp.pm b/scripts/Proc/Prefork/Interp.pm
new file mode 100644 (file)
index 0000000..488c926
--- /dev/null
@@ -0,0 +1,608 @@
+# Copyright 2022 Ian Jackson and contributors to chiark-utils
+# SPDX-License-Identifier: GPL-3.0-or-later
+# There is NO WARRANTY.
+
+package Proc::Prefork::Interp;
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(
+                 prefork_initialisation_complete 
+                 prefork_autoreload_also_check
+              );
+
+use strict;
+
+use Carp;
+use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
+use IO::FDPass;
+use POSIX qw(_exit setsid :sys_wait_h :errno_h :signal_h);
+use Sys::Syslog qw(openlog syslog LOG_INFO LOG_ERR LOG_WARNING);
+use Time::HiRes qw();
+
+our $logger;
+
+our $env_name = 'PREFORK_INTERP';
+
+our @call_fds;
+our $socket_path;
+our $fail_log = 0;
+our $startup_mtime;
+
+our @autoreload_extra_files = ();
+
+sub prefork_autoreload_also_check {
+  push @autoreload_extra_files, @_;
+}
+
+sub fail_log ($) {
+  my ($m) = @_;
+  if ($fail_log) {
+    syslog(LOG_ERR, "$0: prefork: error: $m");
+  } else {
+    carp "$0: prefork: initialisation error: $m";
+  }
+  _exit 127;
+}
+
+sub server_quit ($) {
+  my ($m) = @_;
+  syslog(LOG_INFO, "$0 prefork: $m, quitting");
+  _exit(0);
+}
+
+# Returns in the executor process
+sub become_monitor () {
+  close LISTEN;
+  close WATCHI;
+  close WATCHE;
+
+  # Make a process group for this call
+  setpgrp or fail_log("setpgrp failed: $!");
+
+  eval { protocol_exchange(); 1; }
+    or fail_log("protocol exchange failed: $@");
+
+  pipe EXECTERM, EXECTERMW or fail_log("pipe: $!");
+
+  my $child = fork // fail_log("fork executor: $!");
+  if (!$child) {
+    #---- executor ----
+    open ::STDIN , "<& $call_fds[0]" or fail_log("dup for fd0");
+    open ::STDOUT, ">& $call_fds[1]" or fail_log("dup for fd1");
+    open ::STDERR, ">& $call_fds[2]" or fail_log("dup for fd2");
+    close EXECTERM;
+    close_call_fds();
+    $! = 0;
+    return;
+  }
+  close EXECTERMW;
+
+  #---- monitor [2] ----
+
+  for (;;) {
+    my $rbits = '';
+    vec($rbits, fileno(CALL), 1) = 1;
+    vec($rbits, fileno(EXECTERM), 1) = 1;
+    my $ebits = $rbits;
+    my $nfound = select($rbits, '', $ebits, undef);
+    last if $nfound > 0;
+    next if $! == EINTR;
+    fail_log("monitor select() failed: $!");
+  }
+
+  # Either the child has just died, or the caller has gone away
+
+  $SIG{INT} = 'IGN';
+  kill 'INT', 0 or fail_log("kill executor [$child]: $!");
+
+  my $got = waitpid $child, 0;
+  $got >= 0 // fail_log("wait for executor [$child] (2): $!");
+  $got == $child or fail_log("wait for esecutor [$child] gave [$got]");
+
+  protocol_write(pack "N", $?);
+  _exit(0);
+}
+
+sub close_call_fds () {
+  foreach (@call_fds) {
+    POSIX::close($_);
+  }
+  close CALL;
+}
+
+sub protocol_write ($) {
+  my ($d) = @_;
+  return if (print CALL $d and flush CALL);
+  _exit(0) if $!==EPIPE || $!==ECONNRESET;
+  fail_log("protocol write: $!");
+}
+
+sub eintr_retry ($) {
+  my ($f) = @_;
+  for (;;) {
+    my $r = $f->();
+    return $r if defined $r;
+    next if $!==EINTR;
+    return $r;
+  }
+}
+
+sub protocol_read_fail ($) {
+  my ($what) = @_;
+  _exit(0) if $!==ECONNRESET;
+  die("recv $what: $!");
+}
+
+sub protocol_exchange () {
+  my $greeting = "PFI\n\0\0\0\0";
+  protocol_write($greeting);
+
+  my $ibyte = 0;
+  my $r;
+  for (;;) {
+    $r = sysread CALL, $ibyte, 1;
+    last if $r > 0;
+    $!==EINTR or protocol_read_fail("signalling byte");
+  }
+  $r == 1 or _exit(0);
+  $ibyte = ord $ibyte;
+  $ibyte and die(sprintf "signalling byte is 0x%02x, not zero", $ibyte);
+
+  @call_fds = map {
+    my $r;
+    for (;;) {
+      $! = 0;
+      $r = IO::FDPass::recv(fileno(CALL));
+      last if $r >= 0;
+      _exit(0) if $!==0;
+      protocol_read_fail("fd $_");
+    }
+    $r;
+  } 0..2;
+
+  my $len;
+  $r = read(CALL, $len, 4) // protocol_read_fail("message length");
+  $r == 4 or _exit(0);
+
+  $len = unpack "N", $len;
+  my $data;
+  $r = read(CALL, $data, $len) // protocol_read_fail("message data ($len)");
+  $r == $len or _exit(0);
+
+  @ARGV = split /\0/, $data, -1;
+  @ARGV >= 2 or die("message data has too few strings (".(scalar @ARGV).")");
+  length(pop(@ARGV)) and die("message data missing trailing nul");
+  %ENV = ();
+  while (my $s = shift @ARGV) {
+    last if !length $s;
+    $s =~ m/=/ or die("message data env var missing equals");
+    $ENV{$`} = $';
+  }
+}
+
+sub autoreload_check ($) {
+  my ($f) = @_;
+  my @s = Time::HiRes::stat($f);
+  if (!@s) {
+    $!==ENOENT or fail_log("autoreload check: stat failed: $f: $!");
+    return;
+  }
+  if ($s[9] > $startup_mtime) {
+    syslog(LOG_INFO, "$0 prefork: reloading; due to $f");
+    _exit(0);
+  }
+}
+
+sub prefork_initialisation_complete {
+  my %opts = @_;
+
+  push @autoreload_extra_files, $0;
+
+  # if env var not set, we're not running under prefork-interp
+  my @env_data = split / /, ($ENV{$env_name} // return);
+  croak "$env_name has too few words" unless @env_data >= 2;
+  my (@vsns) = split /,/, $env_data[0];
+  croak "$env_name doesn't specify v1" unless @vsns >= 2 && $vsns[0] eq 'v1';
+  $startup_mtime = $vsns[1];
+  my @env_fds = split /,/, $env_data[1];
+  croak "$env_name has too few fds" unless @env_fds >= 4;;
+  $#env_fds = 3;
+
+  my $num_servers = $opts{max_servers} // 4;
+
+  #---- setup (pm) [1] ----
+
+  foreach (@env_fds) {
+    $_ eq ($_+0) or croak "$env_name contains $_, not a number";
+  }
+  open LISTEN, "+>&=$env_fds[0]" or croak "listen fd: $!";
+  open CALL,   "+>&=$env_fds[1]" or croak "call fd: $!";
+  open WATCHI, "+>&=$env_fds[2]" or croak "call fd: $!";
+  open WATCHE, "+>&=$env_fds[3]" or croak "watch stderr fd: $!";
+
+  my $log_facility = $opts{log_facility} // 'LOG_USER';
+  if (length $log_facility) {
+    openlog("prefork-interp $0", 'ndelay,nofatal,pid', $log_facility);
+  }
+
+  open NULL, "+>/dev/null" or croak "open /dev/null: $!";
+
+  #---- fork for server ----
+
+  my $child = fork // croak "first fork failed: $!";
+  if ($child) {
+    #---- setup (pm) [2], exits ----
+    _exit(0);
+  }
+  setsid() > 0 or fail_log("setsid: $!");
+  # The server will be a session leader, but it won't open ttys,
+  # so that is ok.
+
+  #---- server(pm) [1] ----
+
+  $child = fork // croak "second fork failed: $!";
+  if (!$child) {
+    # we are the child, i.e. the one fa-monitor
+    local $0 = "$0 [monitor(init)]";
+    return become_monitor();
+  }
+  close CALL;
+
+  our %children;
+  $children{$child} = 1;
+  
+  # --- server(pm) [2] ----
+
+  local $0 = "$0 [server]";
+
+  $fail_log = 1;
+  open STDIN, "<&NULL" or fail_log("dup null onto stdin: $!");
+  open STDOUT, ">&NULL" or fail_log("dup null onto stdout: $!");
+  open STDERR, ">&NULL" or fail_log("dup null onto stderr: $!");
+  close NULL;
+
+  my $errcount = 0;
+
+  for (;;) {
+    # reap children
+    if (%children) {
+      my $full = $num_servers >= 0 ? %children >= $num_servers : 0;
+      my $got = waitpid -1, ($full ? 0 : WNOHANG);
+      $got >= 0 or fail_log("failed to wait for monitor(s): $!");
+      if ($got) {
+       if ($? && $? != SIGPIPE) {
+         syslog(LOG_WARNING,
+ "$0 prefork: monitor process [$got] failed with wait status $?");
+       }
+       if (!exists $children{$got}) {
+         syslog(LOG_WARNING,
+ "$0 prefork: monitor process [$got] wasn't one of ours?!");
+       }
+       delete $children{$got};
+       next;
+      }
+    }
+
+    # select for accepting or housekeeping timeout
+    my $rbits = '';
+    vec($rbits, fileno(LISTEN), 1) = 1;
+    vec($rbits, fileno(WATCHE), 1) = 1;
+    my $ebits = $rbits;
+    my $idle_timeout = $opts{idle_timeout} // 1000000;
+    $idle_timeout = undef if $idle_timeout < 0;
+    my $nfound = select($rbits, '', $ebits, $idle_timeout);
+
+    # Idle timeout?
+    last if $nfound == 0;
+    if ($nfound < 0) {
+      next if $! == EINTR;
+      fail_log("select failed: $!");
+    }
+
+    # Has the watcher told us to shut down, or died with a message ?
+    my $msgbuf = '';
+    my $r = sysread WATCHE, $msgbuf, 2048;
+    if ($r > 0) {
+      chomp $msgbuf;
+      fail_log("watcher: $msgbuf");
+    } elsif (defined $r) {
+      syslog(LOG_INFO,
+ "$0 prefork: lost socket (fresh start or cleanup?), quitting");
+      last;
+    } elsif ($! == EINTR || $! == EAGAIN || $! == EWOULDBLOCK) {
+    } else {
+      fail_log("watcher stderr read: $!");
+    }
+
+    if (%opts{autoreload_inc} // 1) {
+      foreach my $f (values %INC) {
+       autoreload_check($f);
+      }
+    }
+    foreach my $f (@autoreload_extra_files) {
+      autoreload_check($f);
+    }
+    foreach my $f (@{ %opts{autoreload_extra} // [] }) {
+      autoreload_check($f);
+    }
+
+    # Anything to accept ?
+    if (accept(CALL, LISTEN)) {
+      $child = fork // fail_log("fork for accepted call failed: $!");
+      if (!$child) {
+       #---- monitor [1] ----
+       $0 =~ s{ \[server\]$}{ [monitor]};
+       return become_monitor();
+      }
+      close(CALL);
+      $errcount = 0;
+      $children{$child} = 1;
+    } elsif ($! == EINTR || $! == EAGAIN || $! == EWOULDBLOCK) {
+    } else {
+      syslog(LOG_WARNING, "$0 prefork: accept failed: $!");
+      if ($errcount > ($opts{max_errors} // 100)) {
+       fail_log("too many accept failures, quitting");
+      }
+    }
+  }
+  _exit(0);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Proc::Prefork::Interp - script-side handler for prefork-interp
+
+=head1 SYNOPSYS
+
+    #!/usr/bin/prefork-interp -U,perl,-w
+    # -*- perl -*-
+    use strict;
+    use Proc::Prefork::Interp;
+
+    ... generic initialisation code, use statements ...
+
+    prefork_initialisation_complete();
+
+    ... per-execution code ...
+
+=head1 DESCRIPTION
+
+Proc::Prefork::Interp implements the script-side protocol
+expected by the preform-interp C wrapper program.
+
+The combination arranges that the startup overhead of your script
+is paid once, and then the initialised script can service multiple
+requests, quickly and in parallel.
+
+C<prefork_initialisation_complete> actually daemonises the program,
+forking twice, and returning in the grandchild.
+
+It returns once for each associated invocation of C<prefork-interp>
+(ie, each invocation of the script which starts C<#!/usr/bin/prefork-interp>),
+each time in a separate process.
+
+=head1 PRE-INITIALISATION STATE, CONTEXT AND ACTIONS
+
+During initialisation, the program may load perl modules, and do
+other kinds of pre-computation and pre-loading.
+
+Where files are read during pre-loading, consider calling
+C<prefork_autoreload_also_check> to arrange that the script will
+automatically be restarted when the files change.
+See L</"AUTOMATIC RELOADING">.
+
+Before C<prefork_initialisation_complete>,
+the script will stdin connected to /dev/null,
+and stdout connected to its stderr.
+
+It should avoid accessing its command line arguments
+- or, at least, those which will vary from call to call.
+
+Likewise it should not pay attention to environment variables
+which are expected to change from one invocation to the next.
+For example, if the program is a CGI script, it ought not to
+read the CGI environment variables until after initialisation.
+
+It is I<NOT> safe to open a connection to a database,
+or other kind of server, before initialisation is complete.
+This is because the db connection would end up being shared
+by all of the individual executions.
+
+=head1 POST-INITIALISATION STATE, CONTEXT AND ACTIONS
+
+Each time C<prefork_initialisation_complete> returns,
+corresponds to one invocation of C<prefork-interp>.
+
+On return the script will have its stdin, stdout and stderr
+connected to those provided by C<prefork-interp>'s caller
+for this invocation.
+Likewise C<@ARGV> and C<%ENV> will have been adjusted to
+copy the arguments and environment of the particular call.
+
+By this time, the process has forked twice.
+Its parent is not the original caller,
+and it is in a session and a process group
+set up for this shared script and this particular invocation,
+respectively.
+
+Signals sent to the C<prefork-interp> will not be received
+by the script.
+if C<prefork-interp> is killed, the script will receive a C<SIGINT>;
+when that happens it ought to die promptly,
+without doing further IO on stdin/stdout/stderr.
+
+The exit status of the script will be reproduced
+as the exit status of C<prefork-interp>,
+so that the caller sees the right exit status.
+
+=head1 DESCRIPTORS AND OTHER INHERITED PROCESS PROPERTIES
+
+The per-invocation child inherits everything that is
+set up before C<prefork_initialisation_complete>.
+
+This includes ulimits, signal dispositions, uids and gids,
+and of course file descriptors (other than 0/1/2).
+
+The prefork-interp system
+uses C<SIGINT> to terminate services when needed
+and relies on C<SIGPIPE> to have a default disposition.
+Do not mess with these.
+
+It is not generally safe to open a connection to some kind of service
+during initialisation.
+Each invocation will share the socket,
+which can cause terrible confusion (even security holes).
+For example, do not open a database handle during initialisation.
+
+=head1 AUTOMATIC RELOADING
+
+The prefork-interp system supports automatic reloading/restarting,
+when a script, or files it loads, are modified.
+
+Files mentioned in C<$0> and C<%INC> will automatically be checked;
+if any are found to be newer than the original invocation,
+a fressh "server" will created -
+re-running the script again from the top, as for an initial call.
+
+The set of files checked in this way can be modified
+via initialisation-complete options,
+or by calling C<prefork_autoreload_also_check>.
+
+=head1 STANDALONE OPERATION
+
+A script which loads Proc::Prefork::Interp
+and calls C<prefork_initialisation_complete>
+can also be run standalone.
+This can be useful for testing.
+
+When not run under C<prefork-interp>, C<prefork_initialisation_complete>
+does nothing and returns in the same process.
+
+=head1 FUNCTIONS
+
+=over
+
+=item C<< prefork_initialisation_complete( I<%options> ) >>
+
+Turns this script into a server,
+which can be reused for subsequent invocations.
+Returns multiple times,
+each time in a different process,
+one per invocation.
+
+When not run under C<prefork-interp>, this is a no-op.
+
+C<%options> is an even-length list of options,
+in the format used for initalising a Perl hash:
+
+=over
+
+=item C<< max_servers => I<MAX> >>
+
+Allow I<MAX> (an integer) concurrent invocations at once.
+If too many invocations arrive at once,
+new ones won't be served until some of them complete.
+
+If I<MAX> is negative, there is no limit.
+The limit is only applied somewhat approximately.
+Default is 4.
+
+=item C<< idle_timeout => I<TIMEOUT> >>
+
+If no invocations occur for this length of time, we quit;
+future invocations would involve a restart.
+
+If I<TIMEOUT> is negative, we don't time out.
+
+=item C<< autoreload_inc => I<BOOL> >>
+
+If set falseish,
+we don't automatically check files in C<%INC> for reloads.
+See L</"AUTOMATIC RELOADING">.
+
+=item C<< autoreload_extra => [ I<PATHS> ] >>
+
+Additional paths to check for reloads
+(as an arrayref of strings).
+(This is in addition to paths passed to C<prefork_autoreload_also_check>.)
+See L</"AUTOMATIC RELOADING">.
+Default is 1 megasecond.
+
+=item C<< max_errors => I<NUMBER> >>
+
+If our server loop experiences more errors than this, we quit.
+(If this happens,
+a future invocation would restart the script from the top.)
+Default is 100.
+
+=item C<< log_facility => I<BOOL> >>
+
+The syslog facility to use,
+for messages from the persistent server.
+
+The value is in the format expected by C<Sys::Syslog::openlog>;
+the empty string means not to use syslog at all,
+in which case errors experienced by the psersistent server
+will not be reported anywhere, impeding debugging.
+
+Default is C<LOG_USER>.
+
+=back
+
+=item C<< prefork_autoreload_also_check I<PATHS> >>
+
+Also check each path in I<PATHS> for being out of date;
+if any exists and has an mtime after our setup,
+we consider ourselves out of date and arrange for a reload.
+
+It is not an error for a I<PATH> to not exist,
+but it is an error if it can't be checked.
+
+=back
+
+=head1 AUTHORS AND COPYRIGHT
+
+The prefork-interp system was designed and implemented by Ian Jackson
+and is distributed as part of chiark-utils.
+
+prefork-interp and Proc::Prefork::Interp are
+Copyright 2022 Ian Jackson and contributors to chiark-utils.
+
+=head1 LIMITATIONS
+
+A function which works and returns in the grant parent,
+having readjusted many important process properties,
+is inherently rather weird.
+Scripts using this facility must take some care.
+
+Signal propagation, from caller to actual service, is lacking.
+
+If the service continues to access its descriptors after receiving SIGINT,
+the ultimate callers can experience maulfunctions
+(eg, stolen terminal keystrokes!)
+
+=head1 FUTURE POSSIBILITIES
+
+This system should work for Python too.
+I would welcome contribution of the approriate Python code.
+Please get in touch so I can help you.
+
+=head1 SEE ALSO
+
+=over
+
+=item C<prefork-interp.txt>
+
+Usage and options for the C<prefork-interp>
+invocation wrapper program.
+
+=item C<prefork-interp.c>
+
+Design and protocol information is in the comments
+at the top of the source file.
+
+=back
index 76006783bbfe17f818e810cfdc9bc8a553a32c70..62ba62d9cda969b3d45cefb0b2a3810192860d37 100755 (executable)
@@ -1,16 +1,35 @@
-#!/bin/bash
-set -e
-                       usage () {
-                       cat <<END
+#!/usr/bin/perl -w
+#
+# Copyright 2006 Ian Jackson <ijackson@chiark.greenend.org.uk>
+#
+# This script and its documentation (if any) are free software; you
+# can redistribute it and/or modify them under the terms of the GNU
+# General Public License as published by the Free Software Foundation;
+# either version 3, or (at your option) any later version.
+# 
+# chiark-named-conf and its manpage are distributed in the hope that
+# it will be useful, but WITHOUT ANY WARRANTY; without even the
+# implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
+# PURPOSE.  See the GNU General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, consult the Free Software Foundation's
+# website at www.fsf.org, or the GNU Project website at www.gnu.org.
+
+use strict;
+
+our $usage = <<'END';
 usage:
   expire-iso8601 [<options>] <number>x<interval> [<number>x<interval> ...]
 options:
    -u<unitlen>  <interval> is measured in units of <unitlen> seconds
                    (default is 86400, so <interval> is in days)
-   -s<slop>     allow kept items to be <slop> seconds shorter apart than
-                   specified; default is 10% of <unitlen>
-   -n           do not really delete
-   -r           recursive removal (rm -r)
+   -s<slop>       allow kept items to be <slop> seconds shorter or
+                   longer apart than specified; default is 0.1 unit
+   -n             do not really delete
+   -r             recursive removal (rm -r)
+   --rename-only  rename to *.rm, but do not delete
+   --help
 example:
    /home/ian/junk/expire-iso8601 14x1 4x7
       uses units of 86400s (1 day) with a slop of 8640
@@ -24,204 +43,226 @@ exit status:
    0                   ok
    4                   rm failed
    8                   bad usage
-   16                  catastrophic failure
+  -1                   catastrophic failure
 END
-                       }
 
-# Copyright 2006 Ian Jackson <ian@chiark.greenend.org.uk>
-#
-# This script and its documentation (if any) are free software; you
-# can redistribute it and/or modify them under the terms of the GNU
-# General Public License as published by the Free Software Foundation;
-# either version 3, or (at your option) any later version.
-# 
-# chiark-named-conf and its manpage are distributed in the hope that
-# it will be useful, but WITHOUT ANY WARRANTY; without even the
-# implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
-# PURPOSE.  See the GNU General Public License for more details.
-# 
-# You should have received a copy of the GNU General Public License along
-# with this program; if not, consult the Free Software Foundation's
-# website at www.fsf.org, or the GNU Project website at www.gnu.org.
+use POSIX;
+use Carp;
+use Data::Dumper;
+use Date::Parse;
+use DateTime::Format::Strptime;
+
+$|=1;
 
+our @oldfiles;
+our @files;
+our $enable = 2;
+our $recurse = 1;
+our $unit = 86400;
+our $slop;
+our $debug = 0;
+our @intervals;
 
-trap 'exit 16' 0
-badusage () { echo >&2 "bad usage: $*"; usage >&2; trap '' 0; exit 8; }
+sub badusage ($) {
+  print STDERR "bad usage: $_[0]\n$usage" or die $!;
+  exit 8;
+}
+
+sub scan () {
+#  my $strp = DateTime::Format::Strptime->new();
+  foreach my $f (<[0-9]*>) {
+    if ($f  !~ m/^ \d\d\d\d - \d\d - \d\d 
+                (?: T \d\d \: \d\d (?: \: \d\d )?
+                  (?: [-+] \d{1,2} \:? \d\d )? )? 
+                ( \.rm )? $/x) {
+      print STDERR "ignoring $f\n";
+    }
 
-#-------------------- argument parsing --------------------
+    if ($1) {
+      push @oldfiles, $f;
+      next;
+    }
 
-alldigits () {
-       [ "x${2##*[^0-9]}" = "x$2" ] || \
-               badusage "bad $1 \`$2'; must be all digits"
-       [ "$2" ] || badusage "bad $2; must be nonempty"
-       eval $1='$2'
+    my @t = Date::Parse::strptime($f);
+    @t = map { $_ // 0 } @t;
+    my $t = mktime @t;
+#    m
+#    my $t = $strp->parse_datetime($f);
+#    $t = $t->epoch();
+#    my @t = Date::Parse::strptime($f);
+#print STDERR Dumper(\@t);
+#    my $t = mktime(@t);
+#    $!=0; $?=0; my $t = `date -d '$&' +%s`;
+#    die "date(!) failed on $&: $? $!" if $! || $?;
+#    chomp $t or confess;
+    push @files, { F => $f, T => $t, U => [] };
+  }
 }
 
-rm=rm
-recurse=''
-unit=86400
-slop=''
-
-while [ $# -ge 1 ]; do
-       arg=$1; shift
-       case "$arg" in
-       --|-)   break ;;
-       --help) usage; exit 0 ;;
-       --*)    badusage "unknown option $arg" ;;
-       -*)
-               val=${arg#-?}
-               case "$arg" in
-               -n*)    rm=: ;;
-               -r*)    recurse=-r ;;
-               -u*)    alldigits unit "$val"; arg='' ;;
-               -s*)    alldigits slop "$val"; arg='' ;;
-               *)      badusage "unknown option ${1:0:2}" ;;
-               esac
-               arg=-${arg#-?}
-               if test "x$arg" != x-; then set -- "$arg" "$@"; fi
-               ;;
-       *)      set "$arg" "$@"; break ;;
-       esac
-done
-
-[ $# -ge 1 ] || badusage 'too few arguments'
-[ "$slop" ] || slop=$(( $unit / 10 ))
-
-for ni in "$@"; do
-       case "$ni" in *x*);; *) badusage "bad <number>x<interval> $ni";; esac
-       alldigits number "${ni%%x*}"
-       alldigits interval "${ni#*x}"
-done
-
-#-------------------- scanning the directory ----------
-
-# We build in $l a list of the relevant filenames and the time_t's
-# they represent.
-#
-# Each entry in $l is $time_t/$filename, and the list is
-# newline-separated for the benefit of sort(1).
-
-ls=0
-for cn in [0-9]*; do
-       case "$cn" in
-       ????-??-??)
-               conv="$cn";;
-       ????-??-??T[0-2][0-9]+[0-9][0-9][0-9][0-9]|\
-       ????-??-??T[0-2][0-9]:[0-6][0-9]+[0-9][0-9][0-9][0-9]|\
-       ????-??-??T[0-2][0-9]:[0-6][0-9]:[0-6][0-9]+[0-9][0-9][0-9][0-9])
-               conv="${cn%T*} ${cn#*T}";;
-       *)
-               echo >&2 "ignoring $cn"
-               continue;;
-       esac
-       cs=$(date -d "$conv" +%s)
-       l="$cs/$cn
-$l"
-done
-
-#-------------------- main computation --------------------
-
-# We process each minimum/extent pair, to have it select a bunch of
-# versions to keep.  We annotate entries in $l: if we are keeping
-# an entry we prepend a colon; temporarily, if we are keeping an entry
-# because of this particular minimum/extent, we prepend a comma.
-
-# For each minimum/extent pair we look at the list from most recent
-# to least recent,
-#   ie in order of increasing age
-#   ie in order of decreasing time_t
-# and each time we're more than min older than the last item we kept,
-# we mark the item to keep, until we have as many as we want.
-#
-# We build the new list (space-separated) in lnew.
+sub precomp () {
+  if (!@files) {
+    print STDERR "none at all yet!\n";
+    exit 0;
+  }
 
-l=$(sort -nr <<END
-$l
-END
-)
-
-for ni in "$@"; do
-       wantcount=${ni%x*}
-
-       div=1
-
-       while true; do
-               min=$(( (${ni#*x} * $unit) / $div - $slop ))
-
-               ls=''
-               lnew=''
-               skipped=0
-               for ce in $l; do
-                       cn=${ce#*/}; cl=${ce%%/*}
-                       cs=${cl#,}; cs=${cs#:}
-                       case $cl in ,*) ls=$cs; continue;; esac
-                       if [ $wantcount != 0 ]; then
-                               if ! [ "$ls" ] || \
-                                  [ $(( $ls - $cs )) -ge $min ]; then
-                                       echo "keep (for $ni) $cn"
-                                       ce=,$ce
-                                       ls=$cs
-                                       wantcount=$(( $wantcount - 1 ))
-                               else
-                                       skipped=$(( $skipped+1 ))
-                               fi
-                       fi
-                       lnew="$lnew $ce"
-               done
-               l=$lnew
-
-               if [ $wantcount = 0 ]; then break; fi
-               printf "%s" "insufficient (for $ni) by $wantcount"
-               if [ $skipped = 0 ]; then echo; break; fi
-               div=$(( $div * 2 ))
-               echo " shortening interval ${div}x"
-       done
-
-       # s/([,:]+).*/:\1/g
-       lnew=''
-       for ce in $l; do
-               case $ce in ,*) ce=:${ce#,};; esac
-               case $ce in ::*) ce=${ce#:};; esac
-               lnew="$lnew $ce"
-       done
-       l=$lnew
-done
-
-#-------------------- execution --------------------
-
-trap '' 0
-exitstatus=0
-
-nonbroken_echo () { (echo "$@"); }
-# While we have subprocesses, we have to avoid bash calling write(1,...)
-# because of a bug in bash (Debian #382798), so we arrange for a subshell
-# for each echo.
-
-jobs=''
-for ce in $l; do
-       case $ce in
-       :*);;
-       *)
-               cn=${ce#*/}
-               nonbroken_echo "expire $cn"
-               $rm $recurse -- $cn &
-               jobs="$jobs $!"
-               ;;
-       esac
-done
-
-if [ "$jobs" ]; then
-       nonbroken_echo "all running"
-fi
-
-for job in $jobs; do
-       wait $job || exitstatus=4
-done
-
-if [ $exitstatus = 0 ]; then
-       echo "complete"
-else
-       echo "complete, but problems deleting"
-fi
-
-exit $exitstatus
+  # newest first, which means biggest T
+  @files = sort { $b->{T} <=> $a->{T} || $b->{F} cmp $a->{F} } @files;
+  my $newest_t = $files[0]{T};
+  $_->{A} = ($newest_t - $_->{T}) / $unit foreach @files;
+  $slop /= $unit;
+
+  push @{$files[0]{U}}, "newest";
+
+  print DEBUG Dumper(scalar(@files), \@files, \@intervals) if $debug >= 2;
+}
+
+sub flag ($) {
+  my ($int) = @_;
+  my $n = $int->{N};
+  my $d = $int->{D};
+  my $dmin = $d - $slop;
+  my $dmax = $d + $slop;
+  my $spec = $int->{Spec};
+  my $start_age = ($n-1) * $d - $slop;
+  my $i = 0;
+  my $insufficiently_old = 0;
+
+  print DEBUG "FLAG $spec sa=$start_age dmin=$dmin dmax=$dmax\n";
+
+  # find $i, the youngest which is at least $start_age
+  for (;;) {
+    print DEBUG "i #$i $files[$i]{A}\n";
+    last if $files[$i]{A} >= $start_age;
+    if ($i == $#files) {
+      $insufficiently_old = 1;
+      print STDERR "insufficiently old for $spec\n";
+      last;
+    }
+    $i++;
+  }
+
+  my $oldest = $i;
+  my $count = 0;
+
+  my $use = sub {
+    my ($i, $spec) = @_;
+    push @{ $files[$i]{U} }, $spec;
+    $count++;
+  };
+
+  for (;;) {
+    $use->($i, $spec);
+
+    # find $j, the closest to $i, preferably no more than $dmax younger
+    my $j = $i;
+    for (;;) {
+      $j--;
+      # at each point in this loop $j is the next candidate
+      last if $j < 0;
+      my $dt = $files[$i]{A} - $files[$j]{A};
+      print DEBUG "j #$j $files[$j]{A} dt=$dt\n";
+      last if $dt > $dmax;
+    }
+    $j++;
+    if ($j == $i) {
+      $j--;
+      last if $j < 0;
+      print STDERR "insufficiently dense for $spec before $files[$j]{F}\n";
+    }
+    print DEBUG "i #$j\n";
+
+    $i = $j;
+  }
+
+  $i = $oldest;
+  while ($count < $n) {
+    for (;;) {
+      $i++;
+      if ($i > $#files) {
+       if (!$insufficiently_old) {
+         print STDERR
+           "insufficiently old for $spec (density compensation)\n";
+       }
+       return;
+      }
+      my $dt = $files[$i]{A} - $files[$oldest]{A};
+      print DEBUG "o #$i $files[$i]{A} dt=$dt\n";
+      last if $dt >= $dmin;
+    }
+    $use->($i, "$spec+");
+  }
+}
+
+sub do_rm ($) {
+  my ($fn) = @_;
+  if ($enable >= 2) {
+    my $r= system 'rm', ($recurse ? ('-r') : ()), "--", $fn;
+    die "run rm: $!\n" unless defined($r) && $r >= 0;
+    exit 4 if $r;
+  }
+}
+
+sub implement () {
+  foreach (reverse sort @oldfiles) {
+    printf "remove %s - old\n", $_;
+    do_rm($_);
+  }
+  foreach (reverse @files) {
+    next unless @{$_->{U}};
+    printf "keep %s for %s - age %.1f\n",
+      $_->{F}, "@{$_->{U}}", $_->{A};
+  }
+  foreach (reverse @files) {
+    next if @{$_->{U}};
+    printf "remove %s - age %.1f\n",
+      $_->{F}, $_->{A};
+    if ($enable >= 1) {
+      my $tmp = "$_->{F}.rm";
+      rename $_->{F}, $tmp or die "rename $_->{F} to $tmp: $!\n";
+      do_rm($tmp);
+    }
+  }
+}
+
+open DEBUG, ">/dev/null" or die $!;
+
+while (@ARGV && $ARGV[0] =~ m/^-/) {
+  $_ = shift @ARGV;
+  last if $_ eq '-' || $_ eq '--';
+  if (m/^-[^-]/) {
+    while (m/^-./) {
+      if (s/^-n/-/) { $enable=0; }
+      elsif (s/-r/-/) { $recurse=1; }
+      elsif (s/-D/-/) { $debug++; }
+      elsif (s/-u(\d+)$//) { $unit=$1; }
+      elsif (s/-s(\d+)$//) { $slop=$1; }
+      else { badusage "unknown short option $_" }
+    }
+  } elsif (m/^--rename-only$/) {
+    $enable=1;
+  } elsif (m/^--help$/) {
+    print $usage or die $!;
+    exit 0;
+  } else {
+    badusage "unknown long option $_"
+  }
+}
+
+badusage "too few arguments" unless @ARGV;
+
+if ($debug) {
+  open DEBUG, ">&STDERR" or die $!;
+  DEBUG->autoflush(1);
+}
+
+$slop //= $unit * 0.1;
+
+foreach (@ARGV) {
+  m/^(\d+)x(\d+)$/ or badusage "bad <number>x<interval> $_";
+  push @intervals, { Spec => $&, N => $1, D => $2 };
+}
+
+scan();
+precomp();
+foreach (@intervals) { flag $_ }
+implement();
index 6952727b7421614ecb8b9f1ffee9c167110b7e6e..156078fa4d25a07f3897832dda05c3472c6d5afc 100755 (executable)
-#!/bin/bash
+#!/usr/bin/perl
+
+# git-branchmove -- move branches to or from a remote
+
+# Copyright (C) 2019 Sean Whitton
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or (at
+# your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
 #
-# Moves a branch to or from the current git tree to or from
-# another git tree
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+# This script is based on Ian Jackson's git-branchmove script, in the
+# chiark-utils Debian source package.  Ian's script assumes throughout
+# that it is possible to have unrestricted shell access to the remote,
+# however, while this script avoids that global assumption.
 #
-# usage:   git-branchmove get|put REMOTE PATTERN
-
-set -e
-set -o posix
-
-fail () { echo >&2 "git-branchmove: $*"; exit 16; }
-badusage () { fail "bad usage: $*"; }
-
-if [ $# -lt 3 ]; then badusage "too few arguments"; fi
-
-op="$1"; shift
-case "$op" in get|put) ;; *) badusage "unknown operation \`$op'"; esac
-
-remote="$1"; shift
-
-# Plan of attack:
-#  determine execute-sh runes for src and dst trees
-#  list affected branches on source
-#  check that source branches are not checked out
-#  list affected branches on destination and moan if any nonequal overlap
-#  transfer src->dst refs/heads/BRANCH:refs/heads/BRANCH
-#  transfer and merge reflog(s) xxx todo
-#  delete src refs
-
-case "$remote" in
-*:*)   remoteurl="$remote" ;;
-[/.]*) remoteurl="$remote" ;;
-*)     remoteurl="$(
-               git config remote."$remote".pushurl ||
-               git config remote."$remote".url ||
-               fail "no pushurl or url defined for remote $remote"
-               )"
-       remotename="$remote"
-esac
-
-remote_spec="$(perl -e '
-    $_ = $ARGV[0];
-    if (m#^ssh://([^:/]+)(?:\:(\w+))?#) {
-       print "$'\''|ssh ";
-       print " -p $3" if $2;
-        print "$1\n";
-    } elsif (m#^([-+_.0-9a-zA-Z\@]+):(?!//|:)#) {
-        print "$'\''|ssh $1\n";
-    } elsif (m#^[/.]#) {
-        print "$_|sh -c $1\n";
+# As much as possible we treat the remote argument as opaque, i.e., we
+# don't distinguish between git URIs and named remotes.  That means
+# that git will expand insteadOf and pushInsteadOf user config for us.
+
+=head1 NAME
+
+git-branchmove - move branches to or from a remote
+
+=head1 SYNOPSIS
+
+B<git-branchmove> [B<--detach>|B<-d>] B<get>|B<put> I<remote> I<pattern>...
+
+=head1 DESCRIPTION
+
+Move branches matching I<pattern> to or from git remote I<remote>.
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<--detach>|B<-d>
+
+If the move would delete the currently checked out branch in the
+source repository, attempt to detach HEAD first.
+
+Note that in the case of the B<get> operation, the attempt to detach
+HEAD is somewhat fragile.  You will need unrestricted SSH access to
+the remote, and pushInsteadOf git configuration keys will not always
+be expanded, due to limitations in git.
+
+=back
+
+=head1 AUTHOR
+
+This Perl version of B<git-branchmove> was written by Sean Whitton
+<spwhitton@spwhitton.name>, based on an earlier shell script by Ian
+Jackson.  That script made some assumptions that we try to avoid, for
+compatibility with more git remotes and local git configurations.
+
+=cut
+
+use strict;
+use warnings;
+
+use Git::Wrapper;
+use Try::Tiny;
+
+# git wrapper setup
+my $git = Git::Wrapper->new(".");
+try {
+    $git->rev_parse({ git_dir => 1 });
+} catch {
+    die "git-branchmove: pwd doesn't look like a git repository ..\n";
+};
+
+# process arguments
+die "git-branchmove: not enough arguments\n" if @ARGV < 3;
+my $attempt_detach = 0;
+if ($ARGV[0] eq '-d' or $ARGV[0] eq '--detach') {
+    $attempt_detach = 1;
+    shift @ARGV;
+}
+my ($op, $remote, @patterns) = @ARGV;
+die "git-branchmove: unknown operation\n"
+  unless $op eq 'get' or $op eq 'put';
+
+# is this a named remote or a git URL?  See "GIT URLS" in git-fetch(1)
+my $named_remote = not($remote =~ m|:| or $remote =~ m|^[/.]|);
+
+# Attempt to determine how we might be able to run commands in the
+# remote repo.  This will only be used if we need to try to detach the
+# remote HEAD.  These regexps are lifted from Ian's version of
+# git-branchmove
+my ($rurl, $rrune, $rdir);
+if ($named_remote) {
+    # this will expand insteadOf and pushInsteadOf
+    ($rurl) = $git->remote("get-url", "--push", $remote);
+} else {
+    # this will expand insteadOf but not pushInsteadOf, which is the
+    # best we can do; see <https://stackoverflow.com/a/32991784>
+    ($rurl) = $git->ls_remote("--get-url", $remote);
+}
+if ($rurl =~ m#^ssh://([^:/]+)(?:\:(\w+))?#) {
+    $rdir  = $';
+    $rrune = "ssh ";
+    $rrune .= "-p $2 " if $2;
+    $rrune .= $1;
+} elsif ($rurl =~ m#^([-+_.0-9a-zA-Z\@]+):(?!//|:)#) {
+    $rdir  = $';
+    $rrune = "ssh $1";
+} elsif ($rurl =~ m#^[/.]#) {
+    $rdir = $rurl;
+}
+
+# If we don't prefix the patterns, we might match branches the user
+# doesn't intend.  E.g. 'foo' would match 'wip/foo'
+my @branch_pats = map { s|^|[r]efs/heads/|r } @patterns;
+
+# get lists of branches, prefixed with 'refs/heads/' in each case
+my (@source_branches, @dest_branches);
+my @local_branches = map {
+    my ($hash, undef, $ref) = split ' ';
+    { hash => $hash, ref => $ref }
+} $git->for_each_ref(@branch_pats);
+my @remote_branches = map {
+    my ($hash, $ref) = split ' ';
+    { hash => $hash, ref => $ref }
+} $git->ls_remote($remote, @branch_pats);
+if ($op eq 'put') {
+    @source_branches = @local_branches;
+    @dest_branches   = @remote_branches;
+} elsif ($op eq 'get') {
+    @source_branches = @remote_branches;
+    @dest_branches   = @local_branches;
+}
+
+# do we have anything to move?
+die "git-branchmove: nothing to do\n" unless @source_branches;
+
+# check for deleting the current branch on the source
+my $source_head;
+if ($op eq "put") {
+    my @lines = try { $git->symbolic_ref('-q', 'HEAD') };
+    $source_head = $lines[0] if @lines;    # the HEAD is not detached
+} elsif ($op eq "get") {
+    my @lines = try { $git->ls_remote('--symref', $remote, 'HEAD') };
+    if (@lines and $lines[0] =~ m|^ref: refs/heads/|) {
+        # the HEAD is not detached
+        (undef, $source_head) = split ' ', $lines[0];
+    }
+}
+if (defined $source_head and grep /^\Q$source_head\E$/,
+    map { $_->{ref} } @source_branches) {
+    if ($attempt_detach) {
+        if ($op eq 'put') {
+            $git->checkout('--detach');
+        } elsif ($op eq 'get') {
+            if (defined $rrune and defined $rdir) {
+                system "$rrune \"set -e; cd $rdir; git checkout --detach\"";
+                die "failed to detach remote HEAD" unless $? eq 0;
+            } elsif (!defined $rrune and defined $rdir) {
+                my $dest_git = Git::Wrapper->new($rdir);
+                $dest_git->checkout('--detach');
+            } else {
+                die "git-branchmove: don't know how to detach remote HEAD";
+            }
+        }
     } else {
-        die "git-branchmove: unsupported remote url \`$_'\''\n";
+        die "git-branchmove: would delete checked-out branch $source_head\n";
+    }
+}
+
+# check whether we would overwrite anything
+foreach my $source_branch (@source_branches) {
+    foreach my $dest_branch (@dest_branches) {
+        die "git-branchmove: would overwrite $source_branch->{ref}"
+          if (  $source_branch->{ref} eq $dest_branch->{ref}
+            and $source_branch->{hash} ne $dest_branch->{hash});
+    }
+}
+
+# time to actually move the branches
+my @refspecs      = map { "$_->{ref}:$_->{ref}" } @source_branches;
+my @nuke_refspecs = map { ":$_->{ref}" } @source_branches;
+if ($op eq 'put') {
+    $git->push('--no-follow-tags', $remote, @refspecs);
+    $git->update_ref('-m', "git-branchmove: moved to $remote ($rurl)",
+        '-d', $_->{ref}, $_->{hash})
+      for @source_branches;
+} elsif ($op eq 'get') {
+    $git->fetch('--no-tags', $remote, @refspecs);
+    $git->push('--no-follow-tags', $remote, @nuke_refspecs);
+}
+
+# if the remote is a named remote, rather than just a URI, update
+# remote-tracking branches
+if ($named_remote) {
+    foreach my $source_branch (@source_branches) {
+        my $branch       = $source_branch->{ref} =~ s|^refs/heads/||r;
+        my $tracking_ref = "refs/remotes/$remote/$branch";
+        if ($op eq 'put') {
+            $git->update_ref($tracking_ref, $source_branch->{hash});
+        } elsif ($op eq 'get') {
+            $git->update_ref('-d', $tracking_ref);
+        }
     }
-' "$remoteurl")"
-
-remote_path="${remote_spec%%|*}"
-remote_rune="${remote_spec#*|}"
-
-case $op in
-get)
-       src_rune="$remote_rune"
-       src_path="$remote_path"
-       dst_rune="sh -c"
-       dst_path=.
-       updatemsg="git-branchmove: moved to $remote ($remoteurl)"
-       push_fetch=fetch
-       ;;
-put)
-       dst_rune="$remote_rune"
-       dst_path="$remote_path"
-       src_rune="sh -c"
-       src_path=.
-       updatemsg="git-branchmove; moved to `hostname -f` by `whoami`"
-       push_fetch=push
-       ;;
-esac
-
-on_src () { $src_rune "set -e; cd $src_path; $*"; }
-on_dst () { $dst_rune "set -e; cd $dst_path; $*"; }
-
-
-#----- fetch the current refs from both sides -----
-
-branch_pats=''
-for branch_pat in "$@"; do
-       branch_pats+=" '[r]efs/heads/$branch_pat'"
-done
-
-get_branches_rune='
-       git for-each-ref --format="%(refname)=%(objectname)" '"$branch_pats"'
-'
-
-src_branches=( $(
-       on_src '
-               printf H
-               git symbolic-ref -q HEAD || test $? = 1
-               echo " "
-               '"$get_branches_rune"'
-       '       
-))
-
-src_head="${src_branches[0]}"
-unset src_branches[0]
-: "${src_branches[@]}"
-
-case "$src_head" in
-H) ;; # already detached
-*)
-       src_head="${src_head#H}"
-       for check in "${src_branches[@]}"; do
-               case "$check" in
-               "$src_head"=*)
-                       fail "would delete checked-out branch $src_head"
-                       ;;
-               esac
-       done
-       ;;
-esac
-
-
-if [ "${#src_branches[@]}" = 0 ]; then
-       echo >&2 "git-branchmove: nothing to do"
-       exit 1
-fi
-
-dst_branches=( $(on_dst "$get_branches_rune") )
-: "${dst_branches[@]}"
-
-
-#----- check for nonequal overlaps -----
-
-ok=true
-for dst_check in "${dst_branches[@]}"; do
-       dst_ref="${dst_check%=*}"
-       for src_check in "${src_branches[@]}"; do
-               case "$src_check" in
-               "$dst_check")   ;;
-               "$dst_ref"=*)
-                       ok=false
-                       echo >&2 "src: $src_check   dst: $dst_check"
-                       ;;
-               esac
-       done
-done
-
-$ok || fail "would overwrite some destination branch(es)"
-
-
-#----- do the transfer -----
-
-refspecs=()
-for src_xfer in "${src_branches[@]}"; do
-       src_ref="${src_xfer%=*}"
-       refspecs+=("$src_ref:$src_ref")
-done
-
-case "$op" in
-put)   git push "$remote" "${refspecs[@]}"     ;;
-get)   git fetch "$remote" "${refspecs[@]}"    ;;
-*)     fail "unknown $op ???"                  ;;
-esac
-
-
-#----- delete the refs on the source -----
-
-(
-       printf "%s\n" "$updatemsg"
-       for src_rm in "${src_branches[@]}"; do printf "%s\n" "$src_rm"; done
-) | on_src '
-       read updatemsg
-       while read src_rm; do
-               src_ref="${src_rm%=*}"
-               src_obj="${src_rm##*=}"
-               git update-ref -m "$updatemsg" -d "$src_ref" "$src_obj"
-               echo "moved: $src_ref"
-       done
-'
-
-#----- update the remote tracking branches -----
-
-if [ "x$remotename" != x ]; then
-       for src_rm in "${src_branches[@]}"; do
-               src_ref="${src_rm%=*}"
-               src_obj="${src_rm##*=}"
-
-               case "$src_ref" in
-               refs/heads/*) ;;
-               *) continue ;;
-               esac
-
-               branch="${src_ref#refs/heads/}"
-               track_ref="refs/remotes/$remotename/$branch"
-               case $op in
-               get)    git update-ref -d "$track_ref"  ;;
-               put)    git update-ref "$track_ref" "$src_obj" ;;
-               *)      fail "unknown $op ???"
-               esac
-       done
-fi
-
-echo "git-repomove: moved ${#src_branches[@]} branches."
+}
index 52e01d0203b0e210200119cb42b57eea76ff7dbb..2d80cb1b48c1026707b4bd79be0242def7fe9680 100755 (executable)
@@ -19,6 +19,9 @@
 #    fetch=no             just use what is in the cache
 #    fetch=try            use what is in the cache if the fetch/clone fails
 #    timeout=<seconds>    length of time to allow for fetch/clone
+#    housekeeping-interval-days=<integer>  } housekeeping tuning parameters
+#    tree-expire-days=<integer>            }
+#    gc-interval-days=<integer>            }
 
 # example inetd.conf line:
 #  9419 stream tcp nowait git-cache /usr/bin/git-cache-proxy git-cache-proxy
@@ -64,6 +67,7 @@ our $us = 'git-cache-proxy';
 
 our $debug = 0;
 our $housekeepingeverydays = 1;
+our $gcintervaldays = 10;
 our $treeexpiredays = 21;
 our $fetchtimeout = 3600;
 our $maxfetchtimeout = 7200;
@@ -141,6 +145,8 @@ sub fail ($) {
     exit 0;
 }
 
+$SIG{ALRM} = sub { fail "timeout" };
+
 sub gitfail ($) {
     my ($msg) = @_;
     close LOCK;
@@ -176,6 +182,7 @@ for (;;) {
                       | serve-timeout
                       | tree-expire-days
                       | housekeeping-interval-days
+                      | gc-interval-days
                       )=(\d+)$//x) {
            my $vn = $1;
            $vn =~ y/-//d;
@@ -191,12 +198,13 @@ for (;;) {
 
 #---------- utility functions ----------
 
-sub lockfile ($$$) {
-    my ($fh, $fn, $flockmode) = @_;
+sub lockfile ($$$$) {
+    my ($fh, $fn, $flockmode, $update_ts) = @_;
     my $what = $fn.(($flockmode & ~LOCK_NB) == LOCK_SH ? " (shared)" : "");
     for (;;) {
        close $fh;
-       open $fh, '+>', $fn or fail "open/create $fn for lock: $!";
+       open $fh, ($update_ts ? '+>' : '+>>'), $fn
+           or fail "open/create $fn for lock: $!";
        logm 'debug', "lock $what: acquiring";
        if (!flock $fh, $flockmode) {
            if ($flockmode & LOCK_NB && $! == EWOULDBLOCK) {
@@ -246,14 +254,13 @@ sub servinfo ($) {
 }
 
 sub readcommand () {
-    $SIG{ALRM} = sub { fail "timeout" };
     alarm 30;
 
     my $hex_len = xread 4;
     fail "Bad hex in packet length" unless $hex_len =~ m|^[0-9a-fA-F]{4}$|;
     my $line = xread -4 + hex $hex_len;
     unless (($service,$specpath,$spechost) = $line =~
-           m|^(git-[a-z-]+) /*([!-~ ]+)\0host=([!-~]+)\0$|) {
+           m|^(git-[a-z-]+) /*([!-~ ]+)\0host=([!-~]+)\0|) {
        $line =~ s|[^ -~]+| |g;
        gitfail "unknown/unsupported instruction `$line'"
     }
@@ -298,8 +305,18 @@ sub readcommand () {
     servinfo "locking";
 }
 
+sub update_gcstamp ($) {
+    my ($gitdir) = (@_);
+    my $gcdone = "$gitdir/cache-proxy-gc.stamp";
+    if (open GCSTAMP, '>', $gcdone) {
+       close GCSTAMP;
+    } else {
+       $!==ENOENT or fail "create $gcdone: $!";
+    }
+}
+
 sub clonefetch () {
-    lockfile \*LOCK, $lock, LOCK_EX;
+    lockfile \*LOCK, $lock, LOCK_EX, 1;
 
     my $exists = lstat $gitd;
     $exists or $!==ENOENT or fail "lstat $gitd: $!";
@@ -308,6 +325,19 @@ sub clonefetch () {
 
     if ($fetch) {
 
+       my $rbits = '';
+       vec($rbits,0,1) = 1;
+       my $ebits = $rbits;
+       my $r=select $rbits,undef,$ebits,0;
+       $r>=0 or fail "select recheck STDOUT failed: $!";
+       if ($r) {
+           servinfo 'client disconnected (stdin unexpectedly'.
+               (vec($rbits,0,1) ? ' readable' : '').
+               (vec($ebits,0,1) ? ' exception' : '').
+               ')';
+           exit 0;
+       }
+
        our @cmd;
 
        if (!$exists) {
@@ -366,6 +396,7 @@ sub clonefetch () {
         alarm 0;
 
        if (!$exists) {
+           update_gcstamp($tmpd);
            rename $tmpd, $gitd or fail "rename fresh $tmpd to $gitd: $!";
            $exists = 1;
        }
@@ -378,7 +409,7 @@ sub clonefetch () {
     }
 
     servinfo "sharing";
-    lockfile \*LOCK, $lock, LOCK_SH; # NB releases and relocks
+    lockfile \*LOCK, $lock, LOCK_SH, 1; # NB releases and relocks
 
     if (stat $gitd) {
        return 1;
@@ -396,43 +427,94 @@ sub housekeeping () {
     logm 'info', "housekeeping started";
     foreach $lock (<[a-z]*\\.lock>) {
        my $subdir = $lock;  $subdir =~ s/\\.lock$//;
+       my $gcdone = "$subdir\\.git/cache-proxy-gc.stamp";
        if (!lstat $lock) {
            $! == ENOENT or hkfail "$lock: lstat: $!";
            next;
        }
+       my ($mode_what,$mode_locknb,$mode_action);
        if (-M _ <= $treeexpiredays) {
-           logm 'debug', "housekeeping: subdirs $subdir: touched recently";
-           next;
-       }
-       if (!lockfile \*LOCK, $lock, LOCK_EX|LOCK_NB) {
-           logm 'info', "housekeeping: subdirs $subdir: lock busy, skipping";
-           next;
-       }
-       logm 'info', "housekeeping: subdirs $subdir: cleaning";
-       eval {
-           foreach my $suffix (qw(tmp git)) {
-               my $dir = "${subdir}\\.$suffix";
-               my $tdir = "${subdir}\\.tmp";
-               if ($dir ne $tdir) {
-                   if (!rename $dir,$tdir) {
-                       next if $! == ENOENT;
-                       die "$dir: cannot rename to $tdir: $!\n";
+           my $gccheck = sub {
+               if (!lstat "$gcdone") {
+                   $! == ENOENT or hkfail "$gcdone: lstat: $!";
+                   return 1, "touched recently, never gc'd!";
+               } elsif (-M _ <= $gcintervaldays) {
+                   return 0, "touched recently, gc'd recently";
+               } else {
+                   return 1, "touched recently, needs gc";
+               }
+           };
+           my ($needsgc, $gcmsg) = $gccheck->();
+           logm 'debug', "housekeeping: subdirs $subdir: $gcmsg";
+           next unless $needsgc;
+           $mode_what = 'garbage collecting';
+           $mode_locknb = 0;
+           $mode_action = sub {
+               my ($needsgc, $gcmsg) = $gccheck->();
+               if (!$needsgc) {
+                   logm 'info',
+                       "housekeeping: subdirs $subdir: someone else has gc'd";
+                   return;
+               }
+               logm 'debug', "housekeeping: subdirs $subdir: $gcmsg (2)";
+               my $gclog = "$subdir/gc.log";
+               unlink $gclog or $!==ENOENT or hkfail "remove $gclog: $!";
+               my $child = fork // hkfail "fork (for $subdir): $!";
+               if (!$child) {
+                   if (!chdir "$subdir\\.git") {
+                       exit 0 if $!==ENOENT;
+                       die "for gc: chdir $subdir: $!\n";
                    }
+                   exec qw(git gc --quiet);
+                   die "exec git gc (for $subdir): $!\n";
                }
-               system qw(rm -rf --), $tdir;
-               if (stat $tdir) {
-                   die "$dir: problem deleting file(s), rm exited $?\n";
-               } elsif ($! != ENOENT) {
-                   die "$tdir: cannot stat after deletion: $!\n";
+               waitpid($child, 0) == $child or hkfail "waitpid failed! $!";
+               if ($?) {
+                   logm 'err',
+ "housekeeping: subdirs $subdir: gc failed (wait status $?)";
+               } else {
+                   update_gcstamp("$subdir\\.git");
+                   logm 'debug',
+                       "housekeeping: subdirs $subdir: gc done";
                }
-           }
-       };
-       if (length $@) {
-           chomp $@;
-           logm 'warning', "housekeeping: $subdir: cleanup prevented: $@";
+           };
        } else {
-           unlink $lock or hkfail "remove $lock: $!";
+           $mode_what = 'cleaning';
+           $mode_locknb = LOCK_NB;
+           $mode_action = sub {
+               eval {
+                   foreach my $suffix (qw(tmp git)) {
+                       my $dir = "${subdir}\\.$suffix";
+                       my $tdir = "${subdir}\\.tmp";
+                       if ($dir ne $tdir) {
+                           if (!rename $dir,$tdir) {
+                               next if $! == ENOENT;
+                               die "$dir: cannot rename to $tdir: $!\n";
+                           }
+                       }
+                       system qw(rm -rf --), $tdir;
+                       if (stat $tdir) {
+ die "$dir: problem deleting file(s), rm exited $?\n";
+                       } elsif ($! != ENOENT) {
+                           die "$tdir: cannot stat after deletion: $!\n";
+                       }
+                   }
+               };
+               if (length $@) {
+                   chomp $@;
+ logm 'warning', "housekeeping: $subdir: cleanup prevented: $@";
+               } else {
+                   unlink $lock or hkfail "remove $lock: $!";
+               }
+           };
+       }
+       if (!lockfile \*LOCK, $lock, LOCK_EX|$mode_locknb, 0) {
+            die $! unless $mode_locknb;
+           logm 'info', "housekeeping: subdirs $subdir: lock busy, skipping";
+           next;
        }
+       logm 'info', "housekeeping: subdirs $subdir: $mode_what";
+       $mode_action->();
     }
     open HS, ">", "Housekeeping.stamp" or hkfail "touch Housekeeping.stamp: $!";
     close HS or hkfail "close Housekeeping.stamp: $!";
@@ -442,7 +524,7 @@ sub housekeeping () {
 sub housekeepingcheck ($$) {
     my ($dofork, $force) = @_;
     if (!$force) {
-       if (!lockfile \*HLOCK, "Housekeeping.lock", LOCK_EX|LOCK_NB) {
+       if (!lockfile \*HLOCK, "Housekeeping.lock", LOCK_EX|LOCK_NB, 1) {
            logm 'debug', "housekeeping lock taken, not running";
            close HLOCK;
            return 0;
index 9a1b0475bdb4ce05fe84c0a3a8681a8e074ff000..a4458f6b96f4eea7791469188995c9e53312ad9b 100755 (executable)
@@ -1,4 +1,4 @@
-#!/usr/bin/tclsh8.4
+#!/usr/bin/tclsh8.6
 set comment {
 #
 Use of the screen:
diff --git a/scripts/prefork-interp-test b/scripts/prefork-interp-test
new file mode 100755 (executable)
index 0000000..b99af3c
--- /dev/null
@@ -0,0 +1,32 @@
+#!/usr/bin/prefork-interp -U,perl,-w
+# -*- perl -*-
+
+# Copyright 2022 Ian Jackson and contributors to chiark-utils
+# SPDX-License-Identifier: GPL-3.0-or-later
+# There is NO WARRANTY.
+
+use strict;
+use Proc::Prefork::Interp;
+
+sub prwhen ($) {
+  my ($when) = @_;
+  my @env = sort keys %ENV;
+  print STDERR "$when - STDERR - @ARGV - $ENV{PREFORK_INTERP} - @env\n"
+    and flush STDERR or die $!;
+  print STDOUT "$when - STDOUT\n"
+    and flush STDOUT or die $!;
+}
+
+prwhen('BEGIN');
+
+prefork_initialisation_complete();
+
+prwhen('AFTER');
+
+while (<STDIN>) {
+  last unless m{\S};
+  $_ = uc $_;
+  print or die $!;
+  flush STDOUT or die $!;
+  print STDERR length, "\n";
+}
index 495b2b3f855b47d716d59929186d61ee5079bdf4..27969c14f319761ab1cf37b96cb43f9a4e55aff2 100644 (file)
@@ -20,7 +20,8 @@
 # website at www.fsf.org, or the GNU Project website at www.gnu.org.
 
 CONFIG_CPPFLAGS=       -DRWBUFFER_SIZE_MB=$(RWBUFFER_SIZE_MB) \
-                       -DREALLY_CHECK_FILE='"/etc/inittab"'
+                       -DREALLY_CHECK_FILE='"/etc/inittab"' \
+                       -DREALLY_CHECK_FILE_2='"/etc/rc.local"'
 
 CC=            gcc
 CFLAGS=                $(WARNINGS) $(OPTIMISE) $(DEBUG) $(CMDLINE_CFLAGS)
index cef131c78b8b7d3aa0e5d7b5a5cdec943a1bdc8d..5348a14470a89b24b81b26f9eda254ed6752c6c7 100755 (executable)
@@ -64,7 +64,7 @@ sub fields_fmt ($$) {
     my ($pfx,$fmt) = @_;
     my ($vn);
     $vn= "fields_pw_$fmt";
-    die "unknown format $fmt\n" unless defined @$vn;
+    die "unknown format $fmt\n" unless @$vn;
     fields($pfx,@$vn);
     $vn= "${pfx}_format";
     $$vn= $fmt;