1#! /usr/bin/env perl 2# Copyright 2016-2018 The OpenSSL Project Authors. All Rights Reserved. 3# 4# Licensed under the OpenSSL license (the "License"). You may not use 5# this file except in compliance with the License. You can obtain a copy 6# in the file LICENSE in the source distribution or at 7# https://www.openssl.org/source/license.html 8 9use strict; 10use warnings; 11 12use File::Spec::Functions; 13use File::Basename; 14use File::Copy; 15use File::Path; 16use FindBin; 17use lib "$FindBin::Bin/perl"; 18use OpenSSL::Glob; 19use Getopt::Long; 20use Pod::Usage; 21 22use lib '.'; 23use configdata; 24 25# We know we are in the 'util' directory and that our perl modules are 26# in util/perl 27use lib catdir(dirname($0), "perl"); 28use OpenSSL::Util::Pod; 29 30my %options = (); 31GetOptions(\%options, 32 'sourcedir=s', # Source directory 33 'section=i@', # Subdirectories to look through, 34 # with associated section numbers 35 'destdir=s', # Destination directory 36 #'in=s@', # Explicit files to process (ignores sourcedir) 37 'type=s', # The result type, 'man' or 'html' 38 'suffix:s', # Suffix to add to the extension. 39 # Only used with type=man 40 'remove', # To remove files rather than writing them 41 'dry-run|n', # Only output file names on STDOUT 42 'debug|D+', 43 ); 44 45unless ($options{section}) { 46 $options{section} = [ 1, 3, 5, 7 ]; 47} 48unless ($options{sourcedir}) { 49 $options{sourcedir} = catdir($config{sourcedir}, "doc"); 50} 51pod2usage(1) unless ( defined $options{section} 52 && defined $options{sourcedir} 53 && defined $options{destdir} 54 && defined $options{type} 55 && ($options{type} eq 'man' 56 || $options{type} eq 'html') ); 57pod2usage(1) if ( $options{type} eq 'html' 58 && defined $options{suffix} ); 59 60if ($options{debug}) { 61 print STDERR "DEBUG: options:\n"; 62 print STDERR "DEBUG: --sourcedir = $options{sourcedir}\n" 63 if defined $options{sourcedir}; 64 print STDERR "DEBUG: --destdir = $options{destdir}\n" 65 if defined $options{destdir}; 66 print STDERR "DEBUG: --type = $options{type}\n" 67 if defined $options{type}; 68 print STDERR "DEBUG: --suffix = $options{suffix}\n" 69 if defined $options{suffix}; 70 foreach (sort @{$options{section}}) { 71 print STDERR "DEBUG: --section = $_\n"; 72 } 73 print STDERR "DEBUG: --remove = $options{remove}\n" 74 if defined $options{remove}; 75 print STDERR "DEBUG: --debug = $options{debug}\n" 76 if defined $options{debug}; 77 print STDERR "DEBUG: --dry-run = $options{\"dry-run\"}\n" 78 if defined $options{"dry-run"}; 79} 80 81my $symlink_exists = eval { symlink("",""); 1 }; 82 83foreach my $section (sort @{$options{section}}) { 84 my $subdir = "man$section"; 85 my $podsourcedir = catfile($options{sourcedir}, $subdir); 86 my $podglob = catfile($podsourcedir, "*.pod"); 87 88 foreach my $podfile (glob $podglob) { 89 my $podname = basename($podfile, ".pod"); 90 my $podpath = catfile($podfile); 91 my %podinfo = extract_pod_info($podpath, 92 { debug => $options{debug}, 93 section => $section }); 94 my @podfiles = grep { $_ ne $podname } @{$podinfo{names}}; 95 96 my $updir = updir(); 97 my $name = uc $podname; 98 my $suffix = { man => ".$podinfo{section}".($options{suffix} // ""), 99 html => ".html" } -> {$options{type}}; 100 my $generate = { man => "pod2man --name=$name --section=$podinfo{section} --center=OpenSSL --release=$config{version} \"$podpath\"", 101 html => "pod2html \"--podroot=$options{sourcedir}\" --htmldir=$updir --podpath=man1:man3:man5:man7 \"--infile=$podpath\" \"--title=$podname\" --quiet" 102 } -> {$options{type}}; 103 my $output_dir = catdir($options{destdir}, "man$podinfo{section}"); 104 my $output_file = $podname . $suffix; 105 my $output_path = catfile($output_dir, $output_file); 106 107 if (! $options{remove}) { 108 my @output; 109 print STDERR "DEBUG: Processing, using \"$generate\"\n" 110 if $options{debug}; 111 unless ($options{"dry-run"}) { 112 @output = `$generate`; 113 map { s|href="http://man\.he\.net/(man\d/[^"]+)(?:\.html)?"|href="../$1.html"|g; } @output 114 if $options{type} eq "html"; 115 if ($options{type} eq "man") { 116 # Because some *roff parsers are more strict than others, 117 # multiple lines in the NAME section must be merged into 118 # one. 119 my $in_name = 0; 120 my $name_line = ""; 121 my @newoutput = (); 122 foreach (@output) { 123 if ($in_name) { 124 if (/^\.SH "/) { 125 $in_name = 0; 126 push @newoutput, $name_line."\n"; 127 } else { 128 chomp (my $x = $_); 129 $name_line .= " " if $name_line; 130 $name_line .= $x; 131 next; 132 } 133 } 134 if (/^\.SH +"NAME" *$/) { 135 $in_name = 1; 136 } 137 push @newoutput, $_; 138 } 139 @output = @newoutput; 140 } 141 } 142 print STDERR "DEBUG: Done processing\n" if $options{debug}; 143 144 if (! -d $output_dir) { 145 print STDERR "DEBUG: Creating directory $output_dir\n" if $options{debug}; 146 unless ($options{"dry-run"}) { 147 mkpath $output_dir 148 or die "Trying to create directory $output_dir: $!\n"; 149 } 150 } 151 print STDERR "DEBUG: Writing $output_path\n" if $options{debug}; 152 unless ($options{"dry-run"}) { 153 open my $output_fh, '>', $output_path 154 or die "Trying to write to $output_path: $!\n"; 155 foreach (@output) { 156 print $output_fh $_; 157 } 158 close $output_fh; 159 } 160 print STDERR "DEBUG: Done writing $output_path\n" if $options{debug}; 161 } else { 162 print STDERR "DEBUG: Removing $output_path\n" if $options{debug}; 163 unless ($options{"dry-run"}) { 164 while (unlink $output_path) {} 165 } 166 } 167 print "$output_path\n"; 168 169 foreach (@podfiles) { 170 my $link_file = $_ . $suffix; 171 my $link_path = catfile($output_dir, $link_file); 172 if (! $options{remove}) { 173 if ($symlink_exists) { 174 print STDERR "DEBUG: Linking $link_path -> $output_file\n" 175 if $options{debug}; 176 unless ($options{"dry-run"}) { 177 symlink $output_file, $link_path; 178 } 179 } else { 180 print STDERR "DEBUG: Copying $output_path to link_path\n" 181 if $options{debug}; 182 unless ($options{"dry-run"}) { 183 copy $output_path, $link_path; 184 } 185 } 186 } else { 187 print STDERR "DEBUG: Removing $link_path\n" if $options{debug}; 188 unless ($options{"dry-run"}) { 189 while (unlink $link_path) {} 190 } 191 } 192 print "$link_path -> $output_path\n"; 193 } 194 } 195} 196 197__END__ 198 199=pod 200 201=head1 NAME 202 203process_docs.pl - A script to process OpenSSL docs 204 205=head1 SYNOPSIS 206 207B<process_docs.pl> 208[B<--sourcedir>=I<dir>] 209B<--destdir>=I<dir> 210B<--type>=B<man>|B<html> 211[B<--suffix>=I<suffix>] 212[B<--remove>] 213[B<--dry-run>|B<-n>] 214[B<--debug>|B<-D>] 215 216=head1 DESCRIPTION 217 218This script looks for .pod files in the subdirectories 'apps', 'crypto' 219and 'ssl' under the given source directory. 220 221The OpenSSL configuration data file F<configdata.pm> I<must> reside in 222the current directory, I<or> perl must have the directory it resides in 223in its inclusion array. For the latter variant, a call like this would 224work: 225 226 perl -I../foo util/process_docs.pl {options ...} 227 228=head1 OPTIONS 229 230=over 4 231 232=item B<--sourcedir>=I<dir> 233 234Top directory where the source files are found. 235 236=item B<--destdir>=I<dir> 237 238Top directory where the resulting files should end up 239 240=item B<--type>=B<man>|B<html> 241 242Type of output to produce. Currently supported are man pages and HTML files. 243 244=item B<--suffix>=I<suffix> 245 246A suffix added to the extension. Only valid with B<--type>=B<man> 247 248=item B<--remove> 249 250Instead of writing the files, remove them. 251 252=item B<--dry-run>|B<-n> 253 254Do not perform any file writing, directory creation or file removal. 255 256=item B<--debug>|B<-D> 257 258Print extra debugging output. 259 260=back 261 262=head1 COPYRIGHT 263 264Copyright 2013-2018 The OpenSSL Project Authors. All Rights Reserved. 265 266Licensed under the OpenSSL license (the "License"). You may not use 267this file except in compliance with the License. You can obtain a copy 268in the file LICENSE in the source distribution or at 269https://www.openssl.org/source/license.html 270 271=cut 272