eqhmcow/README

## README
slightly-less-insecure-docker
wrapper around docker that perhaps makes it slightly less insecure

example usage:

DOCKER=/path/to/docker-wrapper
sudo $DOCKER run -it -v /etc/passwd:/etc/passwd -v /tmp:/tmp ubuntu


NOTE:
For real-world usage, users must not have full sudo rights. They should only be
able to use sudo to run this wrapper script (or another script that eventually
calls this one)

Users should also not have access to the docker socket or be in the docker group;
otherwise they can get around the wrapper restrictions by running /usr/bin/docker directly


NOTE:
In some cases some processes do not install the usual signal handlers when they are run as pid 1.

See:
* https://github.com/moby/moby/issues/2838
* https://www.gnu.org/software/libc/manual/html_node/Termination-Signals.html
* https://unix.stackexchange.com/questions/149741/why-is-sigint-not-propagated-to-child-process-when-sent-to-its-parent-process

Using the "--init" flag with "docker run" fixes this.

See the following examples:

Example #1 where CTRL+C does not work:

$ time docker run -it alpine sleep 30
^C
real    0m31.803s
user    0m0.063s
sys     0m0.030s

In the above example the CTRL+C is ignored and the "docker run" command executes sleep for 30 seconds.
The SIGINT signal that is generated when you hit CTRL+C is:
* Generated by your TTY and sent to the "foreground process group" which in our case is the sudo process
* Passed from sudo to docker
* Passed from docker to the sleep process (running in its own pid namespace as pid 1)
* Ignored by the sleep process, since the SIGINT signal hander was not installed.


Example #2 where CTRL+C *does* work:

$ time docker run --init -it alpine sleep 30
^C
real    0m19.264s
user    0m0.071s
sys     0m0.031s

In the above example the CTRL+C is:
* Generated by your TTY and sent to the sudo process
* Passed from sudo to docker
* Passed from docker to tini (the tiny init daemon that docker runs when you use the --init flag)
* Passed from tini to the sleep process
* Sleep then exits as per the usual SIGINT handler, instead of sleeping for the full 30 seconds.

## docker_wrapper.pl
#!/usr/bin/perl
use strict;
eval { require User::getgrouplist };

# find out who am i
my $user = getlogin() || '';
die "root may simply run docker directly if you please"
  if $user eq 'root';

# if user is set, compare to environment variable sudo(8) should be setting
if ($user and $user ne $ENV{SUDO_USER}) {
  die "$user - who are you? are you not using sudo?"
}

# assume sudo is running OK and accept SUDO_USER
# if not, they don't have access to docker anyway; so this whole script would
# be a no-op
$user ||= $ENV{SUDO_USER};

my $uid = getpwnam($user) || $ENV{SUDO_UID};
my $gid = getgrnam($user) || $ENV{SUDO_GID};
my @groups;
my $bin_id;
foreach my $bin ('/usr/bin/id', '/bin/id') {
  $bin_id = $bin if -f $bin;
}
if (is_loaded('User::getgrouplist')) {
  @groups = getgrouplist($user);
} elsif ($bin_id) {
  my $g = `$bin_id -G $user`;
  @groups = split /\s+/, $g
    if $g =~ m/^(\s|\d)+$/;
}
undef @groups if $user eq 'nobody';
die "$user - your uid ($uid) is not numeric"
  unless $uid =~ m/^\d+$/;
die "$user - your uid ($uid) is too low"
  if $uid < 500;

use warnings;
use Getopt::Long;
Getopt::Long::Configure ("bundling");

my $DOCKER = "/usr/bin/docker";

# dispatch to command
my $command = shift @ARGV || '';
my @commands = qw/run exec ps info stop diff logs kill images rm rmi
    inspect version commit cp export history load pull push restart
    save tag wait --help -v --version/;

# NOTE: commands NOT currently whitelisted as they are perhaps unsafe:
# start
# attach

# FIXME: future work:
# those commands could be whitelisted if we're sure the container being started
# or attached to is safe (e.g. does not immediately grant root privs). we could
# use docker label metadata to so whitelist containers automatically.

# for now users can come to admins to request help if they need to troubleshoot
# their container (in production; users can always do their own debugging in
# their own dev environment).

die "command must be one of: " . join( " ", @commands )
  unless grep $_ eq $command, @commands;

if ($command =~ m/^-/) {
  exec($DOCKER, $command) or die "couldn't exec docker: $!";
}

my (@strings, @lists, %flags, %strings, %lists);
{
    no strict 'refs';
    &{ "docker_" . $command }();
}

# should never get here
exit 1;

sub _get_opt
{
    foreach (@strings) {
        $strings{$_} = '';
    }
    foreach (@lists) {
        $lists{$_} = [];
    }

    # we have to pre-parse ARGV because if the command takes an image /
    # container / other id, anything after that argument should not be parsed
    # as an option, but instead passed to the docker daemon.

    # create list of valid options
    my %o = @_;
    my (@o, %p, $p);
    foreach (keys %o) {
      $p = 0;
      $p = 1 if m/[=:].$/;
      s/[=:].$//;
      foreach (split m/\|/) {
        push @o, $_;
        $p{$_} = $p;
      }
    }

    # only push valid options into @ARGV for GetOpt parsing
    my @argv = splice @ARGV;
    $p = 0;
    while ($_ = shift @argv) {
      if ($_ =~ m/^--?read-only$/) {
        unshift @argv, 'true';
      }
      push @ARGV, $_;
      last if $_ eq '--';
      last if not $p and not m/^-/;
      s/^--?//;
      $p = $p{$_};
    }
    GetOptions(@_) or die "invalid arguments";
    # restore full ARGV to pass to docker later
    push @ARGV, @argv;

    # user can be nobody or the current user or uid;
    # otherwise cannot be specified
    my $u = delete $strings{user} || '';
    $u =~ s/^=//;
    return unless $u;
    if ($u eq 'nobody') {
        $uid = "nobody:nogroup";
        return;
    }
    $u =~ s/:.*$//;
    return if ($u =~ m/^\d+$/ and $u == $uid);
    return if ($u eq $user);
    die "you cannot specify a user argument";
}

