contrib/cgi/mirror_dir_through_svn.cgi

   1 #!/usr/bin/perl -wT
   2
   3 # $HeadURL$
   4 # $LastChangedDate$
   5 # $LastChangedBy$
   6 # $LastChangedRevision$
   7
   8 $| = 1;
   9
  10 use strict;
  11 use CGI       2.89;
  12 use CGI::Carp 1.24 qw(fatalsToBrowser carpout);
  13 use vars           qw($query);
  14
  15 # Get a CGI object now and send the HTTP headers out immediately so
  16 # that anything else printed will appear in the output, including
  17 # compile errors.
  18 BEGIN {
  19   $query = CGI->new;
  20   print $query->header('text/plain');
  21   carpout(\*STDOUT);
  22 }
  23
  24 # Protect the PATH environmental variable for safe system calls.
  25 $ENV{PATH} = '/usr/bin:/bin';
  26
  27 # Configuration settings.
  28
  29 # The location of the svn program.
  30 my $svn = '/opt/i386-linux/subversion/bin/svn';
  31
  32 # The location of the svn_load_dirs.pl script.
  33 my $svn_load_dirs = '/export/home2/svn/bin/svn_load_dirs.pl';
  34
  35 # The source directory.
  36 my $source_dirname = '/export/home2/svn/public_html/www-devel/webdav';
  37
  38 # The target directory.
  39 my $target_dirname = '/export/home1/apache/htdocs/www';
  40
  41 # The URL for the Subversion repository.
  42 my $repos_base_uri = 'file:///export/home2/svn/repos-www/trunk';
  43
  44 # Verbosity level.
  45 my $opt_verbose = 1;
  46 my @opt_verbose = $opt_verbose ? (qw(-v)) : ();
  47
  48 # Use this version of die instead of Perl's die so that messages are
  49 # sent to STDOUT instead of STDERR so that the browser can see them.
  50 # Otherwise, messages would be sent to Apache's error_log.
  51 sub my_die ($@)
  52 {
  53   print "@_\n" if @_;
  54   exit 1;
  55 }
  56
  57 # For permissions information, print my actual and effective UID and
  58 # GID.
  59 if ($opt_verbose)
  60   {
  61     my $real_uid      = getpwuid($<) || $<;
  62     my $effective_uid = getpwuid($>) || $>;
  63     my $real_gid      = getgrgid($() || $(;
  64     my $effective_gid = getgrgid($)) || $);
  65
  66     print "My real uid is $real_uid and my effective uid is $effective_uid.\n";
  67     print "My real gid is $real_gid and my effective gid is $effective_gid.\n";
  68   }
  69
  70 # Check the configuration settings.
  71 -e $source_dirname
  72   or my_die "$0: source directory `$source_dirname' does not exist.\n";
  73 -d _
  74   or my_die "$0: source directory `$source_dirname' is not a directory.\n";
  75 -e $target_dirname
  76   or my_die "$0: target directory `$target_dirname' does not exist.\n";
  77 -d _
  78   or my_die "$0: target directory `$target_dirname' is not a directory.\n";
  79
  80 # Since the path to svn and svn_load_dirs.pl depends upon the local
  81 # installation preferences, check that the required programs exist to
  82 # insure that the administrator has set up the script properly.
  83 {
  84   my $ok = 1;
  85   foreach my $program ($svn, $svn_load_dirs)
  86     {
  87       if (-e $program)
  88         {
  89           unless (-x $program)
  90             {
  91               print "$0: required program `$program' is not executable, ",
  92                     "edit $0.\n";
  93               $ok = 0;
  94             }
  95         }
  96       else
  97         {
  98           print "$0: required program `$program' does not exist, edit $0.\n";
  99           $ok = 0;
 100         }
 101     }
 102   exit 1 unless $ok;
 103 }
 104
 105 # Check that the svn base URL works by running svn log on it.
 106 &read_from_process($svn, 'log', $repos_base_uri);
 107
 108 # Determine the authentication username for commit privileges.
 109 # Untaint the REMOTE_USER environmental variable.
 110 my $username;
 111 if (defined $ENV{REMOTE_USER})
 112   {
 113     ($username) = $ENV{REMOTE_USER} =~ m/(\w+)/;
 114     unless (defined $username and length $username)
 115       {
 116         my_die "$0: REMOTE_USER set to `$ENV{REMOTE_USER}' but no valid ",
 117                "string extracted from it.\n";
 118       }
 119   }
 120 else
 121   {
 122     my_die "$0: the REMOTE_USER environmental variable is not set.\n";
 123   }
 124
 125 if ($opt_verbose)
 126   {
 127     print "I am logged in as `$username'.\n";
 128   }
 129
 130 # Load the source directory into Subversion.
 131 print "Now syncing Subversion repository with source directory.\n\n";
 132 my_system($svn_load_dirs,
 133           @opt_verbose,
 134           '-no_user_input',
 135           '-svn_username', $username,
 136           '-p', '/opt/i386-linux/installed/svn_load_dirs_property_table.cfg',
 137           $repos_base_uri,
 138           '.',
 139           $source_dirname) == 0
 140   or my_die "$0: system failed.  Quitting.\n";
 141
 142 print "\nNow syncing target directory with Subversion repository.\n\n";
 143
 144 chdir $target_dirname
 145   or my_die "$0: chdir `$target_dirname' failed: $!\n";
 146 my_system($svn, 'update', '.') == 0
 147   or my_die "$0: system failed.  Quitting.\n";
 148
 149 print "\nTarget directory sucessfully updated to mirror source directory.\n";
 150
 151 exit 0;
 152
 153 # Start a child process safely without using /bin/sh.
 154 sub safe_read_from_pipe
 155 {
 156   unless (@_)
 157     {
 158       croak "$0: safe_read_from_pipe passed no arguments.\n";
 159     }
 160
 161   if ($opt_verbose)
 162     {
 163       print "Running @_\n";
 164     }
 165
 166   my $pid = open(SAFE_READ, '-|');
 167   unless (defined $pid)
 168     {
 169       my_die "$0: cannot fork: $!\n";
 170     }
 171   unless ($pid)
 172     {
 173       open(STDERR, ">&STDOUT")
 174         or my_die "$0: cannot dup STDOUT: $!\n";
 175       exec(@_)
 176         or my_die "$0: cannot exec `@_': $!\n";
 177     }
 178   my @output;
 179   while (<SAFE_READ>)
 180     {
 181       chomp;
 182       push(@output, $_);
 183     }
 184   close(SAFE_READ);
 185   my $result = $?;
 186   my $exit   = $result >> 8;
 187   my $signal = $result & 127;
 188   my $cd     = $result & 128 ? "with core dump" : "";
 189   if ($signal or $cd)
 190     {
 191       print "$0: pipe from `@_' failed $cd: exit=$exit signal=$signal\n";
 192     }
 193   if (wantarray)
 194     {
 195       return ($result, @output);
 196     }
 197   else
 198     {
 199       return $result;
 200     }
 201 }
 202
 203 # Use safe_read_from_pipe to start a child process safely and exit the
 204 # script if the child failed for whatever reason.
 205 sub read_from_process
 206   {
 207   unless (@_)
 208     {
 209       croak "$0: read_from_process passed no arguments.\n";
 210     }
 211   my ($status, @output) = &safe_read_from_pipe(@_);
 212   if ($status)
 213     {
 214       my_die "$0: @_ failed with this output:\n", join("\n", @output), "\n";
 215     }
 216   else
 217     {
 218       return @output;
 219     }
 220 }
 221
 222 # Run system() and print warnings on system's return values.
 223 sub my_system
 224 {
 225   unless (@_)
 226     {
 227       confess "$0: my_system passed incorrect number of arguments.\n";
 228     }
 229
 230   if ($opt_verbose)
 231     {
 232       print "Running @_\n";
 233     }
 234
 235   my $result = system(@_);
 236   if ($result == -1)
 237     {
 238       print "$0: system(@_) call itself failed: $!\n";
 239     }
 240   elsif ($result)
 241     {
 242       my $exit_value  = $? >> 8;
 243       my $signal_num  = $? & 127;
 244       my $dumped_core = $? & 128;
 245
 246       my $message     = "$0: system(@_) exited with status $exit_value";
 247       if ($signal_num)
 248         {
 249           $message     .= " caught signal $signal_num";
 250         }
 251       if ($dumped_core)
 252         {
 253           $message     .= " and dumped core";
 254         }
 255       print "$message\n";
 256     }
 257
 258   $result;
 259 }