docker wrapper

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

docker_wrapper.pl

#!/usr/bin/perl
use strict;

# find out who am i --
# coreutils's logname(1) executable is least likely to be fooled
my $user = `/usr/bin/logname`;
chomp($user);

die "root may simply run docker directly if you please"
  if $user eq 'root';

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

my $uid = getpwnam($user);
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/;

# 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;
my $exit_status = 0;
{
    no strict 'refs';
    &{ "docker_" . $command }();
}

die "system failed: $!" if $exit_status == -1;
if ( $exit_status & 127 ) {
    warn "child died with signal " . $exit_status & 127;
}
else {
    $exit_status = $exit_status >> 8;
}

exit $exit_status;

# pass white-listed arguments to docker run
sub docker_run
{
    my %flags;
    my %strings;
    foreach (qw/
      cpu_shares cpus detach_keys entrypoint env_file memory name restart
      shm_size user workdir
    /){
        $strings{$_} = '';
    }
    my %lists;
    foreach (qw/attach env label volume/) {
        $lists{$_} = [];
    }
    my %opt = (
        "d|detach"       => \$flags{detach},
        "help"           => \$flags{help},
        "i|interactive"  => \$flags{interactive},
        "read-only"      => \$flags{read_only},
        "rm"             => \$flags{rm},
        "t|tty"          => \$flags{tty},
        "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},
        "m|memory=s"     => \$strings{memory},
        "name=s"         => \$strings{name},
        "restart=s"      => \$strings{restart},
        "shm-size=s"     => \$strings{shm_size},
        "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},
    );
    GetOptions(%opt) or die "invalid arguments";
    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*-/;

    # user can be nobody; otherwise cannot be specified
    {
        my $u = delete $strings{user};
        die "you cannot specify a user argument"
          if $u and $u ne 'nobody';
        $uid = "nobody" if $u eq 'nobody';
    }

    # build run command -- user is mandatory (cannot be root; can be nobody)
    my $docker_cmd = qq{$DOCKER run
        --cap-drop=ALL
        --security-opt=no-new-privileges
        --network=host
        -u $uid
    };

    # 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=$_";
        }
    }

    # 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
    system( @docker_cmd, $docker_image, @ARGV );
    $exit_status = $?;
}


# 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
{
    my %flags;
    my %strings;
    foreach (qw/
      detach_keys
    /){
        $strings{$_} = '';
    }
    my %opt = (
        "a|attach"      => \$flags{attach},
        "i|interactive" => \$flags{interactive},
        "detach-keys=s" => \$strings{detach_keys},
    );
    GetOptions(%opt) or die "invalid arguments";
    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*-/;

    # build start command
    my $docker_cmd = qq{$DOCKER start
    };

    # 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";
    }

    system( @docker_cmd, $docker_container, @ARGV );
    $exit_status = $?;
}


# 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
{
    my %flags;
    my %strings;
    foreach (qw/
      detach_keys sig_proxy
    /){
        $strings{$_} = '';
    }
    my %opt = (
        "no-stdin"      => \$flags{no_stdin},
        "detach-keys=s" => \$strings{detach_keys},
        "sig-proxy=s"   => \$strings{sig_proxy},
    );
    GetOptions(%opt) or die "invalid arguments";
    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*-/;

    # build attach command
    my $docker_cmd = qq{$DOCKER attach
    };

    # 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";
    }

    system( @docker_cmd, $docker_container, @ARGV );
    $exit_status = $?;
}


# pass white-listed arguments to docker exec
sub docker_exec
{
    my %flags;
    my %strings;
    foreach (qw/
      detach_keys user
    /){
        $strings{$_} = '';
    }
    my %lists;
    foreach (qw/env/) {
        $lists{$_} = [];
    }
    my %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},
    );
    GetOptions(%opt) or die "invalid arguments";
    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*-/;

    # user can be nobody; otherwise cannot be specified
    {
        my $u = delete $strings{user};
        die "you cannot specify a user argument"
          if $u and $u ne 'nobody';
        $uid = "nobody" if $u eq 'nobody';
    }

    # build exec command -- user is mandatory (cannot be root; can be nobody)
    my $docker_cmd = qq{$DOCKER exec
        -u $uid
    };

    # 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=$_";
        }
    }

    # 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
    system( @docker_cmd, $docker_container, @ARGV );
    $exit_status = $?;
}


# pass white-listed arguments to docker stop
sub docker_stop
{
    my %flags;
    my %strings;
    foreach (qw/
      time
    /){
        $strings{$_} = '';
    }
    my %opt = (
        "t|time=s" => \$strings{time},
    );
    GetOptions(%opt) or die "invalid arguments";
    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*-/;

    # build stop command
    my $docker_cmd = qq{$DOCKER stop
    };

    # 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";
    }

    system( @docker_cmd, $docker_container, @ARGV );
    $exit_status = $?;
}