sub _build_cmd
{
    my $docker_cmd = shift;

    # add flags
    foreach ( keys %flags ) {
        next unless $flags{$_};
        my $flag = $_;
        $flag =~ s/_/-/;
        $docker_cmd .= " --$flag ";
    }
    my @docker_cmd = split( m/\s+/, $docker_cmd );

    # add strings
    foreach ( keys %strings ) {
        my $s = $strings{$_};
        next unless length($s);
        my $flag = $_;
        $flag =~ s/_/-/;
        push @docker_cmd, "--$flag=$s";
    }

    # add lists
    foreach my $list ( keys %lists ) {
        foreach ( @{ $lists{$list} } ) {
            push @docker_cmd, "--$list=$_";
        }
    }

    return @docker_cmd;
}


# pass white-listed arguments to docker run
sub docker_run
{
    @strings = qw/
      cgroup_parent cidfile cpu_shares cpus detach_keys entrypoint env_file
      hostname log_driver memory name network restart shm_size sig_proxy user
      workdir
    /;
    @lists = qw/attach env label volume/;
    _get_opt(
        "d|detach"        => \$flags{detach},
        "help"            => \$flags{help},
        "i|interactive"   => \$flags{interactive},
        "init"            => \$flags{init},
        "read-only:s"     => sub {
            $flags{read_only} = 1 unless $_[1] =~ m/^false$/i
        },
        "rm"              => \$flags{rm},
        "t|tty"           => \$flags{tty},
        "cgroup-parent=s" => \$strings{cgroup_parent},
        "cidfile=s"       => \$strings{cidfile},
        "c|cpu-shares=s"  => \$strings{cpu_shares},
        "cpus=s"          => \$strings{cpus},
        "detach-keys=s"   => \$strings{detach_keys},
        "entrypoint=s"    => \$strings{entrypoint},
        "env-file=s"      => \$strings{env_file},
        "hostname=s"      => \$strings{hostname},
        "log-driver=s"    => \$strings{log_driver},
        "m|memory=s"      => \$strings{memory},
        "name=s"          => \$strings{name},
        "net|network=s"   => \$strings{network},
        "restart=s"       => \$strings{restart},
        "shm-size=s"      => \$strings{shm_size},
        "sig-proxy=s"     => \$strings{sig_proxy},
        "u|user=s"        => \$strings{user},
        "w|workdir=s"     => \$strings{workdir},
        "a|attach=s"      => $lists{attach},
        "e|env=s"         => $lists{env},
        "l|label=s"       => $lists{label},
        "v|volume=s"      => $lists{volume},
    );
    my $docker_image = shift @ARGV;

    # docker image argument can't start with "-"
    die "you must specify a valid docker image"
      unless $docker_image and $docker_image !~ m/^\s*-/;

    # network defaults to host
    $strings{network} ||= "host";

    # add additional group ids
    my $group_ids = '';
    foreach my $g (@groups) {
      $group_ids .= " --group-add $g ";
    }

    # execute run command -- user is mandatory (cannot be root; can be nobody)
    # docker accepts no options for itself after the image is specified; so
    # passing thru parsed @ARGV in case the user specifies an image command
    # (and optionally that command's arguments) should be safe
    exec( _build_cmd(qq{$DOCKER run
        --cap-drop=ALL
        --security-opt=no-new-privileges
        -u $uid:$gid
        $group_ids
    }), $docker_image, @ARGV ) or die "couldn't exec docker: $!";
}


# pass white-listed arguments to docker start
# NOTE: docker start is not safe - users can restart stopped "admin"
# containers if any exist on the host
# docker start is NOT whitelisted above
sub docker_start
{
    @strings = qw/detach_keys/;
    _get_opt(
        "a|attach"      => \$flags{attach},
        "i|interactive" => \$flags{interactive},
        "detach-keys=s" => \$strings{detach_keys},
    );
    my $docker_container = shift @ARGV;

    # docker container argument can't start with "-"
    die "you must specify a valid docker container"
      unless $docker_container and $docker_container !~ m/^\s*-/;

    # execute start command
    exec( _build_cmd(qq{$DOCKER start}), $docker_container, @ARGV )
         or die "couldn't exec docker: $!";
}


# pass white-listed arguments to docker attach
# NOTE: docker attach is not safe - users can attach to "admin"
# containers if any exist on the host
# docker attach is NOT whitelisted above
sub docker_attach
{
    @strings = qw/detach_keys sig_proxy/;
    _get_opt(
        "no-stdin"      => \$flags{no_stdin},
        "detach-keys=s" => \$strings{detach_keys},
        "sig-proxy=s"   => \$strings{sig_proxy},
    );
    my $docker_container = shift @ARGV;

    # docker container argument can't start with "-"
    die "you must specify a valid docker container"
      unless $docker_container and $docker_container !~ m/^\s*-/;

    # execute attach command
    exec( _build_cmd(qq{$DOCKER attach}), $docker_container, @ARGV )
         or die "couldn't exec docker: $!";
}


# pass white-listed arguments to docker exec
sub docker_exec
{
    @strings = qw/detach_keys user/;
    @lists = qw/env/;
    _get_opt(
        "d|detach"      => \$flags{detach},
        "i|interactive" => \$flags{interactive},
        "t|tty"         => \$flags{tty},
        "detach-keys=s" => \$strings{detach_keys},
        "u|user=s"      => \$strings{user},
        "e|env=s"       => $lists{env},
    );
    my $docker_container = shift @ARGV;

    # docker container argument can't start with "-"
    die "you must specify a valid docker container"
      unless $docker_container and $docker_container !~ m/^\s*-/;

    # execute exec command -- user is mandatory (cannot be root; can be nobody)
    # docker accepts no options for itself after the container is specified; so
    # passing thru parsed @ARGV in case the user specifies a command
    # (and optionally that command's arguments) should be safe
    exec( _build_cmd(qq{$DOCKER exec
        -u $uid:$gid
    }), $docker_container, @ARGV ) or die "couldn't exec docker: $!";
}


