view release on metacpan or  search on metacpan

hooks/post-action  view on Meta::CPAN

    my $client = $ENV{XMODIFIERS} =~ /^client=.*(git-?\w*)/m ? $1 : "";
    (my $msg = $op) =~ s/e?$/ed/;
    $msg .= " (in $ref->{server_git_duration} seconds)" if $ref->{server_git_duration};
    if ($pull_branch) {
       $msg .= $op eq "clone" ? " [git clone --branch $pull_branch $ref->{repo}]" :
           $client eq "git-deploy" ? " [git deploy --branch $pull_branch]" :
           $op eq "pull" ? " [git checkout $pull_branch; git pull]" : "";
    }
    else {
        $msg .= $op eq "clone" ? " [git clone $ref->{repo}]" :
            $client eq "git-deploy" ? " [git deploy]" :
            $op eq "pull" ? " [git pull]" :
            $op eq "push" ? " [git push]" : "";
    }
    $msg .= " ($ref->{client_git_version})" if $ref->{client_git_version};
    $msg .= " $_->{type}:$_->{ref}" foreach @{ $ref->{refs} };
    logger $msg;
}

my $lock;
my $queue_lock = "$queue/.lock";
!-e $queue_lock and open $lock, ">>", $queue_lock and close $lock; # Create empty "touch" file
if (!-e $queue_lock) {
    warn localtime().": [$who] git-server: [$$] DEBUG: FAILED creating WebHooks lock file! [$queue_lock] $!\n";
    exit;
}
if (!open $lock, "+<", $queue_lock) {
    die localtime().": [$who] git-server: [$$] DEBUG: WebHooks lock file [$queue_lock] could not be opened! [$!]\n";
}
if (!eval {require Fcntl;1} or !flock $lock, (Fcntl::LOCK_EX()|Fcntl::LOCK_NB())) {
    my $pid = eval { 0+<$lock> } or die localtime().": [$who] git-server: [$$] DEBUG: WebHooks failed to acquire naked lock? $! $@\n";
    warn localtime().": [$who] git-server: [$$] DEBUG: WebHooks dequeuer already running by PID [$pid].\n"; # Great! Nothing for me to worry about.
    close $lock;
    exit;
}

$0 = "$Script - Running WebHooks";
warn localtime().": [$who] git-server: [$$] DEBUG: Running post-action webhooks ...\n";
print $lock "$$\n";
truncate $lock, tell $lock;
chdir $queue or die localtime().": [$who] git-server: [$$] DEBUG: Exclusively locked but unable to chdir? [$queue] $!\n";

my $sent = 1;
while ($sent) { # If any webhooks were sent, then keep trying until it's clean and quiet.
    $sent = 0;
    my $send_failures = 0;
    opendir my $q, "." or die localtime().": [$who] git-server: [$$] DEBUG: Exclusively locked but unable to read queue directory? [$queue] $!\n";
    my @events = readdir $q;
    closedir $q;
    delete $ENV{GIT_DIR};
    my $total = @events-3 or last; # Ignore . and .. and .lock
    my $progress = 0;
    foreach my $file (sort @events) {
        next if $file =~ /^\.(|\.|lock)$/;
        $0 = "$Script - Running WebHooks: ".++$progress."/$total";
        next if $file !~ /^webhook-.*\.queue$/;
        my $f = "$queue/$file";
        my $p = "$f.$$-RUNNING";
        rename $f, $p or !warn localtime().": [$who] git-server: [$$] DEBUG: Rename Failed! [$f] $!\n" or next;
        open $q, "+<", $p or open $q, "<", $p or !warn localtime().": [$who] git-server: [$$] DEBUG: Open Failed! [$f] $!\n" or next;
        my $event = do { local $/ = ""; scalar <$q> };
        if ($event =~ /^\s*\{/) {
            # Must be JSON
            $event = eval {
                require JSON;
                JSON->new->decode($event);
            };
        }
        elsif ($event =~ /^\s*\$VAR1\s*=/) {
            # Must be the silly Dumper
            my $VAR1 = undef;
            eval $event;
            $event = $VAR1;
        }
        else {
            # No idea what else it could be
            warn localtime().": [$who] git-server: [$$] DEBUG: Unknown transport in queue file [$p]\n";
            next;
        }
        if ("HASH" ne ref $event) {
            warn localtime().": [$who] git-server: [$$] DEBUG: Unable to decode trigger info or unimplemented event type [$p] $@ $!\n";
            next;
        }
        my $url = $event->{url} or !warn localtime().": [$who] git-server: [$$] DEBUG: Missing {url} target in event [$p]\n" or next;

        local $ENV{GIT_DIR} = $event->{gitdir};
        my $method = "";
        my $body = "";
        my $content_type = "";
        $ref = $event->{payload};
        if ($event->{transport} =~ /^json$/i) {
            $content_type = "application/json";
            if (eval { require JSON }) {
                $body = JSON->new->canonical->encode($ref)."\n";
            }
            elsif ($ref =~ /^\s*\{/) {
                $body = "$ref\n";
            }
            else {
                rename $p, $f; # Hopefully JSON will work better later?
                logger "Unable to load JSON.pm? Please install JSON and try again later. [$f]\n$@\n";
                last;
            }
        }
        else {
            logger "Unimplemented transport [$event->{transport}]";
            next;
        }
        if ($event->{method} =~ /^post$/i) {
            $method = "POST";
        }
        else {
            logger "Unimplemented method [$event->{method}]";
            next;
        }
        require IPC::Open3;
        require Symbol;
        my ($in,$out,$err) = (Symbol::gensym(),Symbol::gensym(),Symbol::gensym());
        my $pid = eval {
            IPC::Open3::open3($in, $out, $err, qw(curl -k -s -w \n%{http_code} --data-binary @- -X), $method, "-HContent-type:$content_type", $url);
        };