Support setuid operation.

* sysif.c (orig_euid, real_uid, repress_called, is_setuid):
New static variables.
(repress_privilege, drop_privilage, simulate_setuid):
New functions.
(RC_MAGIC): New preprocessor symbol.

* sysif.c (repress_privilege, drop_privilage,
simulate_setuid): Declared.

* txr.c (txr_main): Call repress_privilege to check
and remember whether we are in setuid mode, and temporarily
drop the effective uid to the real one.
(txr_main): Permanently drop privileges in all cases except
script execution. In script execution cases, go through
simulate_setuid to either set or preserve the effective
user ID, or else drop privs.

* txr.1: Documented setuid operation in new section.

4 files changed, 136 insertions, 1 deletions

diff --git a/sysif.c b/sysif.c
index 18761e59..7b072072 100644
--- a/sysif.c
+++ b/sysif.c
@@ -861,6 +861,59 @@ static val setegid_wrap(val nval)
   return t;
 }
 
+#define RC_MAGIC 0xbe50c001
+
+static uid_t orig_euid, real_uid;
+static int repress_called = 0, is_setuid = 1;
+
+void repress_privilege(void)
+{
+  real_uid = getuid();
+  orig_euid = geteuid();
+
+  if (real_uid != orig_euid)
+    seteuid(getuid());
+  else
+    is_setuid = 0;
+
+  repress_called = RC_MAGIC;
+}
+
+void drop_privilege(void)
+{
+  if (repress_called != RC_MAGIC || (is_setuid && setuid(getuid()) != 0))
+    abort();
+}
+
+void simulate_setuid(val open_script)
+{
+  if (repress_called != RC_MAGIC || (is_setuid && seteuid(orig_euid) != 0))
+    abort();
+
+  if (!is_setuid && orig_euid != 0)
+    return;
+
+  {
+    val fdv = stream_get_prop(open_script, fd_k);
+
+    if (fdv) {
+      struct stat stb;
+      cnum fd = c_num(fdv);
+
+      if (fstat(fd, &stb) != 0)
+        abort();
+
+      if ((stb.st_mode & (S_ISUID | S_IXUSR)) == (S_ISUID | S_IXUSR)) {
+        seteuid(stb.st_uid);
+        return;
+      }
+    }
+  }
+
+  if (is_setuid)
+    setuid(real_uid);
+}
+
 #endif
 
 #if HAVE_PWUID
diff --git a/sysif.h b/sysif.h
index 051f1d6d..22431823 100644
--- a/sysif.h
+++ b/sysif.h
@@ -49,4 +49,13 @@ off_t off_t_num(val num);
 val num_off_t(off_t offnum);
 val stdio_ftell(FILE *);
 val stdio_fseek(FILE *, val, int whence);
+#if HAVE_GETEUID
+void repress_privilege(void);
+void drop_privilege(void);
+void simulate_setuid(val open_script);
+#else
+INLINE repress_privilege(void) { }
+INLINE drop_privilege(void) { }
+INLINE void simulate_setuid(val open_script) { }
+#endif
 void sysif_init(void);
diff --git a/txr.1 b/txr.1
index 44fe5eb8..aaec5228 100644
--- a/txr.1
+++ b/txr.1
@@ -39122,6 +39122,52 @@ If multi-line mode is toggled interactively from within the listener,
 the variable is updated to reflect the latest state. This happens
 when the command is submitted for evaluation.
 
