#!/usr/bin/env perl
#>*******************************************************
# THIS FILE WAS AUTO-GENERATED BY ATLASSIAN BITBUCKET.
# IT CONTAINS NO USER-SERVICEABLE PARTS.
#>*******************************************************

# Perl script should be placed in ${bitbucket.home}/bin/git-hooks. This script opens a socket connection to
# Bitbucket and facilitates RPC for hook callbacks.
#
# When Bitbucket calls out to the SCM, it sets the following environment variables:
# - STASH_HOOK_ADDRESS: which IP address the server is listening on (specific address for these callbacks)
# - STASH_HOOK_PORT: which port the server is listening on (specific port for these callbacks)
# - STASH_HOOK_REQUEST_ID: an identifier that the server can use to determine which request the callback applies to

use IO::Socket;
use Encode;

# Utility functions to match the Java counterparts on DataInputStream and DataOutputStream

sub writeUnsignedShort {
    my ($out, $short) = @_;
    my $packed = pack('n', $short);
    print $out $packed;
}

sub writeUTF {
   my ($out, $chunk) = @_;
   my $packed = Encode::encode_utf8($chunk);
   writeUnsignedShort($out, length($packed));
   print $out $packed;
}

sub readBinary {
    my ($in) = @_;
    my $length = readUnsignedShort($in);
    read($in, my $packed, $length);
    return $packed;
}

sub readUnsignedShort {
    my ($in) = @_;
    read($in, my $packed, 2);
    return unpack('n', $packed);
}

# Open a socket back to the server. This will be used to send and receive information about
# the hook via a channel based protocol
my $socket = new IO::Socket::INET (
			PeerAddr => $ENV{'STASH_HOOK_ADDRESS'},
			PeerPort => $ENV{'STASH_HOOK_PORT'}, 
			Proto => 'tcp');
die "Could not create socket to trigger Bitbucket hooks: $!\n" unless $socket;

# Write inputs over socket.

# Ensure raw (binary) output
binmode($socket, ':raw');

# 1: write the REQUEST ID
print $socket 'X';
writeUTF($socket, $ENV{'STASH_HOOK_REQUEST_ID'});

# 2: write the hook type
print $socket 'T';
writeUTF($socket, $ARGV[0]);
shift @ARGV;

# 3: write any additional args
foreach my $arg (@ARGV) {
    print $socket 'A';
    writeUTF($socket, $arg);
}

# 4: write GIT_* environment variables
foreach my $key (keys %ENV) {
    if ($key =~ /^GIT_/ or $key =~ /^BB_/) {
        print $socket 'V';
        writeUTF($socket, "$key=$ENV{$key}");
    }
}

# 5: copy STDIN to the socket, ensuring UTF8 encoding is used
# STDIN is consumed in 16380 _UTF-8 character_ chunks. The max packet size
# is 65535 _bytes_, so 16380 is used to ensure no STDIN chunk exceeds what
# can be written in a single packet (x4 for max UTF-8 binary encoding)
my ($stdInChunk, $n);
binmode(STDIN, ":utf8");
while (($n = read(STDIN, $stdInChunk, 16380)) != 0) {
    print $socket 'I';
    writeUTF($socket, $stdInChunk);
}

# Signify that this is the end of the client's communication
print $socket 'E';

# Read channels from socket

# Ensure raw (binary) on stdout/err. (We may write encoded UTF-8 to them,
# but that should produce the correct results.)
binmode(STDOUT, ":raw");
binmode(STDERR, ":raw");

my $exitCode = 0;
while (True) {
    read($socket, my $c, 1);
    if ($c eq "O") {
        # STDOUT channel. Read the next chunk and write it to STDOUT
        print STDOUT readBinary($socket);
        next;
    } elsif ($c eq "E") {
        # STDERR channel. Read the next chunk and write it to STDERR
        print STDERR readBinary($socket);
        next;
    } elsif ($c eq "X") {
        # Exit code channel. Read short and use it to exit
        $exitCode = readUnsignedShort($socket);
        last;
    } else {
        # The server isn't giving back valid data. Bail
        print STDOUT "Communication breakdown with Bitbucket.\n";
        $exitCode = 1;
        last;
    }
}

# close the socket
close($socket);

# finally exit with the correct status code
exit $exitCode
