diff --git a/config/auto/perldoc.pm b/config/auto/perldoc.pm index 4d87aca..7e54156 100644 --- a/config/auto/perldoc.pm +++ b/config/auto/perldoc.pm @@ -66,24 +66,12 @@ E_NOTE foreach my $ops (@ops) { my $pod = $ops; $pod =~ s/\.ops$/.pod/; - if ( $new_perldoc ) { - $TEMP_pod_build .= <<"END"; + $TEMP_pod_build .= <<"END"; ops/$pod: ../src/ops/$ops -\t\$(PERLDOC) -ud ops/$pod ../src/ops/$ops +\t\$(PODEXTRACT) ../src/ops/$ops ops/$pod \t\$(CHMOD) 0644 ops/$pod \t\$(ADDGENERATED) "docs/\$\@" "[doc]" - -END - } - else { - $TEMP_pod_build .= <<"END"; -ops/$pod: ../src/ops/$ops -\t\$(PERLDOC) -u ../ops/$ops > ops/$pod -\t\$(CHMOD) 0644 ../ops/$pod -\t\$(ADDGENERATED) "docs/\$\@" "[doc]" - END - } } $conf->data->set( diff --git a/config/gen/makefiles/docs.in b/config/gen/makefiles/docs.in index 3e8c74b..4e8f35d 100644 --- a/config/gen/makefiles/docs.in +++ b/config/gen/makefiles/docs.in @@ -11,6 +11,7 @@ RM_RF = @rm_rf@ PERLDOC = @perldoc@ POD2MAN = @pod2man@ VERSION = @VERSION@@DEVEL@ +PODEXTRACT = $(PERL) ../tools/build/podextract.pl ADDGENERATED = $(PERL) ../tools/build/addgenerated.pl OPS_SUMMARY = ../tools/docs/ops_summary.pl @@ -63,8 +64,7 @@ doc-prep: $(TOUCH) doc-prep packfile-c.pod: ../src/packfile/api.c -#IF(new_perldoc): $(PERLDOC) -ud packfile-c.pod ../src/packfile/api.c -#ELSE: $(PERLDOC) -u ../src/packfile/api.c > packfile-c.pod + $(PODEXTRACT) ../src/packfile/api.c packfile-c.pod $(ADDGENERATED) "docs/$@" "[doc]" .pod.1 : # suffix rule (limited support) diff --git a/config/gen/makefiles/root.in b/config/gen/makefiles/root.in index c1f0c19..36e853a 100644 --- a/config/gen/makefiles/root.in +++ b/config/gen/makefiles/root.in @@ -115,6 +115,7 @@ LDFLAGS = @ldflags@ @ld_debug@ INNO_SETUP = iscc TEMPDIR = @tempdir@ RPATH_BLIB = @rpath_blib@ +PODEXTRACT = $(PERL) $(BUILD_TOOLS_DIR)/podextract.pl ADDGENERATED = $(PERL) $(BUILD_TOOLS_DIR)/addgenerated.pl #IF(darwin):export MACOSX_DEPLOYMENT_TARGET = @osx_version@ diff --git a/tools/build/podextract.pl b/tools/build/podextract.pl new file mode 100644 index 0000000..0979b6b --- /dev/null +++ b/tools/build/podextract.pl @@ -0,0 +1,75 @@ +#! perl + +=head1 NAME + +tools/build/podextract.pl + +=head1 DESCRIPTION + +Simple POD Extraction + +=head1 SYNOPSIS + +Previously: + + perldoc -ud $target $source + +or + + perldoc -u $source > $target + +Now: + + perl podextract.pl $source $target + +=head1 RATIONALE + +C does many things, and is somewhat complex. + +For instance, normally, + + perldoc perldoc + +Inspects various paths, and paths that are controlled by C<%ENV> to find relevant documentation for "perldoc". + +And because of this, it is a little security concious, and pre-emptively drops root to UID=nobody + +But Parrot is not using this feature of C + +Parrot is simply using C as a content filter to extract C from source files. + +And as such, it only needs the alternative function + + perldoc $PATH + +To work, which doesn't require C<%ENV>, and additionally, dropping root to C makes it impossible +for some parrot to invoke C on some systems, because it drops privelages and can then no longer read C<$source>, and can no longer write C<$target>. + +However, some means vendor tooling that B execute C as root, by proxy, C invoke C as root, and as such, invokes the security problem, which is impossible to work around. + +Given a simple C is not enough, because parent directories also are not readable or writeable by C, and additionally, vendor tooling causes fatal access violations when a process running as C even attempts to do directory lookaround ( which C does much of as part of C<%ENV> handling ) + +So this tool is simple: + +It takes the very core utility in C that parrot needed to utilize, and calls it directly. + +And this avoids the misguided attempts of increasing security, which simply does nothing useful. + +=cut + +use strict; +use warnings; + +if ( not $ARGV[1] ) { + die "pod_extract "; +} +if ( not -e $ARGV[0] ) { + die " $ARGV[0] does not exist"; +} +require Pod::Perldoc::ToPod; +my $parser = Pod::Perldoc::ToPod->new(); +open my $output, '>', $ARGV[1] or die "Cant write to $ARGV[1] $! $?"; +$parser->parse_from_file( $ARGV[0], $output ); + +1 +