+.SH* SETUID OPERATION
+
+On platforms with the Unix security model, \*(TX provides special behaviors
+in situations when the \*(TX executable is running as "setuid" on behalf of
+some user or is running as root (uid 0), and from the command line executes a
+script file which is marked executable and setuid.
+
+The main noteworthy consequence of this functionality is that this feature
+allows TXR interpreter scripts (which use the Unix Hash Bang `#!` mechanism)
+to use the setuid permission bit, even if the underlying operating system
+kernel does not support setuid on interpreter scripts.
+
+Firstly, when \*(TX is invoked as root (meaning that the effective uid is 0,
+regardless of the value of the real uid), and the command line indicates that a
+file is to be executed whose owner execute permission is set, and which is
+marked "setuid", \*(TX will honor that setuid permission. Before processing the
+file, \*(TX changes its effective user ID to the owner of the file.
+
+Secondly, when \*(TX is invoked setuid (meaning that the effective uid
+is different from the real uid), and the command line indicates that
+a file is to be executed whose owner execute permission is set, and which
+is marked "setuid", \*(TX will honor that setuid permission, if possible.
+If the effective uid is 0, then this happens through the previously described
+case. If the effective uid is other than zero, and matches the owner uid of
+the file, then \*(TX maintains its effective uid as-is. Otherwise, \*(TX
+drops its setuid privilege.
+
+Thirdly, when \*(TX is invoked setuid in order to perform computations other
+than opening a script file, it drops privileges.
+
+Dropping privilege means evaluating the C expression `setuid(getuid())`:
+the effective uid, and every other stored uid, are permanently reset back to
+the real uid.
+
+Thus, in summary, when \*(TX is invoked setuid, eventually a decision is made
+whether to drop the privileges, change the effective uid to that indicated
+by a setuid executable script, or simply keep the effective uid. This decision
+is made before executing code supplied as inputs. Thus a setuid \*(TX
+executable will not execute arbitrary code under elevated privilege,
+but grants privilege to properly configured setuid scripts.
+
+Furthermore, as a small precaution, between program startup and the point in
+the execution when this this decision is made, \*(TX temporarily changes its
+effective uid to the real uid, using `seteuid(getuid())`. Just prior to making
+the decision regarding the setuid script, \*(TX restores its effective uid.
+
 .SH* DEBUGGER
 \*(TX has a simple, crude, built-in debugger. The debugger is invoked by adding
 the
diff --git a/txr.c b/txr.c
index 36703b2f..476362ae 100644
--- a/txr.c
+++ b/txr.c
@@ -327,6 +327,7 @@ int txr_main(int argc, char **argv);
 int main(int argc, char **argv)
 {
   val stack_bottom = nil;
+  repress_privilege();
   progname = argv[0] ? utf8_dup_from(argv[0]) : progname;
   progname_u8 = argv[0];
   init(progname, oom_realloc_handler, &stack_bottom);
@@ -436,6 +437,7 @@ int txr_main(int argc, char **argv)
   }
 
   if (argc <= 1) {
+    drop_privilege();
 #if HAVE_TERMIOS
     banner();
     goto repl;
@@ -510,6 +512,7 @@ int txr_main(int argc, char **argv)
 
       /* Long opts with no arguments */
       if (org) {
+        drop_privilege();
         format(std_error,
                lit("~a: option --~a takes no argument, ~a given\n"),
                prog_string, opt, org, nao);
@@ -517,23 +520,29 @@ int txr_main(int argc, char **argv)
       }
 
       if (equal(opt, lit("version"))) {
+        drop_privilege();
         format(std_output, lit("~a: version ~a\n"),
                prog_string, static_str(version), nao);
         return 0;
       }
 
       if (equal(opt, lit("help"))) {
+        drop_privilege();
         help();
         return 0;
       }
 
-      if (equal(opt, lit("license")))
+      if (equal(opt, lit("license"))) {
+        drop_privilege();
         return license();
+      }
 
       if (equal(opt, lit("gc-debug"))) {
+        drop_privilege();
         opt_gc_debug = 1;
         continue;
       } else if (equal(opt, lit("vg-debug"))) {
+        drop_privilege();
 #if HAVE_VALGRIND
         opt_vg_debug = 1;
         continue;
@@ -554,6 +563,7 @@ int txr_main(int argc, char **argv)
         txr_lisp_p = t;
         continue;
       } else if (equal(opt, lit("debugger"))) {
+        drop_privilege();
 #if CONFIG_DEBUG_SUPPORT
         opt_debugger = 1;
         continue;
@@ -562,6 +572,7 @@ int txr_main(int argc, char **argv)
         return EXIT_FAILURE;
 #endif
       } else if (equal(opt, lit("debug-autoload"))) {
+        drop_privilege();
 #if CONFIG_DEBUG_SUPPORT
         opt_debugger = 1;
         opt_dbg_autoload = 1;
@@ -571,6 +582,7 @@ int txr_main(int argc, char **argv)
         return EXIT_FAILURE;
 #endif
       } else if (equal(opt, lit("debug-expansion"))) {
+        drop_privilege();
 #if CONFIG_DEBUG_SUPPORT
         opt_debugger = 1;
         opt_dbg_expansion = 1;
@@ -580,6 +592,7 @@ int txr_main(int argc, char **argv)
         return EXIT_FAILURE;
 #endif
       } else if (equal(opt, lit("yydebug"))) {
+        drop_privilege();
         if (have_yydebug) {
           yydebug_onoff(1);
           format(std_error,
@@ -627,6 +640,7 @@ int txr_main(int argc, char **argv)
         spec_file = arg;
         break;
       case 'e':
+        drop_privilege();
         reg_varl(self_path_s, lit("cmdline-expr"));
         reg_var(args_s, arg_list);
 
@@ -645,6 +659,7 @@ int txr_main(int argc, char **argv)
                                             if3(c_chr(opt) == 'P',
                                                 pprinl,
                                                 tprint));
+          drop_privilege();
           reg_varl(self_path_s, lit("cmdline-expr"));
           reg_var(args_s, arg_list);
           pf(eval_intrinsic(lisp_parse(arg, std_error, colon_k,
@@ -683,6 +698,7 @@ int txr_main(int argc, char **argv)
           opt_print_bindings = 1;
           break;
         case 'i':
+          drop_privilege();
 #if HAVE_TERMIOS
           enter_repl = t;
           break;
@@ -693,6 +709,7 @@ int txr_main(int argc, char **argv)
           return EXIT_FAILURE;
 #endif
         case 'd':
+          drop_privilege();
 #if CONFIG_DEBUG_SUPPORT
           opt_debugger = 1;
 #else
@@ -713,14 +730,17 @@ int txr_main(int argc, char **argv)
         case 'C':
         case 't':
         case 'D':
+          drop_privilege();
           format(std_error, lit("~a: option -~a does not clump\n"),
                  prog_string, opch, nao);
           return EXIT_FAILURE;
         case '-':
+          drop_privilege();
           format(std_error, lit("~a: unrecognized long option: --~a\n"),
                  prog_string, cdr(optchars), nao);
           return EXIT_FAILURE;
         default:
+          drop_privilege();
           format(std_error, lit("~a: unrecognized option: -~a\n"),
                  prog_string, opch, nao);
           return EXIT_FAILURE;
@@ -730,12 +750,14 @@ int txr_main(int argc, char **argv)
   }
 
   if (specstring && spec_file) {
+    drop_privilege();
     format(std_error, lit("~a: cannot specify both -f and -c\n"),
            prog_string, nao);
     return EXIT_FAILURE;
   }
 
   if (specstring) {
+    drop_privilege();
     spec_file_str = lit("cmdline");
     if (gt(length_str(specstring), zero) &&
         chr_str(specstring, minus(length_str(specstring), one)) != chr('\n'))
@@ -746,13 +768,16 @@ int txr_main(int argc, char **argv)
   } else if (spec_file) {
     if (wcscmp(c_str(spec_file), L"-") != 0) {
       open_txr_file(spec_file, &txr_lisp_p, &spec_file_str, &parse_stream);
+      simulate_setuid(parse_stream);
     } else {
+      drop_privilege();
       spec_file_str = lit("stdin");
     }
     if (arg)
       arg_list = arg_undo;
   } else {
     if (!arg) {
+      drop_privilege();
       if (enter_repl)
         goto repl;
       if (evaled)
@@ -768,7 +793,9 @@ int txr_main(int argc, char **argv)
 
     if (!equal(arg, lit("-"))) {
       open_txr_file(arg, &txr_lisp_p, &spec_file_str, &parse_stream);
+      simulate_setuid(parse_stream);
     } else {
+      drop_privilege();
       spec_file_str = lit("stdin");
     }
   }