# pass white-listed arguments to docker stop
sub docker_stop
{
    @strings = qw/time/;
    _get_opt(
        "t|time=s" => \$strings{time},
    );
    my $docker_container = shift @ARGV;

    # docker container argument can't start with "-"
    die "you must specify a valid docker container"
      unless $docker_container and $docker_container !~ m/^\s*-/;

    # execute stop command
    exec( _build_cmd(qq{$DOCKER stop}), $docker_container, @ARGV )
        or die "couldn't exec docker: $!";
}


# pass white-listed arguments to docker diff
sub docker_diff
{
    # docker container argument can't start with "-"
    my $docker_container = shift @ARGV;
    die "you must specify a valid docker container"
      unless $docker_container and $docker_container !~ m/^\s*-/;

    # execute diff command
    exec( _build_cmd(qq{$DOCKER diff}), $docker_container )
         or die "couldn't exec docker: $!";
}


# pass white-listed arguments to docker info
sub docker_info
{
    @strings = qw/format/;
    _get_opt(
        "f|format=s" => \$strings{format},
    );

    # execute info command
    exec( _build_cmd(qq{$DOCKER info}) )
         or die "couldn't exec docker: $!";
}


# pass white-listed arguments to docker version
sub docker_version
{
    @strings = qw/format/;
    _get_opt(
        "f|format=s" => \$strings{format},
    );

    # execute version command
    exec( _build_cmd(qq{$DOCKER version}) )
        or die "couldn't exec docker: $!";
}


# pass white-listed arguments to docker ps
sub docker_ps
{
    @strings = qw/format last/;
    @lists = qw/filter/;
    _get_opt(
        "a|all"         => \$flags{all},
        "l|latest"      => \$flags{latest},
        "no-trunc"      => \$flags{no_trunc},
        "q|quiet"       => \$flags{quiet},
        "s|size"        => \$flags{size},
        "format=s"      => \$strings{format},
        "n|last=s"      => \$strings{last},
        "f|filter=s"    => $lists{filter},
    );

    # execute ps command
    exec( _build_cmd(qq{$DOCKER ps}) )
         or die "couldn't exec docker: $!";
}


# pass white-listed arguments to docker logs
sub docker_logs
{
    @strings = qw/since tail/;
    _get_opt(
        "details"      => \$flags{details},
        "f|follow"     => \$flags{follow},
        "t|timestamps" => \$flags{timestamps},
        "since=s"      => \$strings{since},
        "tail=s"       => \$strings{tail},
    );
    my $docker_container = shift @ARGV;

    # docker container argument can't start with "-"
    die "you must specify a valid docker container"
      unless $docker_container and $docker_container !~ m/^\s*-/;

    # execute logs command
    exec( _build_cmd(qq{$DOCKER logs}), $docker_container )
         or die "couldn't exec docker: $!";
}


# pass white-listed arguments to docker kill
sub docker_kill
{
    @strings = qw/signal/;
    _get_opt(
        "s|signal=s" => \$strings{signal},
    );
    my $docker_container = shift @ARGV;

    # docker container argument can't start with "-"
    die "you must specify a valid docker container"
      unless $docker_container and $docker_container !~ m/^\s*-/;

    # execute kill command
    exec( _build_cmd(qq{$DOCKER kill}), $docker_container, @ARGV )
         or die "couldn't exec docker: $!";
}


# pass white-listed arguments to docker images
sub docker_images
{
    @strings = qw/format/;
    @lists = qw/filter/;
    _get_opt(
        "a|all"         => \$flags{all},
        "digests"       => \$flags{digests},
        "no-trunc"      => \$flags{no_trunc},
        "q|quiet"       => \$flags{quiet},
        "format=s"      => \$strings{format},
        "f|filter=s"    => $lists{filter},
    );
    my $docker_repository = shift @ARGV;
    $docker_repository ||= '';

    # docker repository argument can't start with "-"
    die "you must specify a valid docker repository"
      if $docker_repository and $docker_repository =~ m/^\s*-/;

    # execute images command
    exec( _build_cmd(qq{$DOCKER images}), $docker_repository )
         or die "couldn't exec docker: $!";
}


# pass white-listed arguments to docker rm
sub docker_rm
{
    _get_opt(
        "f|force"   => \$flags{force},
        "v|volumes" => \$flags{volumes},
    );
    my $docker_container = shift @ARGV;

    # docker container argument can't start with "-"
    die "you must specify a valid docker container"
      unless $docker_container and $docker_container !~ m/^\s*-/;

    # execute rm command
    exec( _build_cmd(qq{$DOCKER rm}), $docker_container, @ARGV )
         or die "couldn't exec docker: $!";
}


# pass white-listed arguments to docker rmi
sub docker_rmi
{
    _get_opt(
        "f|force"  => \$flags{force},
        "no-prune" => \$flags{no_prune},
    );
    my $docker_image = shift @ARGV;

    # docker image argument can't start with "-"
    die "you must specify a valid docker image"
      unless $docker_image and $docker_image !~ m/^\s*-/;

    # execute rmi command
    exec( _build_cmd(qq{$DOCKER rmi}), $docker_image, @ARGV )
         or die "couldn't exec docker: $!";
}


# pass white-listed arguments to docker inspect
sub docker_inspect
{
    @strings = qw/format type/;
    _get_opt(
        "s|size"     => \$flags{size},
        "f|format=s" => \$strings{format},
        "type=s"     => \$strings{type},
    );
    my $docker_id = shift @ARGV;

    # docker id argument can't start with "-"
    die "you must specify a valid docker id"
      unless $docker_id and $docker_id !~ m/^\s*-/;

    # execute inspect command
    exec( _build_cmd(qq{$DOCKER inspect}), $docker_id, @ARGV )
         or die "couldn't exec docker: $!";
}


