#! /bin/sh
# with --- run program with special properties

# Copyright (C) 1995, 2000 Noah S. Friedman

# Author: Noah Friedman <friedman@splode.com>
# Created: 1995-08-14

# $Id: with,v 1.10 2000/01/20 20:09:45 friedman Exp $

# 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 2, 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.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, you can either send email to this
# program's maintainer or write to: The Free Software Foundation,
# Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.

# Commentary:

# TODO: create optional socket streams for stdin or stdout before invoking
# subprocess.

# Code:

exec ${PERL-perl} -Sx $0 ${1+"$@"}
#!perl		  [perl will skip all lines in this file before this line]

use Getopt::Long;
use Fcntl;
use Symbol;

use strict;
no strict "vars";

sub err (;@)
{
  my $fh = (ref ($_[0]) ? shift : *STDERR{IO});
  print $fh join (": ", $progname, @_), "\n";
  exit (1);
}

sub require_soft ($)
{
  my $f = shift;
  for my $dir (@INC)
    {
      return require "$f" if (-f "$dir/$f");
    }
  return undef;
}

sub get_includes ()
{
  push (@INC, @$opt_include,
              "$ENV{HOME}/lib/perl",
              "$ENV{HOME}/lib/perl/include")
    if (defined $opt_include);

  if ($opt_groups)
    {
      require_soft ("syscall.ph");
    }

  if ($opt_notty)
    {
      # Look for &TIOCNOTTY
      require_soft ("sys/ttycom.ph");
      require_soft ("sys/termios.ph");
      require_soft ("sys/ttold.ph");
      require_soft ("sys/ioctl.ph");
    }
}

sub numberp ($)
{
  return (defined $_[0] && $_[0] =~ /^-?\d+$/o) ? 1 : 0;
}

sub group2gid ($)
{
  my $g = shift;
  return $g if (numberp ($g));
  my $gid = getgrnam ($g);
  return $gid if (defined $gid && numberp ($gid));
  err ($g, "no such group");
}

sub user2uid ($)
{
  my $u = shift;
  return $u if (numberp ($u));
  my $uid = getpwnam ($u);
  return $uid if (defined $uid && numberp ($uid));
  err ($u, "no such user");
}

sub background
{
  fork && exit (0);
}

sub notty
{
  # Don't allow any file descriptors, including stdin, stdout, or
  # stderr to be propagated to children.
  $^F = -1;

  # exit parent
  fork && exit (0);

  # Duped in case we've closed stderr but can't exec anything.
  my $saved_stderr = gensym;
  open ($saved_stderr, ">&STDERR");

  close (STDERR);
  close (STDOUT);
  close (STDIN);

  my $fh = gensym;
  open ($fh, "</dev/tty");
  ioctl ($fh, &TIOCNOTTY, 0);
  close ($fh);

  return $saved_stderr;
}

sub set_cwd ($)
{
  my $d = shift;
  chdir ($d) || err ("chdir", $d, $!);
}

sub set_egid ($)
{
  my $sgid = group2gid (shift);
  my $egid = $) + 0;

  $) = $sgid;
  err ($sgid, "cannot set egid", $!) if ($) == $egid && $egid != $sgid);
}

sub set_gid ($)
{
  my $sgid = group2gid (shift);
  my $rgid = $( + 0;
  my $egid = $) + 0;

  $( = $sgid;
  $) = $sgid;
  err ($sgid, "cannot set rgid", $!) if ($( == $rgid && $rgid != $sgid);
  err ($sgid, "cannot set egid", $!) if ($) == $egid && $egid != $sgid);
}

sub big_endian_p ()
{
  my $x = 1;
  my @y = unpack ("c2", pack ("i", $x));
  return ($y[0] == 1) ? 0 : 1;
}

