de

#!/usr/bin/env perl
#
#ver http://stackoverflow.com/a/26547845
#
use strict;
use YAML qw(LoadFile DumpFile);
use Getopt::Std;
use Cwd;
use Data::Dumper;
use File::Spec;
use File::Basename;

our $VERSION=2.1.1;

my $CONFIG_FILE = '.de';

my %DEFAULT_ENV = (
    TERM => 'xterm-256color'
);

my @current_path = File::Spec->splitdir(

    File::Spec->rel2abs(

        File::Spec->curdir()
    )
);


my $DEFAULT_PROJECT_NAME = pop @current_path;
my $REAL_GROUP_ID = (split(' ', $())[0];

my $CONFIG = {
    container => undef,
    image => undef,
    
    working_dir => File::Spec->join(
        File::Spec->rootdir,
        'home',
        $DEFAULT_PROJECT_NAME
    ),
    ports => [],
    volumes => [],
    links => [],
    action => 'exec',
    
    homedir => File::Spec->join(
    
        File::Spec->rootdir(),
        'home',
        scalar(getpwuid($<))
    ),
    
    user_id => $<,
    
    group_id => $REAL_GROUP_ID,

    env => [],
    sysctl => [],
    entrypoint => undef,
};
&read_config;
&load_command_line_args;

if($CONFIG->{action} eq 'exec'){

    my $sh_cmd = &build_command(@ARGV);
    &execute_command(@$sh_cmd);
}
elsif($CONFIG->{action} =~  /^delete|drop|rm|remove$/i){
    &delete_image();
}



#########################################################################

sub current_path_relative_to_project_root {
    my $current_abs_path = File::Spec->rel2abs(File::Spec->curdir());

    my @current_abs_path = File::Spec->splitdir($current_abs_path);

    my $rel_path = File::Spec->curdir();

    my @slices = ();

    while(@current_abs_path > 0){

        if(-e File::Spec->join($rel_path, $CONFIG_FILE)){

            return File::Spec->join(@slices, File::Spec->curdir());
        }

        unshift @slices, pop(@current_abs_path);

        $rel_path = File::Spec->join(File::Spec->updir(), $rel_path);
    }

}

sub abs_root_path {

    my $current_abs_path = File::Spec->rel2abs(File::Spec->curdir());
    my @current_abs_path = File::Spec->splitdir($current_abs_path);
    my $rel_path = File::Spec->curdir();

    while(@current_abs_path > 0 ){
        if(-e File::Spec->join($rel_path, $CONFIG_FILE)){

            return File::Spec->join(@current_abs_path);
        }

        pop(@current_abs_path);

        $rel_path = File::Spec->join(File::Spec->updir(), $rel_path);

    }

}

sub build_command {
    my @args = @_;

    unless(@args){
        
        HELP_MESSAGE();

        die("Command (to run in container) missing");
    }

    my $cmd = join (' ', @args);

    return [@args];


}

sub build_env {

    my $env = {};

    if(ref($CONFIG->{env}) eq 'ARRAY'){

        foreach my $env_var (@{$CONFIG->{env}}){
            
            my ($key, $val)  = split '=', $env_var;

            $env->{$key} = $val;
        }
    }
    elsif(ref($CONFIG->{env}) eq 'HASH'){
        $env = $CONFIG->{env};
    }


    $env = {(%$env, %DEFAULT_ENV)};
    
    $env;
    
}


sub execute_command{
    my (@sh_cmd) = @_;
    die("image not specified") unless($CONFIG->{image});

    my $container_name = &generate_container_name();

    # para evitar retornos de carro (\r) na saida do docker run
    # evitamos activa a tty a menos que se indique explicitamente     
    #(https://github.com/docker/docker/issues/8513)
    my @command = qw(docker run -i);

    if($CONFIG->{tty}){
        push @command, '-t'
    }
    
    if($CONFIG->{commit}){
        push @command, ('--name', $container_name);
    }
    else{
       push @command, "--rm";
    }

    # 
    # seteamos el usuario dentro del container
    # equivalente al que lo esta ejecutando fuera
    #
    unless($CONFIG->{root}){
        #push @command, ('-e', 'USER='.$ENV{USER});
        #push @command, ('-e', 'USERID='.$<);

        #push @command, ('-u', "$<:$REAL_GROUP_ID");
        push @command, ('-e', 'USER='.getpwuid($CONFIG->{user_id}));
        push @command, ('-e', 'USERID='.$CONFIG->{user_id});

        push @command, ('-u', $CONFIG->{user_id}.':'.$CONFIG->{group_id});
    }

    push @command, ("-v", File::Spec->rel2abs(File::Spec->curdir()).':'.$CONFIG->{working_dir});
    push @command, ('-w', $CONFIG->{working_dir});


    # volumes extra
    foreach my $vol (@{$CONFIG->{volumes}}){
        
        my @part = split ':', $vol;

        my $local_path;

        # sustituimos variables de entorno, si existen
        $part[0] = &interpolate_env_vars($part[0]);

        my $access_control = ($part[2])? ':'.$part[2] : '';

        # miramos si es ruta relativa o absoluta
        # si es relativa, hai que calcular la absoluta
        my $root = File::Spec->rootdir();

        #
        # Pero para poder montar los containers con named_volumes 
        # si la ruta empieza por @ (de label) no se hace más que seguir la label
        #
        if($part[0] =~ /^\@([^:]+)/){
            push @command, ('-v', $1.':'.$part[1].$access_control);
            
            next;
        }
        else{
            if($part[0] =~ qr!^$root!x ){
                $local_path = $part[0]
            }
            else{
                $local_path = File::Spec->rel2abs(&abs_root_path.'/'.$part[0]);
            }
        }

        push @command, ('-v', $local_path.':'.$part[1].$access_control);
        
    }

    # env vars definied en config
    my $env = &build_env;
    while(my ($k,$v) = each(%$env)){

        $v = &interpolate_env_vars($v);

        push @command, ('-e', "$k=$v");
    }

    # links
    foreach my $link (@{$CONFIG->{links}}){
        push @command, ('--link', $link);
    }
    
    # ports
    if($CONFIG->{connect_ports}){
        foreach my $port (@{$CONFIG->{ports}}){ 
            push @command, ("-p", $port);
        }
    }

    # sysctl
    foreach my $opt (@{$CONFIG->{sysctl}}){
        push @command, ('--sysctl', $opt);
    }

    # entrypoint 
    if(defined($CONFIG->{entrypoint})){
        push @command, ("--entrypoint" , $CONFIG->{entrypoint});
    }

    push @command, ($CONFIG->{image}, @sh_cmd);

    run_cmd(@command);

    if($CONFIG->{commit}){
        my $tag = $CONFIG->{tag} || 'latest';
        commit_container($container_name, $CONFIG->{image}.":$tag")
    }
}

sub interpolate_env_vars{
    
    $_[0] =~ s/\$(\w+)/$ENV{$1}/g;
    $_[0];
}


sub generate_container_name {
    use Time::HiRes qw(time);

    time;
}


sub commit_container{
    my ($container, $image) = @_;

    run_cmd(
        "docker commit $container $image"
    );

    # limpamos container
    run_cmd(
        "docker rm -f -v $container"
    );
}


sub delete_image{
    die("image not specified") unless ($CONFIG->{image});
    print "Removing image ".$CONFIG->{image}." ...";
    run_cmd("docker rmi $CONFIG->{image}");
}


sub read_config {
 
    my $config_path = File::Spec->join(
        &abs_root_path,
        $CONFIG_FILE
    );

    return unless -e $config_path;

    my $data = LoadFile($config_path);

    while(my ($k, $v) = each(%$data)){
        if(exists($CONFIG->{$k})){
            $CONFIG->{$k} = $v
        }
    }
}

sub save_config {

    delete($CONFIG->{action});
    DumpFile($CONFIG_FILE, $CONFIG)
}


sub load_command_line_args{
    my $conf = $CONFIG;

    # Mergeamos CONF cas opcions pasadas desde a linea de comandos
    my $opts = {};
    getopts("i:c:w:a:e:dRCUST:t", $opts);

    $conf->{container} = $opts->{c} if($opts->{c});
    $conf->{image} = $opts->{i} if($opts->{i});
    $conf->{working_dir} = $opts->{w} if($opts->{w});
    $conf->{action} = $opts->{a} if($opts->{a});
    $conf->{root} = 1 if($opts->{R});
    $conf->{debug} = 1 if($opts->{d});

    $conf->{commit} =  $opts->{C} || $opts->{S};
    $conf->{tag} = $opts->{T} if($opts->{T});
    $conf->{tty} = $opts->{t} if($opts->{t});
    $conf->{connect_ports} = !($opts->{U});
    $conf->{entrypoint} = $opts->{e} if($opts->{e});

}

sub HELP_MESSAGE {
    print "Run commands related to a code project, inside an associated docker container, from outside\n\n";
    print "Usage: $0 <args> <command>\n\n";
    print 
        "VALID ARGS:\n",
        "  -c <container_name>: Launch container with name specified, by default random name is used \n", 
        "  -i <image_name>: Use image to run container \n",
        "  -w <dir>: working dir, default to '.'\n",
        "  -e <entrypoint>: entrypoint, modify image entrypoint\n",
        "  -R: root mode, run as root\n",
        "  -d: debug, print docker command executed\n",
        "  -t: tty allocate, to get echo in terminal\n",
        "  -U: avoid connect ports to container to avoid colision with another family container in execution (only command line)\n",

        "  -C,-S: commit after container exit. It will use -T tag, or image name if not tag is specified\n",
        "  -T: tag to commit to, if commit flag is set\n",
        "\n\n";
}

sub run_cmd{
    my ($cmd,@rest) = @_;

    print join(' ', $cmd, @rest, "\n") if($CONFIG->{debug});

    system(&split_command($cmd), @rest);
}

sub split_command {
    my ($cmd) = @_;

    my @cmd;
    # 
    # regexp que permite partir por espacios y por bloques entrecomillados
    #
    while($cmd =~ /((\"[^"]+\")|(\'[^']+\')|([^\s]+))\s?/g){
        my $token = $1;
        $token =~ s/(^["']|["']$)//g;
        push @cmd, $token;
    }

    @cmd;

}