# pass white-listed arguments to docker commit
sub docker_commit
{
    @strings = qw/author message pause/;
    @lists = qw/change/;
    _get_opt(
        "a|author=s"  => \$strings{author},
        "m|message=s" => \$strings{message},
        "p|pause=s"   => \$strings{pause},
        "c|change=s"  => $lists{change},
    );
    my $docker_container = shift @ARGV;

    # docker container argument can't start with "-"
    die "you must specify a valid docker container"
      unless $docker_container and $docker_container !~ m/^\s*-/;

    # execute commit command
    exec( _build_cmd(qq{$DOCKER commit}), $docker_container, @ARGV )
         or die "couldn't exec docker: $!";
}


# pass white-listed arguments to docker cp
sub docker_cp
{
    _get_opt(
        "a|archive"     => \$flags{archive},
        "L|follow-link" => \$flags{follow_link},
    );
    my $docker_container = shift @ARGV;

    # docker container argument can't start with "-" unless it's entirely "-"
    die "you must specify a valid docker container or src_patch"
      if (not $docker_container) or ($docker_container =~ m/^\s*-\S/);

    # execute cp command
    exec( _build_cmd(qq{$DOCKER cp}), $docker_container, @ARGV )
         or die "couldn't exec docker: $!";
}


# pass white-listed arguments to docker export
sub docker_export
{
    @strings = qw/output/;
    _get_opt(
        "o|output=s" => \$strings{output},
    );
    my $docker_container = shift @ARGV;

    # docker container argument can't start with "-"
    die "you must specify a valid docker container"
      unless $docker_container and $docker_container !~ m/^\s*-/;

    # execute export command
    exec( _build_cmd(qq{$DOCKER export}), $docker_container )
         or die "couldn't exec docker: $!";
}


# pass white-listed arguments to docker history
sub docker_history
{
    @strings = qw/format human/;
    _get_opt(
        "no-trunc"  => \$flags{no_trunc},
        "q|quiet"   => \$flags{quiet},
        "format=s"  => \$strings{format},
        "H|human=s" => \$strings{human},
    );
    my $docker_image = shift @ARGV;

    # docker image argument can't start with "-"
    die "you must specify a valid docker image"
      unless $docker_image and $docker_image !~ m/^\s*-/;

    # execute history command
    exec( _build_cmd(qq{$DOCKER history}), $docker_image )
         or die "couldn't exec docker: $!";
}


# pass white-listed arguments to docker load
sub docker_load
{
    @strings = qw/input/;
    _get_opt(
        "q|quiet"   => \$flags{quiet},
        "i|input=s" => \$strings{input},
    );

    # execute load command
    exec( _build_cmd(qq{$DOCKER load}) )
         or die "couldn't exec docker: $!";
}


# pass white-listed arguments to docker pull
sub docker_pull
{
    @strings = qw/disable_content_trust/;
    _get_opt(
        "a|all-tags"            => \$flags{all_tags},
        "disable-content-trust" => \$strings{disable_content_trust},
    );
    my $docker_name = shift @ARGV;

    # docker name argument can't start with "-"
    die "you must specify a valid docker name"
      unless $docker_name and $docker_name !~ m/^\s*-/;

    # execute pull command
    exec( _build_cmd(qq{$DOCKER pull}), $docker_name )
         or die "couldn't exec docker: $!";
}


# pass white-listed arguments to docker push
sub docker_push
{
    @strings = qw/disable_content_trust/;
    _get_opt(
        "disable-content-trust" => \$strings{disable_content_trust},
    );
    my $docker_name = shift @ARGV;

    # docker name argument can't start with "-"
    die "you must specify a valid docker name"
      unless $docker_name and $docker_name !~ m/^\s*-/;

    # execute push command
    exec( _build_cmd(qq{$DOCKER push}), $docker_name )
         or die "couldn't exec docker: $!";
}


# pass white-listed arguments to docker restart
sub docker_restart
{
    @strings = qw/time/;
    _get_opt(
        "t|time=s" => \$strings{time},
    );
    my $docker_container = shift @ARGV;

    # docker container argument can't start with "-"
    die "you must specify a valid docker container"
      unless $docker_container and $docker_container !~ m/^\s*-/;

    # execute restart command
    exec( _build_cmd(qq{$DOCKER restart}), $docker_container, @ARGV )
         or die "couldn't exec docker: $!";
}


# pass white-listed arguments to docker save
sub docker_save
{
    @strings = qw/output/;
    _get_opt(
        "o|output=s"  => \$strings{output},
    );
    my $docker_image = shift @ARGV;

    # docker image argument can't start with "-"
    die "you must specify a valid docker image"
      unless $docker_image and $docker_image !~ m/^\s*-/;

    # execute save command
    exec( _build_cmd(qq{$DOCKER save}), $docker_image, @ARGV )
         or die "couldn't exec docker: $!";
}


# pass white-listed arguments to docker tag
sub docker_tag
{
    my $docker_image = shift @ARGV;

    # docker image argument can't start with "-"
    die "you must specify a valid docker image"
      unless $docker_image and $docker_image !~ m/^\s*-/;

    # execute tag command
    exec( _build_cmd(qq{$DOCKER tag}), $docker_image, @ARGV )
         or die "couldn't exec docker: $!";
}


# pass white-listed arguments to docker wait
sub docker_wait
{
    my $docker_container = shift @ARGV;

    # docker container argument can't start with "-"
    die "you must specify a valid docker container"
      unless $docker_container and $docker_container !~ m/^\s*-/;

    # execute wait command
    exec( _build_cmd(qq{$DOCKER wait}), $docker_container, @ARGV )
         or die "couldn't exec docker: $!";
}

# perl 5.8 compat - Module::Loaded not in core until 5.10
sub is_loaded () {
    my $pm      = shift;
    my $file    = _pm_to_file( $pm ) or return;

    return $INC{$file} if exists $INC{$file};

    return;
}

