diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2019-10-07 12:13:12 +0200 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2019-10-07 12:16:59 +0200 |
commit | 59065ff6e02b605cddb55c15436b294f553c8619 (patch) | |
tree | 71768453bb50b772a607a012a03365eb2c4cf745 /mansrv | |
parent | a928def5ed6fff777d32a19c635274aa33635655 (diff) | |
download | mansrv-59065ff6e02b605cddb55c15436b294f553c8619.tar.gz mansrv-59065ff6e02b605cddb55c15436b294f553c8619.tar.bz2 |
Various improvements
* mansrv: Interpret material appearing between {% and %}
in template files as Perl expression.
Avoid using hardcoded URLs.
Diffstat (limited to 'mansrv')
-rwxr-xr-x | mansrv | 70 |
1 files changed, 52 insertions, 18 deletions
@@ -19,9 +19,10 @@ use strict; | |||
19 | use File::Basename; | 19 | use File::Basename; |
20 | use sigtrap; | 20 | use sigtrap; |
21 | use Sys::Syslog; | 21 | use Sys::Syslog; |
22 | use Safe; | ||
22 | 23 | ||
23 | my $server = "mansrv"; | 24 | my $package_name = "mansrv"; |
24 | my $version = "1.0"; | 25 | our $VERSION = "1.1"; |
25 | my $cf = "/etc/mansrv.conf"; | 26 | my $cf = "/etc/mansrv.conf"; |
26 | 27 | ||
27 | our $docdir; | 28 | our $docdir; |
@@ -110,17 +111,34 @@ sub build_manpath() { | |||
110 | $ENV{'MANPATH'} = "$dirs:$ENV{'MANPATH'}" if ($dirs); | 111 | $ENV{'MANPATH'} = "$dirs:$ENV{'MANPATH'}" if ($dirs); |
111 | } | 112 | } |
112 | 113 | ||
114 | sub expand_template { | ||
115 | my ($comp, $code, $file, $line) = @_; | ||
116 | my $r = $comp->reval($code); | ||
117 | unless (defined($r)) { | ||
118 | syslog("LOG_ERR", "%s:%d: error expanding template expression %s", | ||
119 | $file, $line, $code); | ||
120 | $r = ''; | ||
121 | } | ||
122 | return $r; | ||
123 | } | ||
124 | |||
113 | sub interpret_file($$) { | 125 | sub interpret_file($$) { |
114 | my ($ofd, $file) = @_; | 126 | my ($ofd, $file) = @_; |
115 | my $ifd; | 127 | my $ifd; |
116 | 128 | ||
117 | open($ifd, $file) or syserror("cannot open $file: $!"); | 129 | open($ifd, $file) or syserror("cannot open $file: $!"); |
130 | my $s = new Safe 'Root' ; | ||
131 | %{$s->varglob('ENV')} = %ENV; | ||
132 | ${$s->varglob('TITLE')} = $ARGV[1]; | ||
133 | ${$s->varglob('SECTION')} = $ARGV[0]; | ||
134 | ${$s->varglob('PACKAGE')} = $package_name; | ||
135 | ${$s->varglob('VERSION')} = $VERSION; | ||
136 | ${$s->varglob('SERVER')} = "$proto://$ENV{SERVER_NAME}"; | ||
137 | |||
118 | while (<$ifd>) { | 138 | while (<$ifd>) { |
119 | s/\@TITLE\@/$ARGV[1]/g; | 139 | chomp; |
120 | s/\@SECTION\@/$ARGV[0]/g; | 140 | s/\{%(.*)%\}/expand_template($s, $1, $file, $.)/ex; |
121 | s/\@SERVER\@/$server/g; | 141 | print $ofd "$_\n"; |
122 | s/\@VERSION\@/$version/g; | ||
123 | print $ofd $_; | ||
124 | } | 142 | } |
125 | close($ifd); | 143 | close($ifd); |
126 | } | 144 | } |
@@ -159,9 +177,7 @@ sub checkdeps($) { | |||
159 | 177 | ||
160 | # ############################################################################# | 178 | # ############################################################################# |
161 | 179 | ||
162 | my $script; # This script name. | 180 | openlog(basename($0), "ndelay,pid", "daemon"); |
163 | ($script = $0) =~ s/.*\///; | ||
164 | openlog($script, "ndelay,pid", "daemon"); | ||
165 | 181 | ||
166 | if ($ENV{'MANSRV_CONF'}) { | 182 | if ($ENV{'MANSRV_CONF'}) { |
167 | $cf = $ENV{'MANSRV_CONF'}; | 183 | $cf = $ENV{'MANSRV_CONF'}; |
@@ -178,11 +194,21 @@ if ($manref =~ /\?$/) { | |||
178 | } | 194 | } |
179 | 195 | ||
180 | # Set up environment | 196 | # Set up environment |
181 | &build_manpath; | 197 | build_manpath(); |
198 | |||
199 | my $proto; | ||
200 | if (exists($ENV{HTTP_X_FORWARDED_PROTO})) { | ||
201 | $proto = $ENV{HTTP_X_FORWARDED_PROTO}; | ||
202 | } elsif ($ENV{HTTPS} eq 'on') { | ||
203 | $proto = 'https'; | ||
204 | } else { | ||
205 | $proto = 'http'; | ||
206 | } | ||
207 | $ENV{REQUEST_SCHEME} = $proto; | ||
182 | $ENV{'MANCGI'}='WEBDOC'; | 208 | $ENV{'MANCGI'}='WEBDOC'; |
183 | 209 | ||
184 | if ($#ARGV != 1) { | 210 | if ($#ARGV != 1) { |
185 | print "Location: http://man.gnu.org.ua\n"; | 211 | print "Location: $ENV{REQUEST_SCHEME}://$ENV{SERVER_NAME}\n"; |
186 | print "\n"; | 212 | print "\n"; |
187 | exit 0; | 213 | exit 0; |
188 | } | 214 | } |
@@ -457,24 +483,32 @@ Include path for B<groff> (list of directories separated with semicolons). | |||
457 | =head1 TEMPLATE SUBSTITUTIONS | 483 | =head1 TEMPLATE SUBSTITUTIONS |
458 | 484 | ||
459 | While interpreting the contents of the files B<htmltop>, B<htmlbot> and | 485 | While interpreting the contents of the files B<htmltop>, B<htmlbot> and |
460 | B<errpage>, the following character sequences are removed and replaced with | 486 | B<errpage>, the material between B<{%> and B<%}> is evaluated as a Perl |
461 | the corresponding expansions: | 487 | expression. It can make references to the following variables: |
462 | 488 | ||
463 | =over 4 | 489 | =over 4 |
464 | 490 | ||
465 | =item B<@SERVER@> | 491 | =item B<$PACKAGE> |
466 | 492 | ||
467 | Canonical name of the program (B<mansrv>). | 493 | Canonical name of the program (B<mansrv>). |
468 | 494 | ||
469 | =item B<@VERSION@> | 495 | =item B<$VERSION> |
470 | 496 | ||
471 | Version of B<mansrv>. | 497 | Version of B<mansrv>. |
472 | 498 | ||
473 | =item B<@TITLE@> | 499 | =item B<%ENV> |
500 | |||
501 | Trimmed environment from the master process. | ||
502 | |||
503 | =item B<$SERVER> | ||
504 | |||
505 | Base server URL. | ||
506 | |||
507 | =item B<$TITLE> | ||
474 | 508 | ||
475 | Manpage title. | 509 | Manpage title. |
476 | 510 | ||
477 | =item B<@SECTION@> | 511 | =item B<$SECTION> |
478 | 512 | ||
479 | Requested manpage section. | 513 | Requested manpage section. |
480 | 514 | ||