| 1 | # -*- perl -*- |
| 2 | |
| 3 | # uses: |
| 4 | # $specpath whole path from caller, minus any leading /s |
| 5 | # $spechost host from caller |
| 6 | # |
| 7 | # sets: |
| 8 | # |
| 9 | # always: |
| 10 | # $uri |
| 11 | # |
| 12 | # if match found for this host and path: |
| 13 | # $serve_user username, or undef if no match (then other serve_* invalid) |
| 14 | # $serve_dir directory as specified in config |
| 15 | # $serve_repo subpath under $serve_dir _including_ leading / |
| 16 | # |
| 17 | # for use by user's service program |
| 18 | # $repo_regexp |
| 19 | # $require_exportok |
| 20 | |
| 21 | sub remain_path ($) { |
| 22 | # return value matches {( / [^/]+ )+}x |
| 23 | my ($vsubpath) = @_; |
| 24 | syslog 'debug', sprintf "DEBUG remain_path %s $specpath", |
| 25 | (defined $vsubpath ? $vsubpath : '<undef>'); |
| 26 | return "/$specpath" if !defined $vsubpath; |
| 27 | return "" if $vsubpath eq $specpath; |
| 28 | return substr($specpath,length($vsubpath)) |
| 29 | if substr($specpath,0,length($vsubpath)+1) eq "$vsubpath/"; |
| 30 | return undef; |
| 31 | } |
| 32 | |
| 33 | fail "no config ??" unless @ARGV; |
| 34 | fail "no specpath ??" unless length $specpath; |
| 35 | |
| 36 | our $uri = "git://$spechost/$specpath"; |
| 37 | |
| 38 | our $repo_regexp= '^(\\w[-+._0-9A-Za-z]*/?\.git)$'; # stupid emacs '; |
| 39 | our $check_export= 0; |
| 40 | |
| 41 | our ($serve_user, $serve_dir, $serve_repo); |
| 42 | |
| 43 | sub fexists ($) { |
| 44 | my ($f) = @_; |
| 45 | if (stat $f) { |
| 46 | -f _ or fail "bad config $_ - not a file"; |
| 47 | return 1; |
| 48 | } else { |
| 49 | $!==&ENOENT or fail "bad config $_ - could not stat: $!"; |
| 50 | return 0; |
| 51 | } |
| 52 | } |
| 53 | |
| 54 | @ARGV = grep { fexists($_) } @ARGV; |
| 55 | |
| 56 | while (<>) { |
| 57 | |
| 58 | s/^\s*//; |
| 59 | s/\s+$//; |
| 60 | next unless m/\S/; |
| 61 | next if m/^\#/; |
| 62 | |
| 63 | if (m{^ single-user \s+ (\S+?) (/\S*)? \s+ (\S+) (?: \s+ (\S+) )? $ }x) { |
| 64 | my ($h,$v,$u,$d) = ($1,$2,$3,$4); |
| 65 | next unless $h eq $spechost; |
| 66 | $serve_repo= remain_path($v); |
| 67 | next unless defined $serve_repo; |
| 68 | $serve_user= $u; |
| 69 | $serve_dir= $d; |
| 70 | syslog 'debug', "DEBUG $ARGV:$. match". |
| 71 | " $serve_user $serve_dir $serve_repo"; |
| 72 | } elsif (m{^ multi-user \s+ (\S+?) (/\S*)? \s+ (\S+) $ }x) { |
| 73 | my ($h,$v,$d) = ($1,$2,$3); |
| 74 | next unless $1 eq $spechost; |
| 75 | $serve_repo= remain_path($v); |
| 76 | next unless defined $serve_repo; |
| 77 | syslog 'debug', "DEBUG $ARGV:$. perhaps $serve_repo"; |
| 78 | next unless $serve_repo =~ s{ ^/\~( [a-z][-+_0-9a-z]* )/ }{/}xi; |
| 79 | $serve_user= $1; |
| 80 | $serve_dir= $d; |
| 81 | syslog 'debug', "DEBUG $ARGV:$. match". |
| 82 | " $serve_user $serve_dir $serve_repo"; |
| 83 | } elsif (m{^ repo-regexp \s+ (\S.*) $ }x) { |
| 84 | $repo_regexp= $1; |
| 85 | } elsif (m{^ (no-)?require-git-daemon-export-ok $ }x) { |
| 86 | $check_export= !defined $1; |
| 87 | } else { |
| 88 | fail "config syntax error at $ARGV:$."; |
| 89 | } |
| 90 | } |
| 91 | |
| 92 | # end |