# pass white-listed arguments to docker diff
sub docker_diff
{
    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*-/;

    # build diff command
    my $docker_cmd = qq{$DOCKER diff
    };
    my @docker_cmd = split( m/\s+/, $docker_cmd );

    system( @docker_cmd, $docker_container );
    $exit_status = $?;
}


# pass white-listed arguments to docker info
sub docker_info
{
    my %strings;
    foreach (qw/
      format
    /){
        $strings{$_} = '';
    }
    my %opt = (
        "f|format=s" => \$strings{format},
    );
    GetOptions(%opt) or die "invalid arguments";

    # build info command
    my $docker_cmd = qq{$DOCKER info
    };
    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";
    }

    system( @docker_cmd );
    $exit_status = $?;
}


# pass white-listed arguments to docker version
sub docker_version
{
    my %strings;
    foreach (qw/
      format
    /){
        $strings{$_} = '';
    }
    my %opt = (
        "f|format=s" => \$strings{format},
    );
    GetOptions(%opt) or die "invalid arguments";

    # build version command
    my $docker_cmd = qq{$DOCKER version
    };
    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";
    }

    system( @docker_cmd );
    $exit_status = $?;
}


# pass white-listed arguments to docker ps
sub docker_ps
{
    my %flags;
    my %strings;
    foreach (qw/
      format last
    /){
        $strings{$_} = '';
    }
    my %lists;
    foreach (qw/ filter /) {
        $lists{$_} = [];
    }
    my %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},
    );
    GetOptions(%opt) or die "invalid arguments";

    # build ps command
    my $docker_cmd = qq{$DOCKER ps
    };

    # 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=$_";
        }
    }

    system( @docker_cmd );
    $exit_status = $?;
}


# pass white-listed arguments to docker logs
sub docker_logs
{
    my %flags;
    my %strings;
    foreach (qw/
      since tail
    /){
        $strings{$_} = '';
    }
    my %opt = (
        "details"      => \$flags{details},
        "f|follow"     => \$flags{follow},
        "t|timestamps" => \$flags{timestamps},
        "since=s"      => \$strings{since},
        "tail=s"       => \$strings{tail},
    );
    GetOptions(%opt) or die "invalid arguments";
    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*-/;

    # build logs command
    my $docker_cmd = qq{$DOCKER logs
    };

    # 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";
    }

    system( @docker_cmd, $docker_container );
    $exit_status = $?;
}


# pass white-listed arguments to docker kill
sub docker_kill
{
    my %strings;
    foreach (qw/
      signal
    /){
        $strings{$_} = '';
    }
    my %opt = (
        "s|signal=s" => \$strings{signal},
    );
    GetOptions(%opt) or die "invalid arguments";
    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*-/;

    # build kill command
    my $docker_cmd = qq{$DOCKER kill
    };

    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";
    }

    system( @docker_cmd, $docker_container, @ARGV );
    $exit_status = $?;
}


# pass white-listed arguments to docker images
sub docker_images
{
    my %flags;
    my %strings;
    foreach (qw/
      format
    /){
        $strings{$_} = '';
    }
    my %lists;
    foreach (qw/ filter /) {
        $lists{$_} = [];
    }
    my %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},
    );
    GetOptions(%opt) or die "invalid arguments";
    my $docker_repository = shift @ARGV;

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

    # build images command
    my $docker_cmd = qq{$DOCKER images
    };

    # 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=$_";
        }
    }

    system( @docker_cmd , $docker_repository );
    $exit_status = $?;
}


# pass white-listed arguments to docker rm
sub docker_rm
{
    my %flags;
    my %opt = (
        "f|force"   => \$flags{force},
        "v|volumes" => \$flags{volumes},
    );
    GetOptions(%opt) or die "invalid arguments";
    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*-/;

    # build rm command
    my $docker_cmd = qq{$DOCKER rm
    };

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

    system( @docker_cmd, $docker_container, @ARGV );
    $exit_status = $?;
}


# pass white-listed arguments to docker rmi
sub docker_rmi
{
    my %flags;
    my %opt = (
        "f|force"  => \$flags{force},
        "no-prune" => \$flags{no_prune},
    );
    GetOptions(%opt) or die "invalid arguments";
    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*-/;

    # build rmi command
    my $docker_cmd = qq{$DOCKER rmi
    };

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

    system( @docker_cmd, $docker_image, @ARGV );
    $exit_status = $?;
}


# pass white-listed arguments to docker inspect
sub docker_inspect
{
    my %flags;
    my %strings;
    foreach (qw/
      format type
    /){
        $strings{$_} = '';
    }
    my %opt = (
        "s|size"     => \$flags{size},
        "f|format=s" => \$strings{format},
        "type=s"     => \$strings{type},
    );
    GetOptions(%opt) or die "invalid arguments";
    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*-/;

    # build inspect command
    my $docker_cmd = qq{$DOCKER inspect
    };
    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";
    }

    system( @docker_cmd, $docker_id, @ARGV );
    $exit_status = $?;
}