sub _pm_to_file {
    my $pm  = shift or return;

    my $file = join '/', split '::', $pm;
    $file .= '.pm';

    return $file;
}
	slightly-less-insecure-docker
	wrapper around docker that perhaps makes it slightly less insecure

	example usage:

	DOCKER=/path/to/docker-wrapper
	sudo $DOCKER run -it -v /etc/passwd:/etc/passwd -v /tmp:/tmp ubuntu


	NOTE:
	For real-world usage, users must not have full sudo rights. They should only be
	able to use sudo to run this wrapper script (or another script that eventually
	calls this one)

	Users should also not have access to the docker socket or be in the docker group;
	otherwise they can get around the wrapper restrictions by running /usr/bin/docker directly


	NOTE:
	In some cases some processes do not install the usual signal handlers when they are run as pid 1.

	See:
	* https://github.com/moby/moby/issues/2838
	* https://www.gnu.org/software/libc/manual/html_node/Termination-Signals.html
	* https://unix.stackexchange.com/questions/149741/why-is-sigint-not-propagated-to-child-process-when-sent-to-its-parent-process

	Using the "--init" flag with "docker run" fixes this.

	See the following examples:

	Example #1 where CTRL+C does not work:

	$ time docker run -it alpine sleep 30
	^C
	real 0m31.803s
	user 0m0.063s
	sys 0m0.030s

	In the above example the CTRL+C is ignored and the "docker run" command executes sleep for 30 seconds.
	The SIGINT signal that is generated when you hit CTRL+C is:
	* Generated by your TTY and sent to the "foreground process group" which in our case is the sudo process
	* Passed from sudo to docker
	* Passed from docker to the sleep process (running in its own pid namespace as pid 1)
	* Ignored by the sleep process, since the SIGINT signal hander was not installed.


	Example #2 where CTRL+C does work:

	$ time docker run --init -it alpine sleep 30
	^C
	real 0m19.264s
	user 0m0.071s
	sys 0m0.031s

	In the above example the CTRL+C is:
	* Generated by your TTY and sent to the sudo process
	* Passed from sudo to docker
	* Passed from docker to tini (the tiny init daemon that docker runs when you use the --init flag)
	* Passed from tini to the sleep process
	* Sleep then exits as per the usual SIGINT handler, instead of sleeping for the full 30 seconds.
	#!/usr/bin/perl
	use strict;
	eval { require User::getgrouplist };

	# find out who am i
	my $user = getlogin() \|\| '';
	die "root may simply run docker directly if you please"
	if $user eq 'root';

	# if user is set, compare to environment variable sudo(8) should be setting
	if ($user and $user ne $ENV{SUDO_USER}) {
	die "$user - who are you? are you not using sudo?"
	}

	# assume sudo is running OK and accept SUDO_USER
	# if not, they don't have access to docker anyway; so this whole script would
	# be a no-op
	$user \|\|= $ENV{SUDO_USER};

	my $uid = getpwnam($user) \|\| $ENV{SUDO_UID};
	my $gid = getgrnam($user) \|\| $ENV{SUDO_GID};
	my @groups;
	my $bin_id;
	foreach my $bin ('/usr/bin/id', '/bin/id') {
	$bin_id = $bin if -f $bin;
	}
	if (is_loaded('User::getgrouplist')) {
	@groups = getgrouplist($user);
	} elsif ($bin_id) {
	my $g = `$bin_id -G $user`;
	@groups = split /\s+/, $g
	if $g =~ m/^(\s\|\d)+$/;
	}
	undef @groups if $user eq 'nobody';
	die "$user - your uid ($uid) is not numeric"
	unless $uid =~ m/^\d+$/;
	die "$user - your uid ($uid) is too low"
	if $uid < 500;

	use warnings;
	use Getopt::Long;
	Getopt::Long::Configure ("bundling");

	my $DOCKER = "/usr/bin/docker";

	# dispatch to command
	my $command = shift @ARGV \|\| '';
	my @commands = qw/run exec ps info stop diff logs kill images rm rmi
	inspect version commit cp export history load pull push restart
	save tag wait --help -v --version/;

	# NOTE: commands NOT currently whitelisted as they are perhaps unsafe:
	# start
	# attach

	# FIXME: future work:
	# those commands could be whitelisted if we're sure the container being started
	# or attached to is safe (e.g. does not immediately grant root privs). we could
	# use docker label metadata to so whitelist containers automatically.

	# for now users can come to admins to request help if they need to troubleshoot
	# their container (in production; users can always do their own debugging in
	# their own dev environment).

	die "command must be one of: " . join( " ", @commands )
	unless grep $_ eq $command, @commands;

	if ($command =~ m/^-/) {
	exec($DOCKER, $command) or die "couldn't exec docker: $!";
	}

	my (@strings, @lists, %flags, %strings, %lists);
	{
	no strict 'refs';
	&{ "docker_" . $command }();
	}

	# should never get here
	exit 1;

	sub _get_opt
	{
	foreach (@strings) {
	$strings{$_} = '';
	}
	foreach (@lists) {
	$lists{$_} = [];
	}

	# we have to pre-parse ARGV because if the command takes an image /
	# container / other id, anything after that argument should not be parsed
	# as an option, but instead passed to the docker daemon.

	# create list of valid options
	my %o = @_;
	my (@o, %p, $p);
	foreach (keys %o) {
	$p = 0;
	$p = 1 if m/[=:].$/;
	s/[=:].$//;
	foreach (split m/\\|/) {
	push @o, $_;
	$p{$_} = $p;
	}
	}

	# only push valid options into @ARGV for GetOpt parsing
	my @argv = splice @ARGV;
	$p = 0;
	while ($_ = shift @argv) {
	if ($_ =~ m/^--?read-only$/) {
	unshift @argv, 'true';
	}
	push @ARGV, $_;
	last if $_ eq '--';
	last if not $p and not m/^-/;
	s/^--?//;
	$p = $p{$_};
	}
	GetOptions(@_) or die "invalid arguments";
	# restore full ARGV to pass to docker later
	push @ARGV, @argv;

	# user can be nobody or the current user or uid;
	# otherwise cannot be specified
	my $u = delete $strings{user} \|\| '';
	$u =~ s/^=//;
	return unless $u;
	if ($u eq 'nobody') {
	$uid = "nobody:nogroup";
	return;
	}
	$u =~ s/:.*$//;
	return if ($u =~ m/^\d+$/ and $u == $uid);
	return if ($u eq $user);
	die "you cannot specify a user argument";
	}

	sub _build_cmd
	{
	my $docker_cmd = shift;

	# add flags
	foreach ( keys %flags ) {
	next unless $flags{$_};
	my $flag = $_;
	$flag =~ s/_/-/;
	$docker_cmd .= " --$flag ";
	}
	my @docker_cmd = split( m/\s+/, $docker_cmd );

	# add strings
	foreach ( keys %strings ) {
	my $s = $strings{$_};
	next unless length($s);
	my $flag = $_;
	$flag =~ s/_/-/;
	push @docker_cmd, "--$flag=$s";
	}

	# add lists
	foreach my $list ( keys %lists ) {
	foreach ( @{ $lists{$list} } ) {
	push @docker_cmd, "--$list=$_";
	}
	}

	return @docker_cmd;
	}


	# pass white-listed arguments to docker run
	sub docker_run
	{
	@strings = qw/
	cgroup_parent cidfile cpu_shares cpus detach_keys entrypoint env_file
	hostname log_driver memory name network restart shm_size sig_proxy user
	workdir
	/;
	@lists = qw/attach env label volume/;
	_get_opt(
	"d\|detach" => \$flags{detach},
	"help" => \$flags{help},
	"i\|interactive" => \$flags{interactive},
	"init" => \$flags{init},
	"read-only:s" => sub {
	$flags{read_only} = 1 unless $_[1] =~ m/^false$/i
	},
	"rm" => \$flags{rm},
	"t\|tty" => \$flags{tty},
	"cgroup-parent=s" => \$strings{cgroup_parent},
	"cidfile=s" => \$strings{cidfile},
	"c\|cpu-shares=s" => \$strings{cpu_shares},
	"cpus=s" => \$strings{cpus},
	"detach-keys=s" => \$strings{detach_keys},
	"entrypoint=s" => \$strings{entrypoint},
	"env-file=s" => \$strings{env_file},
	"hostname=s" => \$strings{hostname},
	"log-driver=s" => \$strings{log_driver},
	"m\|memory=s" => \$strings{memory},
	"name=s" => \$strings{name},
	"net\|network=s" => \$strings{network},
	"restart=s" => \$strings{restart},
	"shm-size=s" => \$strings{shm_size},
	"sig-proxy=s" => \$strings{sig_proxy},
	"u\|user=s" => \$strings{user},
	"w\|workdir=s" => \$strings{workdir},
	"a\|attach=s" => $lists{attach},
	"e\|env=s" => $lists{env},
	"l\|label=s" => $lists{label},
	"v\|volume=s" => $lists{volume},
	);
	my $docker_image = shift @ARGV;

	# docker image argument can't start with "-"
	die "you must specify a valid docker image"
	unless $docker_image and $docker_image !~ m/^\s*-/;

	# network defaults to host
	$strings{network} \|\|= "host";

	# add additional group ids
	my $group_ids = '';
	foreach my $g (@groups) {
	$group_ids .= " --group-add $g ";
	}

	# execute run command -- user is mandatory (cannot be root; can be nobody)
	# docker accepts no options for itself after the image is specified; so
	# passing thru parsed @ARGV in case the user specifies an image command
	# (and optionally that command's arguments) should be safe
	exec( _build_cmd(qq{$DOCKER run
	--cap-drop=ALL
	--security-opt=no-new-privileges
	-u $uid:$gid
	$group_ids
	}), $docker_image, @ARGV ) or die "couldn't exec docker: $!";
	}


	# pass white-listed arguments to docker start
	# NOTE: docker start is not safe - users can restart stopped "admin"
	# containers if any exist on the host
	# docker start is NOT whitelisted above
	sub docker_start
	{
	@strings = qw/detach_keys/;
	_get_opt(
	"a\|attach" => \$flags{attach},
	"i\|interactive" => \$flags{interactive},
	"detach-keys=s" => \$strings{detach_keys},
	);
	my $docker_container = shift @ARGV;

	# docker container argument can't start with "-"
	die "you must specify a valid docker container"
	unless $docker_container and $docker_container !~ m/^\s*-/;

	# execute start command
	exec( _build_cmd(qq{$DOCKER start}), $docker_container, @ARGV )
	or die "couldn't exec docker: $!";
	}


	# pass white-listed arguments to docker attach
	# NOTE: docker attach is not safe - users can attach to "admin"
	# containers if any exist on the host
	# docker attach is NOT whitelisted above
	sub docker_attach
	{
	@strings = qw/detach_keys sig_proxy/;
	_get_opt(
	"no-stdin" => \$flags{no_stdin},
	"detach-keys=s" => \$strings{detach_keys},
	"sig-proxy=s" => \$strings{sig_proxy},
	);
	my $docker_container = shift @ARGV;

	# docker container argument can't start with "-"
	die "you must specify a valid docker container"
	unless $docker_container and $docker_container !~ m/^\s*-/;

	# execute attach command
	exec( _build_cmd(qq{$DOCKER attach}), $docker_container, @ARGV )
	or die "couldn't exec docker: $!";
	}


	# pass white-listed arguments to docker exec
	sub docker_exec
	{
	@strings = qw/detach_keys user/;
	@lists = qw/env/;
	_get_opt(
	"d\|detach" => \$flags{detach},
	"i\|interactive" => \$flags{interactive},
	"t\|tty" => \$flags{tty},
	"detach-keys=s" => \$strings{detach_keys},
	"u\|user=s" => \$strings{user},
	"e\|env=s" => $lists{env},
	);
	my $docker_container = shift @ARGV;

	# docker container argument can't start with "-"
	die "you must specify a valid docker container"
	unless $docker_container and $docker_container !~ m/^\s*-/;

	# execute exec command -- user is mandatory (cannot be root; can be nobody)
	# docker accepts no options for itself after the container is specified; so
	# passing thru parsed @ARGV in case the user specifies a command
	# (and optionally that command's arguments) should be safe
	exec( _build_cmd(qq{$DOCKER exec
	-u $uid:$gid
	}), $docker_container, @ARGV ) or die "couldn't exec docker: $!";
	}


	# pass white-listed arguments to docker stop
	sub docker_stop
	{
	@strings = qw/time/;
	_get_opt(
	"t\|time=s" => \$strings{time},
	);
	my $docker_container = shift @ARGV;

	# docker container argument can't start with "-"
	die "you must specify a valid docker container"
	unless $docker_container and $docker_container !~ m/^\s*-/;

	# execute stop command
	exec( _build_cmd(qq{$DOCKER stop}), $docker_container, @ARGV )
	or die "couldn't exec docker: $!";
	}


	# pass white-listed arguments to docker diff
	sub docker_diff
	{
	# docker container argument can't start with "-"
	my $docker_container = shift @ARGV;
	die "you must specify a valid docker container"
	unless $docker_container and $docker_container !~ m/^\s*-/;

	# execute diff command
	exec( _build_cmd(qq{$DOCKER diff}), $docker_container )
	or die "couldn't exec docker: $!";
	}


	# pass white-listed arguments to docker info
	sub docker_info
	{
	@strings = qw/format/;
	_get_opt(
	"f\|format=s" => \$strings{format},
	);

	# execute info command
	exec( _build_cmd(qq{$DOCKER info}) )
	or die "couldn't exec docker: $!";
	}


	# pass white-listed arguments to docker version
	sub docker_version
	{
	@strings = qw/format/;
	_get_opt(
	"f\|format=s" => \$strings{format},
	);

	# execute version command
	exec( _build_cmd(qq{$DOCKER version}) )
	or die "couldn't exec docker: $!";
	}


	# pass white-listed arguments to docker ps
	sub docker_ps
	{
	@strings = qw/format last/;
	@lists = qw/filter/;
	_get_opt(
	"a\|all" => \$flags{all},
	"l\|latest" => \$flags{latest},
	"no-trunc" => \$flags{no_trunc},
	"q\|quiet" => \$flags{quiet},
	"s\|size" => \$flags{size},
	"format=s" => \$strings{format},
	"n\|last=s" => \$strings{last},
	"f\|filter=s" => $lists{filter},
	);

	# execute ps command
	exec( _build_cmd(qq{$DOCKER ps}) )
	or die "couldn't exec docker: $!";
	}


	# pass white-listed arguments to docker logs
	sub docker_logs
	{
	@strings = qw/since tail/;
	_get_opt(
	"details" => \$flags{details},
	"f\|follow" => \$flags{follow},
	"t\|timestamps" => \$flags{timestamps},
	"since=s" => \$strings{since},
	"tail=s" => \$strings{tail},
	);
	my $docker_container = shift @ARGV;

	# docker container argument can't start with "-"
	die "you must specify a valid docker container"
	unless $docker_container and $docker_container !~ m/^\s*-/;

	# execute logs command
	exec( _build_cmd(qq{$DOCKER logs}), $docker_container )
	or die "couldn't exec docker: $!";
	}


	# pass white-listed arguments to docker kill
	sub docker_kill
	{
	@strings = qw/signal/;
	_get_opt(
	"s\|signal=s" => \$strings{signal},
	);
	my $docker_container = shift @ARGV;

	# docker container argument can't start with "-"
	die "you must specify a valid docker container"
	unless $docker_container and $docker_container !~ m/^\s*-/;

	# execute kill command
	exec( _build_cmd(qq{$DOCKER kill}), $docker_container, @ARGV )
	or die "couldn't exec docker: $!";
	}


	# pass white-listed arguments to docker images
	sub docker_images
	{
	@strings = qw/format/;
	@lists = qw/filter/;
	_get_opt(
	"a\|all" => \$flags{all},
	"digests" => \$flags{digests},
	"no-trunc" => \$flags{no_trunc},
	"q\|quiet" => \$flags{quiet},
	"format=s" => \$strings{format},
	"f\|filter=s" => $lists{filter},
	);
	my $docker_repository = shift @ARGV;
	$docker_repository \|\|= '';

	# docker repository argument can't start with "-"
	die "you must specify a valid docker repository"
	if $docker_repository and $docker_repository =~ m/^\s*-/;

	# execute images command
	exec( _build_cmd(qq{$DOCKER images}), $docker_repository )
	or die "couldn't exec docker: $!";
	}


	# pass white-listed arguments to docker rm
	sub docker_rm
	{
	_get_opt(
	"f\|force" => \$flags{force},
	"v\|volumes" => \$flags{volumes},
	);
	my $docker_container = shift @ARGV;

	# docker container argument can't start with "-"
	die "you must specify a valid docker container"
	unless $docker_container and $docker_container !~ m/^\s*-/;

	# execute rm command
	exec( _build_cmd(qq{$DOCKER rm}), $docker_container, @ARGV )
	or die "couldn't exec docker: $!";
	}


	# pass white-listed arguments to docker rmi
	sub docker_rmi
	{
	_get_opt(
	"f\|force" => \$flags{force},
	"no-prune" => \$flags{no_prune},
	);
	my $docker_image = shift @ARGV;

	# docker image argument can't start with "-"
	die "you must specify a valid docker image"
	unless $docker_image and $docker_image !~ m/^\s*-/;

	# execute rmi command
	exec( _build_cmd(qq{$DOCKER rmi}), $docker_image, @ARGV )
	or die "couldn't exec docker: $!";
	}


	# pass white-listed arguments to docker inspect
	sub docker_inspect
	{
	@strings = qw/format type/;
	_get_opt(
	"s\|size" => \$flags{size},
	"f\|format=s" => \$strings{format},
	"type=s" => \$strings{type},
	);
	my $docker_id = shift @ARGV;

	# docker id argument can't start with "-"
	die "you must specify a valid docker id"
	unless $docker_id and $docker_id !~ m/^\s*-/;

	# execute inspect command
	exec( _build_cmd(qq{$DOCKER inspect}), $docker_id, @ARGV )
	or die "couldn't exec docker: $!";
	}


	# pass white-listed arguments to docker commit
	sub docker_commit
	{
	@strings = qw/author message pause/;
	@lists = qw/change/;
	_get_opt(
	"a\|author=s" => \$strings{author},
	"m\|message=s" => \$strings{message},
	"p\|pause=s" => \$strings{pause},
	"c\|change=s" => $lists{change},
	);
	my $docker_container = shift @ARGV;

	# docker container argument can't start with "-"
	die "you must specify a valid docker container"
	unless $docker_container and $docker_container !~ m/^\s*-/;

	# execute commit command
	exec( _build_cmd(qq{$DOCKER commit}), $docker_container, @ARGV )
	or die "couldn't exec docker: $!";
	}


	# pass white-listed arguments to docker cp
	sub docker_cp
	{
	_get_opt(
	"a\|archive" => \$flags{archive},
	"L\|follow-link" => \$flags{follow_link},
	);
	my $docker_container = shift @ARGV;

	# docker container argument can't start with "-" unless it's entirely "-"
	die "you must specify a valid docker container or src_patch"
	if (not $docker_container) or ($docker_container =~ m/^\s*-\S/);

	# execute cp command
	exec( _build_cmd(qq{$DOCKER cp}), $docker_container, @ARGV )
	or die "couldn't exec docker: $!";
	}


	# pass white-listed arguments to docker export
	sub docker_export
	{
	@strings = qw/output/;
	_get_opt(
	"o\|output=s" => \$strings{output},
	);
	my $docker_container = shift @ARGV;

	# docker container argument can't start with "-"
	die "you must specify a valid docker container"
	unless $docker_container and $docker_container !~ m/^\s*-/;

	# execute export command
	exec( _build_cmd(qq{$DOCKER export}), $docker_container )
	or die "couldn't exec docker: $!";
	}


	# pass white-listed arguments to docker history
	sub docker_history
	{
	@strings = qw/format human/;
	_get_opt(
	"no-trunc" => \$flags{no_trunc},
	"q\|quiet" => \$flags{quiet},
	"format=s" => \$strings{format},
	"H\|human=s" => \$strings{human},
	);
	my $docker_image = shift @ARGV;

	# docker image argument can't start with "-"
	die "you must specify a valid docker image"
	unless $docker_image and $docker_image !~ m/^\s*-/;

	# execute history command
	exec( _build_cmd(qq{$DOCKER history}), $docker_image )
	or die "couldn't exec docker: $!";
	}


	# pass white-listed arguments to docker load
	sub docker_load
	{
	@strings = qw/input/;
	_get_opt(
	"q\|quiet" => \$flags{quiet},
	"i\|input=s" => \$strings{input},
	);

	# execute load command
	exec( _build_cmd(qq{$DOCKER load}) )
	or die "couldn't exec docker: $!";
	}


	# pass white-listed arguments to docker pull
	sub docker_pull
	{
	@strings = qw/disable_content_trust/;
	_get_opt(
	"a\|all-tags" => \$flags{all_tags},
	"disable-content-trust" => \$strings{disable_content_trust},
	);
	my $docker_name = shift @ARGV;

	# docker name argument can't start with "-"
	die "you must specify a valid docker name"
	unless $docker_name and $docker_name !~ m/^\s*-/;

	# execute pull command
	exec( _build_cmd(qq{$DOCKER pull}), $docker_name )
	or die "couldn't exec docker: $!";
	}


	# pass white-listed arguments to docker push
	sub docker_push
	{
	@strings = qw/disable_content_trust/;
	_get_opt(
	"disable-content-trust" => \$strings{disable_content_trust},
	);
	my $docker_name = shift @ARGV;

	# docker name argument can't start with "-"
	die "you must specify a valid docker name"
	unless $docker_name and $docker_name !~ m/^\s*-/;

	# execute push command
	exec( _build_cmd(qq{$DOCKER push}), $docker_name )
	or die "couldn't exec docker: $!";
	}


	# pass white-listed arguments to docker restart
	sub docker_restart
	{
	@strings = qw/time/;
	_get_opt(
	"t\|time=s" => \$strings{time},
	);
	my $docker_container = shift @ARGV;

	# docker container argument can't start with "-"
	die "you must specify a valid docker container"
	unless $docker_container and $docker_container !~ m/^\s*-/;

	# execute restart command
	exec( _build_cmd(qq{$DOCKER restart}), $docker_container, @ARGV )
	or die "couldn't exec docker: $!";
	}


	# pass white-listed arguments to docker save
	sub docker_save
	{
	@strings = qw/output/;
	_get_opt(
	"o\|output=s" => \$strings{output},
	);
	my $docker_image = shift @ARGV;

	# docker image argument can't start with "-"
	die "you must specify a valid docker image"
	unless $docker_image and $docker_image !~ m/^\s*-/;

	# execute save command
	exec( _build_cmd(qq{$DOCKER save}), $docker_image, @ARGV )
	or die "couldn't exec docker: $!";
	}


	# pass white-listed arguments to docker tag
	sub docker_tag
	{
	my $docker_image = shift @ARGV;

	# docker image argument can't start with "-"
	die "you must specify a valid docker image"
	unless $docker_image and $docker_image !~ m/^\s*-/;

	# execute tag command
	exec( _build_cmd(qq{$DOCKER tag}), $docker_image, @ARGV )
	or die "couldn't exec docker: $!";
	}


	# pass white-listed arguments to docker wait
	sub docker_wait
	{
	my $docker_container = shift @ARGV;

	# docker container argument can't start with "-"
	die "you must specify a valid docker container"
	unless $docker_container and $docker_container !~ m/^\s*-/;

	# execute wait command
	exec( _build_cmd(qq{$DOCKER wait}), $docker_container, @ARGV )
	or die "couldn't exec docker: $!";
	}

	# perl 5.8 compat - Module::Loaded not in core until 5.10
	sub is_loaded () {
	my $pm = shift;
	my $file = _pm_to_file( $pm ) or return;

	return $INC{$file} if exists $INC{$file};

	return;
	}

	sub _pm_to_file {
	my $pm = shift or return;

	my $file = join '/', split '::', $pm;
	$file .= '.pm';

	return $file;
	}