\n" )
if $debug ;
$log_debug ||= (
$cgi->param( 'log_debug' ) ||
grep( /^log_debug$/i, $cgi->keywords() ) ||
$debug
) ;
$force ||= $cgi->param( 'force' ) || grep( /^force$/i, $cgi->keywords() ) ;
print_debug( 'force', 'yes' ) if $force ;
$project = $cgi->param( 'project' ) ;
print_debug( 'project', $project ) ;
#
# Acquire targets
#
@targets = () ;
@targets = split( /\s*,\s*/, $cgi->param( 'targets' ) )
if defined $cgi->param( 'targets' ) ;
@targets =
grep( ! /^((log_)?debug|debug_make|force|dump_env)$/i, $cgi->keywords() )
unless @targets ;
my $path_info = $cgi->path_info() ;
@targets = ( $path_info )
if length( $path_info ) && ! @targets ;
#
# If no project specified yet, see if the first dirname in the first
# target matches the name of a subdir (ie project name) under the config dir.
# If it does, then that's our project name, so peel it off.
# Assume all targets begin with project name in this case, and that
# all targets are in the same project. Should be an error if targets
# are in different project.
#
if ( ! defined $project && @targets && length( $targets[0] ) ) {
my ( $first_target_dir ) = $targets[0] =~ m@^/([^/]*)/@ ;
if ( length( $first_target_dir ) && -d "$config_dir/$first_target_dir" ) {
$project = $first_target_dir ;
for ( @targets ) {
s@^/([^/]*)@@ ;
my $other_project = $1 ;
error( "Targets in different projects: $project and $other_project" )
unless $other_project eq $project ;
}
print_debug( 'project', $project ) ;
}
}
print_debug( 'Raw Targets', \@targets ) ;
$result_mode = lc( $cgi->param( 'result' ) )
if (
defined( $cgi->param( 'result' ) ) &&
$cgi->param( 'result' ) =~ /^(make|targets?)$/i
) ;
if ( $dump_env ) {
for ( sort keys %ENV ) {
print_debug( $_, $ENV{$_} ) ;
}
}
configure() ;
#
#
#############################################################################
#############################################################################
#
# The main body
#
#
# Let mod_perl send things as soon as we print them
#
local $| = 1 ;
open( LOG, ">>/home/httpd_mod_perl/logs/cgimake.$$" ) ;
$orig_cwd = cwd() ;
chdir( $work_root ) ;
map{ $_ = &target_fixup ; } @targets ;
error( "No targets to make" )
unless ( @targets ) ;
print_debug( 'Edited Targets', \@targets ) ;
map {
$_ =~ s@(.*)/$@_dir$1/index.html@ ;
$_ = $output_root . $_ ;
} @targets ;
print_debug( 'Final Targets', \@targets ) ;
if ( $lock_mode =~ /^targets?$/ ) {
for ( @targets ) {
get_lock( $_ ) ;
}
}
elsif ( $lock_mode eq 'global' ) {
get_lock( '/global' ) ;
}
$command_line = join(
' ',
(
$make_path,
$make_options . ( $debug_make ? " -d" : "" ),
@targets,
'2>&1'
)
) ;
print_debug( 'Command Line', $command_line ) ;
unless ( $result_mode eq 'nomake' ) {
if ( $make_target_dirs ) {
my @errors ;
for ( @targets ) {
my $target_dir = dirname( $_ ) ;
next if -d $target_dir ;
if ( -e $target_dir ) {
push(@errors,"Couldn't make directory '$target_dir': file exists");
}
else {
mkpath( $target_dir, $debug, 0750 ) ;
push( @errors, "Couldn't make directory '$target_dir': $!" )
unless -d $target_dir ;
}
}
error( @errors ) if @errors ;
}
for ( @targets ) {
if ( -e $_ ) {
if ( $force ) {
print_debug( undef, "unlinking $_ due to force option" ) ;
unlink( $_ ) || error( "unlink $_ (force): $!" ) ;
}
elsif ( -s $_ < 20 ) {
print_debug( undef, "unlinking $_ due to size" . -s $_ ) ;
unlink( $_ ) || error( "unlink $_ (size): $!" ) ; ;
}
}
}
my %old_env = %ENV ;
my $path = $ENV{PATH} ;
$ENV{PATH} = join( ':', @path_prefix, $ENV{PATH} ) ;
$ENV{CGIMAKE_PROJECT} = $project ;
$ENV{CGIMAKE_CONFIG_DIR} = $config_dir ;
%ENV = ( %ENV, %env_override )
if %env_override ;
if ( $dump_env ) {
for ( sort keys %ENV ) {
print_debug( $_, $ENV{$_} ) ;
}
}
$make_stdout = `$command_line` ;
%ENV = %old_env ;
}
print_debug( 'Make stdout', $make_stdout ) ;
error( qq{make returned $?
Command Line:
'$command_line'
Output:
'$make_stdout'
} )
if $? ;
if ( $result_mode =~ /^(targets?|nomake)$/ ) {
$found = 0 ;
for ( @targets ) {
if ( -e $_ ) {
# if ( ( -s $_ ) < 20 ) {
# print_debug( undef, "unlinking $_ due to size " . -s $_ ) ;
# unlink( $_ ) || error( "unlinking $_: $!" ) ;
# next ;
# }
++$found ;
print( "From '$_':
\n
$title::
",
'
' , ; } print( join( "\n", @message ) ) ; print '' ; chdir( $orig_cwd ) ; $in_error = 0 ; my_exit( 0 ) ; } my @locks ; sub get_lock { my $lock_file_name = shift ; my $lock_file_name = "$lock_root/$lock_file_name" ; print_debug( "Locking", $lock_file_name ) ; my $lock_file_dir = dirname( $lock_file_name ) ; unless ( -d $lock_file_dir ) { mkpath( $lock_file_dir, $debug, 0750 ) ; error( "couldn't create '$lock_file_dir'" ) unless -d $lock_file_dir ; } $lock_file_name .= ".dir_lock" if -d $lock_file_name || $lock_file_name =~ m@/$@ ; open( LOCKFILE, ">$lock_file_name" ) or error( "couldn't open $lock_file_name: $!" ) ; eval { flock( LOCKFILE, LOCK_EX ) or die $! ; } ; error( "couldn't lock $lock_file_name: $@" ) if $@ ; push( @locks, { FH => \*LOCKFILE, NAME => $lock_file_name } ) ; } sub unlock_all { my @errors ; while ( @locks ) { my $hash = pop @locks ; print_debug( "Unlocking", $hash->{NAME} ) ; eval { flock( $hash->{FH}, LOCK_UN ) or die $! ; } ; error( "couldn't unlock " . $hash->{NAME} . ": $@" ) if $@ ; } error ( @errors ) if @errors ; } sub configure { $output_root = 'http' ; $lock_root = 'lock' ; $lock_mode = 'global' ; @path_prefix = ( "bin" ) ; %env_override = () ; sub target_fixup { return $_ } ; read_config( "$config_dir/$progname.conf" ) ; read_config( "$config_dir/$project/$progname.conf" ) if defined( $project ) && length( $project ) ; # We don't absolutify $output_root, since we chdir() there. $lock_root = absolutify( $work_root, $lock_root ) ; map{ $_ = absolutify( $config_dir, $_ ) } @path_prefix ; map { eval( "print_debug( '$_', $_ )" ) ; } sort( qw( $work_root $lib_root $output_root $lock_root $lock_mode $make_path $make_options $result_mode ) ) ; } sub absolutify { my ( $base, $path ) = @_ ; return ( substr( $path, 0, 1 ) eq '/' ) ? $path : "$base/$path" ; } sub my_exit{ # Apache::exit(-2) will cause the server to exit gracefully, # once logging happens and protocol, etc (-2 == Apache::Constants::DONE) $USE_MOD_PERL ? Apache::exit($_[0]) : CORE::exit($_[0]); } =head1 NAME cgimake - use make as a cgi-bin script coordinator =head1 DESCRIPTION This script is alpha level. See L for more information. cgimake is a wrapper around make that allows make to be used as a cgi-bin program. This allows several convenient things: =over =item optimizing multistep processing Multi-step processes that end in cgi-bin script being called can be broken apart using dependencies so that the whole process need not be run every time. This is most useful for when several cgi-bin scripts share intermediate files produced by (often slow) backend processes which can also be called from make. =item caching output from other cgi-bin scripts cgimake can cache the output from existing (slow) cgi-bin programs and only run them when necessary. This needs a few things worked out to make it work fully. =item web site updates If you keep web materials in an archival system (like CVS), cgimake can be used to automatically check out the latest version whenever a new version gets checked in. This can be done for every request, or by using a form as a control panel and doing the checkouts by submitting the form. =item standard Makefile syntax Since this currently uses an existing make, most of the configuration takes place by writing a Makefile. The primary limitation in caching scenarios is that the GNU pattern (%) rules are often necessary. In some cases, implicit rules can be used to do this. =back Rudimentary locking facilities are provided, see the source code. =head1 TODO =over =item mod_perl support Needed for performance reasons. =item * Improved documentation. A lot of it. =item * Integration with GNU compatible Make.pm (which is not in general release yet). This should allow fine-grained locking and access to perlish extensions to GNU Make. =item * Extensions to allow calling other cgi-bin programs to use as a caching mechanism. I think the main issue here is coming up with a way of mapping query data for GET methods (at least) in to unique filenames to use to hold the cached output from whatever cgi-bin program's being called. =item * Use File::Spec for portability and for preventing odd behavior if symbolic links are used in building cgimake's working directories. =item * Better handling of '..' in requested targets. Currently they're forbidden, but they should be allowed in cases where they aren't a security hazard. They are OK whenever they don't try to updir out of the working directories. =back =head1 PREREQUISITES A recent perl with standard packages, and a make program that supports GNU make's pattern rule syntax. =head1 COREQUISITES CGI =pod OSNAMES Unix, Win32 =pod SCRIPT CATEGORIES CGI =cut