← Back to branch summary

~ubuntu-branches/debian/sid/git/sid

« back to all changes in this revision

Viewing changes to perl/Git.pm

  • Committer: Package Import Robot
  • Author(s): Jonathan Nieder
  • Date: 2013-06-12 07:50:53 UTC
  • mfrom: (1.2.19) (2.1.31 experimental)
  • Revision ID: package-import@ubuntu.com-20130612075053-uue9xe0dq0rvm44y
Tags: 1:1.8.3.1-1
* merge branch debian-experimental
* new upstream point release (see RelNotes/1.8.3.1.txt).
* debian/watch: use xz-compressed tarballs from kernel.org.

Show diffs side-by-side

added added

removed removed

Lines of Context:
perl/Git.pm
58
58
                command_output_pipe command_input_pipe command_close_pipe
59
59
                command_bidi_pipe command_close_bidi_pipe
60
60
                version exec_path html_path hash_object git_cmd_try
61
 
                remote_refs
 
61
                remote_refs prompt
 
62
                get_tz_offset
 
63
                credential credential_read credential_write
62
64
                temp_acquire temp_release temp_reset temp_path);
63
65
 
64
66
 
102
104
use Cwd qw(abs_path cwd);
103
105
use IPC::Open2 qw(open2);
104
106
use Fcntl qw(SEEK_SET SEEK_CUR);
 
107
use Time::Local qw(timegm);
105
108
}
106
109
 
107
110
 
267
270
 