# This function is more complex than it ought to be, all because
# perl does not export the setgroups function.  Oh, it exports the
# getgroups function by making $( and $) return multiple values (in the
# form of a space-separated string) but you cannot set the group list by
# assigning those variables.  Let's hear it for symmetry and consistency!
# In any case, there is no portable way to determine what size gid_t is, so
# we must guess.
sub set_groups ($)
{
  my @glist = sort { $a <=> $b } map { group2gid ($_) } split (/[ ,]/, shift);

  my $expected = join (" ", $(+0, reverse @glist);
  my @p = (big_endian_p() ? ("n", "N", "i") : ("v", "V", "i"));

  for my $c (@p)
    {
      err ("setgroups", $!)
        if (syscall (&SYS_setgroups, @glist+0, pack ("$c*", @glist)) == -1);
      return if ("$(" eq $expected);
    }
  err ("setgroups", "Could not determine gid_t");
}

sub set_pgrp ($)
{
  setpgrp ($$, shift) || err ("setpgrp", $!);
}

sub set_priority
{
  my $prio = shift () + 0;
  setpriority (0, 0, $prio) || err ("setpriority", $prio, $!);
}

sub set_root
{
  my $d = shift;
  chroot ($d) || err ("chroot", $d, $!);
}

sub set_euid
{
  my $suid = user2uid (shift);
  my $euid = $>;

  $> = $suid;
  err ($suid, "cannot set euid", $!) if ($> == $euid && $euid != $suid);
}

sub set_uid
{
  my $suid = user2uid (shift);
  my $ruid = $<;
  my $euid = $>;

  $< = $suid;
  $> = $suid;
  err ($suid, "cannot set ruid", $!) if ($< == $ruid && $ruid != $suid);
  err ($suid, "cannot set euid", $!) if ($> == $euid && $euid != $suid);
}

sub parse_options ()
{
  $progname = $0;
  $progname =~ s|.*/||;

  Getopt::Long::config ('bundling', 'autoabbrev', 'require_order');
  GetOptions ("h|help",          \&usage,
              "b|bg|background", \$opt_bg,
              "c|cwd=s",         \$opt_cwd,
              "d|display=s",     \$ENV{DISPLAY},
              "H|home=s",        \$ENV{HOME},
              "G|egid=s",        \$opt_egid,
              "g|gid=s",         \$opt_gid,
              "I|include=s@",    \@opt_include,
              "l|groups=s",      \$opt_groups,
              "m|umask=s",       \$opt_umask,
              "N|no-tty|notty",  \$opt_notty,
              "n|name=s",        \$opt_name,
              "P|priority=i",    \$opt_priority,
              "p|pgrp=i",        \$opt_pgrp,
              "r|root=s",        \$opt_root,
              "U|euid=s",        \$opt_euid,
              "u|uid=s",         \$opt_uid);
}

sub usage ()
{
  print "Usage: $progname {options} [command {args...}]\n
Options are:
-b, --background      Run process in background.
-c, --cwd       DIR   Run with DIR as the current working directory.
                      This directory is relative to the root directory as
                      specified by \`--root', or \`/'.
-D, --debug           Turn on interactive debugging in perl.
-d, --display   DISP  Run with DISP as the X server display.
-G, --egid      EGID  Set \`effective' group ID.
-g, --gid       GID   Set both \`real' and \`effective' group ID.
-H, --home      HOME  Set \$HOME.
-h, --help            You're looking at it.
-I, --include   DIR   Include DIR in \@INC path for perl.
                      This option may be specified multiple times to append
                      search paths to perl.
-l, --groups    GLIST Set group list to comma-separated GLIST.
-m, --umask     UMASK Set umask.
-n, --name      ARGV0 Set name of running program (argv[0]).
-N, --no-tty          Disassociate process from any tty.
                      This automatically closes stdin,
                      stdout, and stderr, and backgrounds
                      the process.
-P, --priority  NICE  Set scheduling priority to NICE (-20 to 20).
-p, --pgrp      PGRP  Set process group.
-r, --root      ROOT  Set root directory (via \`chroot' syscall) to ROOT.
-U, --euid      EUID  Set \`effective' user ID.
-u, --uid       UID   Set both \`real' and \`effective' user ID.\n";
  exit (1);
}

sub main ()
{
  parse_options ();
  usage () unless ($#ARGV >= 0);


  get_includes ();

  umask (oct ($opt_umask))     if (defined $opt_umask);
  set_gid ($opt_gid)           if (defined $opt_gid);
  set_egid ($opt_egid)         if (defined $opt_egid);
  set_groups ($opt_groups)     if (defined $opt_groups);
  set_root ($opt_root)         if (defined $opt_root);
  set_cwd ($opt_cwd)           if (defined $opt_cwd);
  set_priority ($opt_priority) if (defined $opt_priority);
  set_uid ($opt_uid)           if (defined $opt_uid);
  set_euid ($opt_euid)         if (defined $opt_euid);
  background ()                if (defined $opt_bg && !defined $opt_notty);
  set_pgrp ($opt_pgrp)         if (defined $opt_pgrp);
  my $stderr = ($opt_notty? notty () : *STDERR{IO});

  my $runprog = $ARGV[0];
  if ($opt_name)
    {
      shift   @ARGV;
      unshift @ARGV, $opt_name;
    }
  exec ($runprog @ARGV) || err ($stderr, "exec", $runprog, $!);
}

main ();

# local variables:
# mode: perl
# eval: (auto-fill-mode 1)
# end:

# with ends here