--- loncom/build/lpml_parse.pl 2002/04/13 19:29:32 1.45 +++ loncom/build/lpml_parse.pl 2014/06/09 05:14:12 1.61 @@ -12,7 +12,7 @@ # The LearningOnline Network with CAPA # lpml_parse.pl - Linux Packaging Markup Language parser # -# $Id: lpml_parse.pl,v 1.45 2002/04/13 19:29:32 harris41 Exp $ +# $Id: lpml_parse.pl,v 1.61 2014/06/09 05:14:12 raeburn Exp $ # # Written by Scott Harrison, codeharrison@yahoo.com # @@ -47,6 +47,7 @@ # 12/2,12/3,12/4,12/5,12/6,12/13,12/19,12/29 - Scott Harrison # YEAR=2002 # 1/8,1/9,1/29,1/31,2/5,3/21,4/8,4/12 - Scott Harrison +# 4/21,4/26,5/19,5/23,10/13 - Scott Harrison # ### @@ -85,6 +86,7 @@ Usage is for lpml file to come in throug typical choices: default,redhat6.2,debian2.2,redhat7 4th argument is to manually specify a sourceroot. 5th argument is to manually specify a targetroot. +6th argument is to manually specify a shell. Only the 1st argument is mandatory for the program to run. @@ -99,7 +101,7 @@ END # ------------------------------------------------- Grab command line arguments my $mode=''; -if (@ARGV==5) { +if (@ARGV == 6 || @ARGV == 5) { $mode = shift @ARGV; } else { @@ -134,6 +136,11 @@ $targetroot=~s/\/$//; # remove trailing $sourcerootarg=$sourceroot; $targetrootarg=$targetroot; +my $shell = 'sh'; +if (@ARGV) { + $shell = shift @ARGV; +} + my $logcmd='| tee -a WARNINGS'; my $invocation; # Record how the program was invoked @@ -146,6 +153,7 @@ if ($mode eq 'install' or $mode eq 'conf # 3rd argument (distribution) is: $dist # 4th argument (sourceroot) is: described below # 5th argument (targetroot) is: described below +# 6th argument (shell) is: $shell END } @@ -298,6 +306,7 @@ my $directories; my $directory; my $targetdirs; my $targetdir; +my $protectionlevel; my $categoryname; my $description; my $files; @@ -311,6 +320,7 @@ my $targets; my $target; my $source; my $note; +my $installscript; my $build; my $buildlink; my $commands; @@ -351,6 +361,7 @@ $parser->{textify}={ category => \&format_category, abbreviation => \&format_abbreviation, targetdir => \&format_targetdir, + protectionlevel => \&format_protectionlevel, chown => \&format_chown, chmod => \&format_chmod, rpm => \&format_rpm, @@ -381,8 +392,10 @@ $parser->{textify}={ target => \&format_target, note => \&format_note, build => \&format_build, + installscript => \&format_installscript, status => \&format_status, dependencies => \&format_dependencies, + privatedependencies => \&format_privatedependencies, buildlink => \&format_buildlink, glob => \&format_glob, sourcedir => \&format_sourcedir, @@ -525,7 +538,7 @@ END print ' by Scott Harrison 2001'."\n"; print '# This file was automatically generated on '.`date`; print "\n".$invocation; - $lpml .= "SHELL=\"/bin/bash\"\n\n"; + $lpml .= "\n"; } elsif ($mode eq 'configinstall') { print '# LPML configuration file targets (configinstall).'."\n"; @@ -533,14 +546,14 @@ END print ' by Scott Harrison 2001'."\n"; print '# This file was automatically generated on '.`date`; print "\n".$invocation; - $lpml .= "SHELL=\"/bin/bash\"\n\n"; + $lpml .= "\n"; } elsif ($mode eq 'build') { $lpml = "# LPML build targets. Linux Packaging Markup Language,"; $lpml .= ' by Scott Harrison 2001'."\n"; $lpml .= '# This file was automatically generated on '.`date`; $lpml .= "\n".$invocation; - $lpml .= "SHELL=\"/bin/sh\"\n\n"; + $lpml .= "\n"; } else { return ''; @@ -639,6 +652,8 @@ sub format_category { my ($user,$group)=split(/\:/,$chown); $categoryhash{$category_att_name}='-o '.$user.' -g '.$group. ' -m '.$chmod; + $categoryhash{"chmod.".$category_att_name}=$chmod; + $categoryhash{"chown.".$category_att_name}=$chown; } return ''; } @@ -974,6 +989,9 @@ sub format_directories { elsif ($mode eq 'rpm_file_list') { return $text; } + elsif ($mode eq 'uninstall_shell_commands') { + return $text; + } else { return ''; } @@ -981,7 +999,7 @@ sub format_directories { # ---------------------------------------------------- Format directory section sub format_directory { my (@tokeninfo)=@_; - $targetdir='';$categoryname='';$description=''; + $targetdir='';$categoryname='';$description='';$protectionlevel=''; $parser->get_text('/directory'); $parser->get_tag('/directory'); $directory_count++; @@ -1015,6 +1033,36 @@ sub format_directory { elsif ($mode eq 'rpm_file_list') { return $targetroot.'/'.$targetdir."\n"; } + elsif ($mode eq 'uninstall_shell_commands') { + if ($protectionlevel eq 'never_delete') { + return 'echo "LEAVING BEHIND '.$targetroot.'/'.$targetdir. + ' which may have important data worth saving"'."\n"; + } + elsif ($protectionlevel eq 'weak_delete') { + if ($targetdir!~/\w/) { + die("targetdir=\"$targetdir\"! NEVER EVER DELETE THE WHOLE ". + "FILESYSTEM"."\n"); + } + return 'rm -Rvf -i '.$targetroot.'/'.$targetdir."\n"; + } + elsif ($protectionlevel =~ /never/) { + die("CONFUSING PROTECTION LEVEL \"$protectionlevel\" FOUND ". + "FOR directory $targetdir"."\n"); + } + elsif ($protectionlevel !~ + /^never_delete|weak_delete|modest_delete|strong_delete|absolute_delete$/) { + die("CONFUSING OR MISSING PROTECTION LEVEL \"$protectionlevel\" ". + "FOUND FOR directory $targetdir\n"); + } + else { + if ($targetdir!~/\w/) { + die("targetdir=\"$targetdir\"! NEVER EVER DELETE THE WHOLE ". + "FILESYSTEM"."\n"); + } + return 'rm -Rvf '.$targetroot.'/'.$targetdir. + "| grep 'removed directory'"."\n"; + } + } else { return ''; } @@ -1030,6 +1078,17 @@ sub format_targetdir { } return ''; } +# ---------------------------------------------- Format protectionlevel section +sub format_protectionlevel { + my @tokeninfo=@_; + $protectionlevel=''; + my $text=&trim($parser->get_text('/protectionlevel')); + if ($text) { + $parser->get_tag('/protectionlevel'); + $protectionlevel=$text; + } + return ''; +} # ------------------------------------------------- Format categoryname section sub format_categoryname { my @tokeninfo=@_; @@ -1056,7 +1115,10 @@ sub format_description { sub format_files { my $text=$parser->get_text('/files'); $parser->get_tag('/files'); - if ($mode eq 'html') { + if ($mode eq 'MANIFEST') { + return $text; + } + elsif ($mode eq 'html') { return $directories="\n
 
