http://qs321.pair.com?node_id=60797
Category: CGI Programming
Author/Contact Info Soren Andersen
Description:

Need to install Perl Modules Using FTP Without Having Shell Access?

This script does it for me. My provider has only `tar' on the PATH (no other usual binutils, like `gzip'), so I upload a tarball (not gzipped) to a special dir on my server. Then I go and manually enter a url with a query string like

http://yourserver/cgi-bin/rBuild.pl?archive=Text-Autoformat-1_02.tar
and there it goes. I get no interesting display back in the browser (yet*) but a "journal" page is created with a log of what happened for that module installation.

THIS IS A HUGE POTENTIAL SECURITY RISK.

Anyone messing around with this code is asking to get burned if they don't take the time to study, ask questions of senior monks (Merlyn ;-) and develop understanding of what issues my poor code has left unaddressed. Come up with more secure code if you survey this offering and find it wanting. I post for discussion, not adulation. Nor do I claim that this will work satisfactorily for anyone other than myself -- although I have a hunch it might.

This system requires you to also install `pmake' (Nick Ing-Simmons, CPAN) and the accompanying library "<CITE>Make.pm</CITE>" to your server manually first. And a module called "<CITE>Tie::STDERR</CITE>" which is another thing that is just about the coolest invention since sliced bread. And it most likely requires other things that this first write-up is going to overlook (humble apologies if so).

Soren
P.S.: I have, since posting, worked further on this application a lot and it now uses a client-pull META tag in the head to automatically take the admin-user to the "journal" (build log) page. See below in the head of the script code itself for a link to a url to see the latest version of <CITE>rBuild</CITE>.

2001-03-03 Edit by Corion : Changed mixup of PRE and CODE tags

 

#!/usr/local/bin/perl

#  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#  "rBuild", a Perl application for remote installation of
#  user-filesystem-level Perl modules on WWW servers.
#      l/m:  Sunday, February 25, 2001 3:52 PM
# The latest version of this program may be found <A HREF="http://www.
+wonderstorm.com/techstuff/rBuild.html">here</A>.
#  Copyright (c) 2001 Soren Andersen, All Rights Reserved.
#
# This script is Free Software, and may be freely redistributed or
# modified as defined in the Perl Artistic License. NO WARRENTY
# WHATSOEVER is given, neither express nor implied, not even a claim
# of merchandisability or fitness for a particular purpose. The USER
# of this software is ENTIRELY responsible for any damage it may do.
#  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

BEGIN {
 use vars qw/$start_Dir $toErrIsGiven $tmpDir $uplDir $hEADr/;
  if ($ENV{'DOCUMENT_ROOT'})  {
   $toErrIsGiven = $ENV{'DOCUMENT_ROOT'};
   $toErrIsGiven .= qq[/logs/remoteMake_log];
   $start_Dir = ($^O =~/mswin32/i)?  `cd`:`pwd`;
   chomp $start_Dir;
   require "$start_Dir/../lmods/Tie/STDERR.pm";
   import Tie::STDERR ">> $toErrIsGiven";
   open(LOG, ">>$toErrIsGiven") or
       die("Unable to open Error log \"$toErrIsGiven\": $!\n");
   require "$start_Dir/../lmods/File/PathConvert.pm";
   import File::PathConvert qw{realpath rel2abs joinpath};
   $tmpDir = $ENV{'DOCUMENT_ROOT'}. q[/secure/tmp];
   $uplDir = $ENV{'DOCUMENT_ROOT'}. q[/secure/tmp/upL];
   $hEADr  = qq[Content-type:   text/plain\n\n];
   $ENV{PATH} = ".:$ENV{PATH}";
   $^W = 0;
 } else {
   require "Tie/STDERR.pm";
   import Tie::STDERR '| D:\\cygwin\\bin\\less';
   require "File/PathConvert.pm";
   import File::PathConvert qw{realpath rel2abs joinpath};
   $start_Dir = $ENV{TMP};
   $tmpDir    = $ENV{TMP};
   $uplDir    = q[F:/temp/inst];
   $hEADr  = qq[\n Running local test:   $0\n\n];
   $^W = 1;
 }
   select STDERR;
   $|++;
   select STDOUT;
   $|++;
}

my $rel_libloc = ($start_Dir =~m@/cgi\-bin$@)?
         '../lmods' : $ENV{'DOCUMENT_ROOT'}.'/lmods';

use lib realpath("$start_Dir/../lmods");
use File::Basename;
use strict;
use vars qw{ $Source_Archive @StepWise @MMr @Make_Msgs $nl };
use subs qw{ UnDOS };

my $fontSize = ( $ENV{HTTP_USER_AGENT} and
     $ENV{HTTP_USER_AGENT} =~m@\Q] (@ )?
            'small' : 'x-small';
print $hEADr;

my %ArgUh;
  foreach my $item (split(/&/,$ENV{QUERY_STRING}))  {
     my ($name,$value) = split(/=/,$item,2);
     $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
     $ArgUh{$name} = $value;
  }

($Source_Archive = $ArgUh{'archive'}) or die $!;
my $blog = $start_Dir .q[/../lmods/buildjournal/].
     substr( $Source_Archive,0, rindex($Source_Archive, q[.]) ).
        q[.html];
open JOURNAL,qq[> $blog] or die 
      qq[We could not open an HTML "journal file" named "$blog"].
      qq[ to write to: $!];

$Source_Archive =  $uplDir .q[/]. $Source_Archive;
my $just_distn  = substr( $ArgUh{'archive'},0,
              rindex($ArgUh{'archive'},q[.]));

print JOURNAL<<THERE;

<HTML>
<HEAD>
<STYLE TYPE="text/css">
PRE   { font-family: verdana,"avant-garde",helvetica,arial,sans-serif;
        font-size: $fontSize;
 }
CODE  { font-family: "Lucida Console","Andale Mono",
"Courier Web","Courier New",mono;
        font-size: $fontSize;
 }
</STYLE>
</HEAD>
<BODY>
<H1>Build record for $just_distn</H1>
<H3>\@INC contains:</H3><BLOCKQUOTE>

THERE

print JOURNAL join qq[\n&lt;BR&gt;\n], @INC,
       qq[&lt;/BLOCKQUOTE&gt;&lt;/CODE&gt;\n&lt;HR&gt;\n];

my $make_target  = ($ArgUh{'target'})?
   [ $ArgUh{'target'} ] : [ 'test','pure_install' ];
@StepWise = @$make_target;
$nl = "\n";
my $abs_libloc = rel2abs( $rel_libloc,$start_Dir );
$ENV{PERL5LIB} = qq[$abs_libloc:]. $ENV{PERL5LIB};
my $tar_exe = ($ENV{'DOCUMENT_ROOT'})? q[tar] :
                             q[D:\\Cygwin\\bin\\tar.exe];
my $perl_exe = UnDOS($^X);
my $tar_cmd = q[xf];
my $makeMakefile_cmd = qq[Makefile.PL LIB=$abs_libloc ].
    qq[INSTALLMAN1DIR=$abs_libloc/man/man1 ].
    qq[INSTALLMAN3DIR=$abs_libloc/man/man3];
my $make_exe = "$start_Dir/pmake";

my $distdir = $tmpDir .q[/]. basename( $Source_Archive ); 
   $distdir = substr( $distdir,0,
                rindex($distdir,'.') );
      
 unless ($ArgUh{'target'} and (
       $ArgUh{'target'} eq 'clean' or
       $ArgUh{'target'} =~/dist/))     {
 (system( $tar_exe, $tar_cmd, $Source_Archive,
                      qq[-C], ReadiP($tmpDir))) and
              die "tarball unrolling failed:  $!";
   print JOURNAL qq[\n The distro dir just created by ],
              qq[<CITE>tar</CITE> is: $distdir\n];
   chdir $distdir or die $!;
#  HERE THE making of the Makefile HAPPENS
   @MMr = `$perl_exe -I$abs_libloc $makeMakefile_cmd`;
 } else {
   chdir $distdir or die qq[\nUnable to get into \$distdir ],
            qq["$distdir":\n$!];
 }

my ($rtv, $cmm); $rtv = 0;                # vvvvv
      while (($cmm=shift @StepWise) and defined($rtv))   {
          $rtv = open (PIPE, "$make_exe $cmm 2>&1 |");
             if (defined $rtv)                    {
                push @Make_Msgs, qq[\n\nIn process $rtv, ].
                   qq[got these messages back:\n\n];
              foreach my $proc_line (<PIPE>)        {
                  push @Make_Msgs, $proc_line;
              }
             } else {
                  warn qq[\nWhoa, we have not got a process going ],
                  qq[to get the pmake invocations working: $?];
             }
          close( PIPE );
      }

print LOG qq[\nDone. Here is the make-Makefile log:\n],
      $nl,'-' x 50,$nl, @MMr;

print JOURNAL $nl,
      '</PRE><HR><P>Done. Here is the make-Makefile log:</P><PRE>',
              $nl;
print JOURNAL @MMr;
print LOG     $nl,'-' x 50,$nl,@Make_Msgs;
print JOURNAL $nl,'</PRE><HR><P>Here is the ',
'output from the make command sequence:<PRE>',$nl;
print JOURNAL @Make_Msgs;
print JOURNAL "</PRE><HR></BODY></HTML>\n";

print qq[\nDone\n];
close LOG;
exit 0;


sub UnDOS  {

 my $revslashed = shift;
    $revslashed =~s@\\@/@g;
 return $revslashed;
}

#  THIS IS JUST FOR LOCAL TESTING
sub ReadiP  {

my $conversion;
my $inpath = UnDOS(shift);
 if ( $ENV{OS} and $ENV{OS} =~m@Windows@i ) {
     chomp($conversion = `D:\\cygwin\\bin\\cygpath -pau $inpath`);
     return $conversion;
 }
  return $inpath;
}


__END__
Replies are listed 'Best First'.
Re: rBuild hack
by merlyn (Sage) on Feb 26, 2001 at 20:47 UTC
    I'm not yet commenting on the security aspects here, but I do think your program would be substantially shorter if you simply used both CGI (for safely decoding the incoming parameters) and CPAN (to manage the fetch, unpack, and build), both of which are included in all modern Perl distributions.

    Thanks for the idea though. I'll probably do one myself using those modules and put it in a column, and credit you for inspiration. It's been added to my to-do list.

    -- Randal L. Schwartz, Perl hacker

[reply]
    A reply falls below the community's threshold of quality. You may see it by logging in.

Back to Code Catacombs