268
271
        if (not defined wantarray) {
269
272
                # Nothing to pepper the possible exception with.
270
 
                _cmd_close($fh, $ctx);
 
273
                _cmd_close($ctx, $fh);
271
274
 
272
275
        } elsif (not wantarray) {
273
276
                local $/;
274
277
                my $text = <$fh>;
275
278
                try {
276
 
                        _cmd_close($fh, $ctx);
 
279
                        _cmd_close($ctx, $fh);
277
280
                } catch Git::Error::Command with {
278
281
                        # Pepper with the output:
279
282
                        my $E = shift;
286
289
                my @lines = <$fh>;
287
290
                defined and chomp for @lines;
288
291
                try {
289
 
                        _cmd_close($fh, $ctx);
 
292
                        _cmd_close($ctx, $fh);
290
293
                } catch Git::Error::Command with {
291
294
                        my $E = shift;
292
295
                        $E->{'-outputref'} = \@lines;
313
316
        my $line = <$fh>;
314
317
        defined $line and chomp $line;
315
318
        try {
316
 
                _cmd_close($fh, $ctx);
 
319
                _cmd_close($ctx, $fh);
317
320
        } catch Git::Error::Command with {
318
321
                # Pepper with the output:
319
322
                my $E = shift;
381
384
sub command_close_pipe {
382
385
        my ($self, $fh, $ctx) = _maybe_self(@_);
383
386
        $ctx ||= '<unknown>';
384
 
        _cmd_close($fh, $ctx);
 
387
        _cmd_close($ctx, $fh);
385
388
}
386
389
 
387
390
=item command_bidi_pipe ( COMMAND [, ARGUMENTS... ] )
418
421
is:
419
422
 
420
423
        my ($pid, $in, $out, $ctx) = $r->command_bidi_pipe('cat-file --batch-check');
421
 
        print "000000000\n" $out;
 
424
        print $out "000000000\n";
422
425
        while (<$in>) { ... }
423
426
        $r->command_close_bidi_pipe($pid, $in, $out, $ctx);
424
427
 
426
429
currently it is simply the command name but in future the context might
427
430
have more complicated structure.
428
431
 
 
432
C<PIPE_IN> and C<PIPE_OUT> may be C<undef> if they have been closed prior to
 
433
calling this function.  This may be useful in a query-response type of
 
434
commands where caller first writes a query and later reads response, eg:
 
435
 
 
436
        my ($pid, $in, $out, $ctx) = $r->command_bidi_pipe('cat-file --batch-check');
 
437
        print $out "000000000\n";
 
438
        close $out;
 
439
        while (<$in>) { ... }
 
440
        $r->command_close_bidi_pipe($pid, $in, undef, $ctx);
 
441
 
 
442
This idiom may prevent potential dead locks caused by data sent to the output
 
443
pipe not being flushed and thus not reaching the executed command.
 
444
 
429
445
=cut
430
446
 
431
447
sub command_close_bidi_pipe {
432
448
        local $?;
433
 
        my ($pid, $in, $out, $ctx) = @_;
434
 
        foreach my $fh ($in, $out) {
435
 
                unless (close $fh) {
436
 
                        if ($!) {
437
 
                                carp "error closing pipe: $!";
438
 
                        } elsif ($? >> 8) {
439
 
                                throw Git::Error::Command($ctx, $? >>8);
440
 
                        }
441
 
                }
442
 
        }
443
 
 
 
449
        my ($self, $pid, $in, $out, $ctx) = _maybe_self(@_);
 
450
        _cmd_close($ctx, (grep { defined } ($in, $out)));
444
451
        waitpid $pid, 0;
445
 
 
446
452
        if ($? >> 8) {
447
453
                throw Git::Error::Command($ctx, $? >>8);
448
454
        }
512
518
sub html_path { command_oneline('--html-path') }
513
519
 
514
520
 
 
521
=item get_tz_offset ( TIME )
 
522
 
 
523
Return the time zone offset from GMT in the form +/-HHMM where HH is
 
524
the number of hours from GMT and MM is the number of minutes.  This is
 
525
the equivalent of what strftime("%z", ...) would provide on a GNU
 
526
platform.
 
527
 
 
528
If TIME is not supplied, the current local time is used.
 
529
 
 
530
=cut
 
531
 
 
532
sub get_tz_offset {
 
533
        # some systmes don't handle or mishandle %z, so be creative.
 
534
        my $t = shift || time;
 
535
        my $gm = timegm(localtime($t));
 
536
        my $sign = qw( + + - )[ $gm <=> $t ];
 
537
        return sprintf("%s%02d%02d", $sign, (gmtime(abs($t - $gm)))[2,1]);
 
538
}
 
539
 
 
540
 
 
541
=item prompt ( PROMPT , ISPASSWORD  )
 
542
 
 
543
Query user C<PROMPT> and return answer from user.
 
544
 
 
545
Honours GIT_ASKPASS and SSH_ASKPASS environment variables for querying
 
546
the user. If no *_ASKPASS variable is set or an error occoured,
 
547
the terminal is tried as a fallback.
 
548
If C<ISPASSWORD> is set and true, the terminal disables echo.
 
549
 
 
550
=cut
 
551
 
 
552
sub prompt {
 
553
        my ($prompt, $isPassword) = @_;
 
554
        my $ret;
 
555
        if (exists $ENV{'GIT_ASKPASS'}) {
 
556
                $ret = _prompt($ENV{'GIT_ASKPASS'}, $prompt);
 
557
        }
 
558
        if (!defined $ret && exists $ENV{'SSH_ASKPASS'}) {
 
559
                $ret = _prompt($ENV{'SSH_ASKPASS'}, $prompt);
 
560
        }
 
561
        if (!defined $ret) {
 
562
                print STDERR $prompt;
 
563
                STDERR->flush;
 
564
                if (defined $isPassword && $isPassword) {
 
565
                        require Term::ReadKey;
 
566
                        Term::ReadKey::ReadMode('noecho');
 
567
                        $ret = '';
 
568
                        while (defined(my $key = Term::ReadKey::ReadKey(0))) {
 
569
                                last if $key =~ /[\012\015]/; # \n\r
 
570
                                $ret .= $key;
 
571
                        }
 
572
                        Term::ReadKey::ReadMode('restore');
 
573
                        print STDERR "\n";
 
574
                        STDERR->flush;
 
575
                } else {
 
576
                        chomp($ret = <STDIN>);
 
577
                }
 
578
        }
 
579
        return $ret;
 
580
}
 
581
 
 
582
sub _prompt {
 
583
        my ($askpass, $prompt) = @_;
 
584
        return unless length $askpass;
 
585
        $prompt =~ s/\n/ /g;
 
586
        my $ret;
 
587
        open my $fh, "-|", $askpass, $prompt or return;
 
588
        $ret = <$fh>;
 
589
        $ret =~ s/[\015\012]//g; # strip \r\n, chomp does not work on all systems (i.e. windows) as expected
 
590
        close ($fh);
 
591
        return $ret;
 
592
}
 
593
 
515
594
=item repo_path ()
516
595
 
517
596
Return path to the git repository. Must be called on a repository instance.
890
969
        my $size = $1;
891
970
 
892
971
        my $blob;
893
 
        my $bytesRead = 0;
 
972
        my $bytesLeft = $size;
894
973
 
895
974
        while (1) {
896
 
                my $bytesLeft = $size - $bytesRead;
897
975
                last unless $bytesLeft;
898
976
 
899
977
                my $bytesToRead = $bytesLeft < 1024 ? $bytesLeft : 1024;
900
 
                my $read = read($in, $blob, $bytesToRead, $bytesRead);
 
978
                my $read = read($in, $blob, $bytesToRead);
901
979
                unless (defined($read)) {
902
980
                        $self->_close_cat_blob();
903
981
                        throw Error::Simple("in pipe went bad");
904
982
                }
905
 
 
906
 
                $bytesRead += $read;
 
983
                unless (print $fh $blob) {
 
984
                        $self->_close_cat_blob();
 
985
                        throw Error::Simple("couldn't write to passed in filehandle");
 
986
                }
 
987
                $bytesLeft -= $read;
907
988
        }
908
989
 
909
990
        # Skip past the trailing newline.
918
999
                throw Error::Simple("didn't find newline after blob");
919
1000
        }
920
1001
 
921
 
        unless (print $fh $blob) {
922
 
                $self->_close_cat_blob();
923
 
                throw Error::Simple("couldn't write to passed in filehandle");
924
 
        }
925
 
 
926
1002
        return $size;
927
1003
}
928
1004
 
948
1024
}
949
1025
 
950
1026
 
 
1027
=item credential_read( FILEHANDLE )
 
1028
 
 
1029
Reads credential key-value pairs from C<FILEHANDLE>.  Reading stops at EOF or
 
1030
when an empty line is encountered.  Each line must be of the form C<key=value>
 
1031
with a non-empty key.  Function returns hash with all read values.  Any white
 
1032
space (other than new-line character) is preserved.
 
1033
 
 
1034
=cut
 
1035
 
 
1036
sub credential_read {
 
1037
        my ($self, $reader) = _maybe_self(@_);
 
1038
        my %credential;
 
1039
        while (<$reader>) {
 
1040
                chomp;
 
1041
                if ($_ eq '') {
 
1042
                        last;
 
1043
                } elsif (!/^([^=]+)=(.*)$/) {
 
1044
                        throw Error::Simple("unable to parse git credential data:\n$_");
 
1045
                }
 
1046
                $credential{$1} = $2;
 
1047
        }
 
1048
        return %credential;
 
1049
}
 
1050
 
 
1051
=item credential_write( FILEHANDLE, CREDENTIAL_HASHREF )
 
1052
 
 
1053
Writes credential key-value pairs from hash referenced by
 
1054
C<CREDENTIAL_HASHREF> to C<FILEHANDLE>.  Keys and values cannot contain
 
1055
new-lines or NUL bytes characters, and key cannot contain equal signs nor be
 
1056
empty (if they do Error::Simple is thrown).  Any white space is preserved.  If
 
1057
value for a key is C<undef>, it will be skipped.
 
1058
 
 
1059
If C<'url'> key exists it will be written first.  (All the other key-value
 
1060
pairs are written in sorted order but you should not depend on that).  Once
 
1061
all lines are written, an empty line is printed.
 
1062
 
 
1063
=cut
 
1064
 
 
1065
sub credential_write {
 
1066
        my ($self, $writer, $credential) = _maybe_self(@_);
 
1067
        my ($key, $value);
 
1068
 
 
1069
        # Check if $credential is valid prior to writing anything
 
1070
        while (($key, $value) = each %$credential) {
 
1071
                if (!defined $key || !length $key) {
 
1072
                        throw Error::Simple("credential key empty or undefined");
 
1073
                } elsif ($key =~ /[=\n\0]/) {
 
1074
                        throw Error::Simple("credential key contains invalid characters: $key");
 
1075
                } elsif (defined $value && $value =~ /[\n\0]/) {
 
1076
                        throw Error::Simple("credential value for key=$key contains invalid characters: $value");
 
1077
                }
 
1078
        }
 
1079
 
 
1080
        for $key (sort {
 
1081
                # url overwrites other fields, so it must come first
 
1082
                return -1 if $a eq 'url';
 
1083
                return  1 if $b eq 'url';
 
1084
                return $a cmp $b;
 
1085
        } keys %$credential) {
 
1086
                if (defined $credential->{$key}) {
 
1087
                        print $writer $key, '=', $credential->{$key}, "\n";
 
1088
                }
 
1089
        }
 
1090
        print $writer "\n";
 
1091
}
 
1092
 
 
1093
sub _credential_run {
 
1094
        my ($self, $credential, $op) = _maybe_self(@_);
 
1095
        my ($pid, $reader, $writer, $ctx) = command_bidi_pipe('credential', $op);
 
1096
 
 
1097
        credential_write $writer, $credential;
 
1098
        close $writer;
 
1099
 
 
1100
        if ($op eq "fill") {
 
1101
                %$credential = credential_read $reader;
 
1102
        }
 
1103
        if (<$reader>) {
 
1104
                throw Error::Simple("unexpected output from git credential $op response:\n$_\n");
 
1105
        }
 
1106
 
 
1107
        command_close_bidi_pipe($pid, $reader, undef, $ctx);
 
1108
}
 
1109
 
 
1110
=item credential( CREDENTIAL_HASHREF [, OPERATION ] )
 
1111
 
 
1112
=item credential( CREDENTIAL_HASHREF, CODE )
 
1113
 
 
1114
Executes C<git credential> for a given set of credentials and specified
 
1115
operation.  In both forms C<CREDENTIAL_HASHREF> needs to be a reference to
 
1116
a hash which stores credentials.  Under certain conditions the hash can
 
1117
change.
 
1118
 
 
1119
In the first form, C<OPERATION> can be C<'fill'>, C<'approve'> or C<'reject'>,
 
1120
and function will execute corresponding C<git credential> sub-command.  If
 
1121
it's omitted C<'fill'> is assumed.  In case of C<'fill'> the values stored in
 
1122
C<CREDENTIAL_HASHREF> will be changed to the ones returned by the C<git
 
1123
credential fill> command.  The usual usage would look something like:
 
1124
 
 
1125
        my %cred = (
 
1126
                'protocol' => 'https',
 
1127
                'host' => 'example.com',
 
1128
                'username' => 'bob'
 
1129
        );
 
1130
        Git::credential \%cred;
 
1131
        if (try_to_authenticate($cred{'username'}, $cred{'password'})) {
 
1132
                Git::credential \%cred, 'approve';
 
1133
                ... do more stuff ...
 
1134
        } else {
 
1135
                Git::credential \%cred, 'reject';
 
1136
        }
 
1137
 
 
1138
In the second form, C<CODE> needs to be a reference to a subroutine.  The
 
1139
function will execute C<git credential fill> to fill the provided credential
 
1140
hash, then call C<CODE> with C<CREDENTIAL_HASHREF> as the sole argument.  If
 
1141
C<CODE>'s return value is defined, the function will execute C<git credential
 
1142
approve> (if return value yields true) or C<git credential reject> (if return
 
1143
value is false).  If the return value is undef, nothing at all is executed;
 
1144
this is useful, for example, if the credential could neither be verified nor
 
1145
rejected due to an unrelated network error.  The return value is the same as
 
1146
what C<CODE> returns.  With this form, the usage might look as follows:
 
1147
 
 
1148
        if (Git::credential {
 
1149
                'protocol' => 'https',
 
1150
                'host' => 'example.com',
 
1151
                'username' => 'bob'
 
1152
        }, sub {
 
1153
                my $cred = shift;
 
1154
                return !!try_to_authenticate($cred->{'username'},
 
1155
                                             $cred->{'password'});
 
1156
        }) {
 
1157
                ... do more stuff ...
 
1158
        }
 
1159
 
 
1160
=cut
 
1161
 
 
1162
sub credential {
 
1163
        my ($self, $credential, $op_or_code) = (_maybe_self(@_), 'fill');
 
1164
 
 
1165
        if ('CODE' eq ref $op_or_code) {
 
1166
                _credential_run $credential, 'fill';
 
1167
                my $ret = $op_or_code->($credential);
 
1168
                if (defined $ret) {
 
1169
                        _credential_run $credential, $ret ? 'approve' : 'reject';
 
1170
                }
 
1171
                return $ret;
 
1172
        } else {
 
1173
                _credential_run $credential, $op_or_code;
 
1174
        }
 
1175
}
 
1176
 
951
1177
{ # %TEMP_* Lexical Context
952
1178
 
953
1179
my (%TEMP_FILEMAP, %TEMP_FILES);
954
1180
 
955
1181
=item temp_acquire ( NAME )
956
1182
 
957
 
Attempts to retreive the temporary file mapped to the string C<NAME>. If an
 
1183
Attempts to retrieve the temporary file mapped to the string C<NAME>. If an
958
1184
associated temp file has not been created this session or was closed, it is
959
1185
created, cached, and set for autoflush and binmode.
960
1186
 
1039
1265
                        $tmpdir = $self->repo_path();
1040
1266
                }
1041
1267
 
1042
 
                ($$temp_fd, $fname) = File::Temp->tempfile(
 
1268
                ($$temp_fd, $fname) = File::Temp::tempfile(
1043
1269
                        'Git_XXXXXX', UNLINK => 1, DIR => $tmpdir,
1044
1270
                        ) or throw Error::Simple("couldn't open new temp file");
1045
1271
 
1263
1489
                if (not defined $pid) {
1264
1490
                        throw Error::Simple("open failed: $!");
1265
1491
                } elsif ($pid == 0) {
1266
 
                        if (defined $opts{STDERR}) {
1267
 
                                close STDERR;
1268
 
                        }
1269
1492
                        if ($opts{STDERR}) {
1270
1493
                                open (STDERR, '>&', $opts{STDERR})
1271
1494
                                        or die "dup failed: $!";
 
1495
                        } elsif (defined $opts{STDERR}) {
 
1496
                                open (STDERR, '>', '/dev/null')
 
1497
                                        or die "opening /dev/null failed: $!";
1272
1498
                        }
1273
1499
                        _cmd_exec($self, $cmd, @args);
1274
1500
                }
1303
1529
 
1304
1530
# Close pipe to a subprocess.
1305
1531
sub _cmd_close {
1306
 
        my ($fh, $ctx) = @_;
1307
 
        if (not close $fh) {
1308
 
                if ($!) {
 
1532
        my $ctx = shift @_;
 
1533
        foreach my $fh (@_) {
 
1534
                if (close $fh) {
 
1535
                        # nop
 
1536
                } elsif ($!) {
1309
1537
                        # It's just close, no point in fatalities
1310
1538
                        carp "error closing pipe: $!";
1311
1539
                } elsif ($? >> 8) {