Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

rBuild hack

by Intrepid (Deacon)
on Feb 26, 2001 at 04:28 UTC ( #60797=sourcecode: print w/ replies, xml ) Need Help??

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__

Comment on rBuild hack
Download Code
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

      I am honored, Merlyn. As to the matter of CGI.pm, I wasn't actually surprised you mentioned that .. I kind of anticipated that you might bring that up. Your point about CGI.pm's protection with incoming parameters is a good one.

      I'll admit that while I was writing this application it never occurred to me to use CGI.pm, and that alone shows how much I am fundamentally on a different page from a lot of senior perl hackers (when it comes to writing CGI applications). I think that state of affairs is a consequence of the happenstance that I learned HTML first, and Perl later, and learned HTML rather well (so that all the HTML I do tends to be done in a plain text editor, for instance). It's a matter of what approach and tools fit one's self most naturally. To me learning the CGI.pm methods feels like redundant effort -- to make a line break or a blockquote I have to use some CGI.pm syntax rather than what I can do without thought in HTML -- and that's clumsy enough to slow me down and frustrate me. But you've probably heard others before me say similar things.

      Regards,
      Soren

        Using CGI.pm to generate HTML has little benefit. Using CGI.pm to process CGI parameters, especially forms, is nearly a must if you want good portability and security.

                - tye (but my friends call me "Tye")

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://60797]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (13)
As of 2014-07-28 18:30 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (206 votes), past polls