| 1 | #!/usr/bin/perl | 
|---|
| 2 |  | 
|---|
| 3 | use strict; | 
|---|
| 4 | use warnings; | 
|---|
| 5 |  | 
|---|
| 6 | use Net::LDAP; | 
|---|
| 7 | use Net::LDAP::Filter; | 
|---|
| 8 |  | 
|---|
| 9 | sub report_error | 
|---|
| 10 | { | 
|---|
| 11 | my $proto = shift; | 
|---|
| 12 | my $mesg = shift; | 
|---|
| 13 |  | 
|---|
| 14 | if ($proto eq 'git') { | 
|---|
| 15 | $mesg = "ERR \n  " . $mesg . "\n"; | 
|---|
| 16 | my $len = length($mesg)+4; | 
|---|
| 17 | printf "%04x%s", $len, $mesg; | 
|---|
| 18 | } else { | 
|---|
| 19 | print $mesg; | 
|---|
| 20 | } | 
|---|
| 21 | exit 0; | 
|---|
| 22 | } | 
|---|
| 23 |  | 
|---|
| 24 | my $url = $ARGV[0]; | 
|---|
| 25 | my ($proto, $hostname, $path) = $url =~ m|^(.*?)://([^/]*)(.*)| or die "Could not match URL"; | 
|---|
| 26 | my $mesg; | 
|---|
| 27 |  | 
|---|
| 28 | # oh my gosh Net::LDAP::Filter SUCKS | 
|---|
| 29 | my $filter = bless({and => | 
|---|
| 30 | [{equalityMatch => {attributeDesc  => 'objectClass', | 
|---|
| 31 | assertionValue => 'scriptsVhost'}}, | 
|---|
| 32 | {or => | 
|---|
| 33 | [{equalityMatch => {attributeDesc  => 'scriptsVhostName', | 
|---|
| 34 | assertionValue => $hostname}}, | 
|---|
| 35 | {equalityMatch => {attributeDesc  => 'scriptsVhostAlias', | 
|---|
| 36 | assertionValue => $hostname}}]}]}, | 
|---|
| 37 | 'Net::LDAP::Filter'); | 
|---|
| 38 |  | 
|---|
| 39 | my $ldap = Net::LDAP->new("ldapi://%2fvar%2frun%2fdirsrv%2fslapd-scripts.socket/"); | 
|---|
| 40 | $mesg = $ldap->bind(); | 
|---|
| 41 | $mesg->code && die $mesg->error; | 
|---|
| 42 |  | 
|---|
| 43 | $mesg = $ldap->search(base => "ou=VirtualHosts,dc=scripts,dc=mit,dc=edu", | 
|---|
| 44 | filter => $filter); | 
|---|
| 45 | $mesg->code && die $mesg->error; | 
|---|
| 46 |  | 
|---|
| 47 | my $vhostEntry = $mesg->pop_entry; | 
|---|
| 48 | if (!$vhostEntry) | 
|---|
| 49 | { | 
|---|
| 50 | report_error($proto, "Could not find Host $hostname"); | 
|---|
| 51 | } | 
|---|
| 52 | my $vhostDirectory = $vhostEntry->get_value('scriptsVhostDirectory'); | 
|---|
| 53 |  | 
|---|
| 54 | $mesg = $ldap->search(base => $vhostEntry->get_value('scriptsVhostAccount'), | 
|---|
| 55 | scope => 'base', filter => 'objectClass=posixAccount'); | 
|---|
| 56 | $mesg->code && die $mesg->error; | 
|---|
| 57 |  | 
|---|
| 58 | my $userEntry = $mesg->pop_entry; | 
|---|
| 59 | my ($homeDirectory, $uidNumber, $gidNumber) = | 
|---|
| 60 | map { $userEntry->get_value($_) } qw(homeDirectory uidNumber gidNumber); | 
|---|
| 61 |  | 
|---|
| 62 | if ($proto eq 'svn') { | 
|---|
| 63 | chdir '/usr/libexec/scripts-trusted'; | 
|---|
| 64 | exec('/usr/sbin/suexec', $uidNumber, $gidNumber, '/usr/libexec/scripts-trusted/svn', "$homeDirectory/Scripts/svn/$vhostDirectory"); | 
|---|
| 65 | } elsif ($proto eq 'git') { | 
|---|
| 66 | chdir '/usr/libexec/scripts-trusted'; | 
|---|
| 67 | exec('/usr/sbin/suexec', $uidNumber, $gidNumber, '/usr/libexec/scripts-trusted/git', "$homeDirectory/Scripts/git/$vhostDirectory"); | 
|---|
| 68 | } elsif ($proto eq 'http') { | 
|---|
| 69 | print "suexec $uidNumber $gidNumber $homeDirectory/Scripts/web/$vhostDirectory/$path\n"; | 
|---|
| 70 | } else { | 
|---|
| 71 | die "Unknown protocol\n"; | 
|---|
| 72 | } | 
|---|