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