". "". "Files
 
". @@ -1096,11 +1158,11 @@ sub format_files { $tword=''; $tword=' alwaysrun' if $trigger eq 'always run'; if ($command!~/\s/) { $command=~s/\/([^\/]*)$//; - $command2="cd $command; sh ./$1;\\"; + $command2="cd $command; $shell ./$1;\\"; } else { $command=~s/(.*?\/)([^\/]+\s+.*)$/$1/; - $command2="cd $command; sh ./$2;\\"; + $command2="cd $command; $shell ./$2;\\"; } my $depstring; my $depstring2="\t\t\@echo '';\\\n"; @@ -1167,14 +1229,32 @@ sub format_links { sub format_file { my @tokeninfo=@_; $file=''; $source=''; $target=''; $categoryname=''; $description=''; - $note=''; $build=''; $status=''; $dependencies=''; + $note=''; $build=''; $status=''; $dependencies=''; $installscript=''; + $buildlink = ''; my $text=&trim($parser->get_text('/file')); my $buildtest; $file_count++; $categorycount{$categoryname}++; if ($source) { $parser->get_tag('/file'); - if ($mode eq 'html') { + if ($mode eq 'MANIFEST') { + my $command=$build; + if ($command!~/\s/) { + $command=~s/\/([^\/]*)$//; + } + else { + $command=~s/(.*?\/)([^\/]+\s+.*)$/$1/; + } + $command=~s/^$sourceroot\///; + my (@deps)=split(/\;/,$dependencies); + my $retval=join("\n",($source, + (map {"$command$_"} @deps))); + if ($tokeninfo[2]{type} eq 'private') { + return "\n"; + } + return $retval."\n"; + } + elsif ($mode eq 'html') { return ($file="\n". "". "