source: openpam/trunk/misc/gendoc.pl @ 283

Last change on this file since 283 was 283, checked in by Dag-Erling Smørgrav, 15 years ago

Numerous improvements inspired by comments from ru@. Mainly, this
fixes a couple of markup bugs, improves reference sorting, and
improves handling of function argument names (function pointer
arguments were not properly handled).

File size: 15.7 KB
Line 
1#!/usr/bin/perl -w
2#-
3# Copyright (c) 2002-2003 Networks Associates Technology, Inc.
4# All rights reserved.
5#
6# This software was developed for the FreeBSD Project by ThinkSec AS and
7# Network Associates Laboratories, the Security Research Division of
8# Network Associates, Inc.  under DARPA/SPAWAR contract N66001-01-C-8035
9# ("CBOSS"), as part of the DARPA CHATS research program.
10#
11# Redistribution and use in source and binary forms, with or without
12# modification, are permitted provided that the following conditions
13# are met:
14# 1. Redistributions of source code must retain the above copyright
15#    notice, this list of conditions and the following disclaimer.
16# 2. Redistributions in binary form must reproduce the above copyright
17#    notice, this list of conditions and the following disclaimer in the
18#    documentation and/or other materials provided with the distribution.
19# 3. The name of the author may not be used to endorse or promote
20#    products derived from this software without specific prior written
21#    permission.
22#
23# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
24# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
25# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
26# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
27# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
28# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
29# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
30# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
31# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
32# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
33# SUCH DAMAGE.
34#
35# $P4: //depot/projects/openpam/misc/gendoc.pl#29 $
36#
37
38use strict;
39use locale;
40use Fcntl;
41use Getopt::Std;
42use POSIX qw(locale_h strftime);
43use vars qw($COPYRIGHT $TODAY %FUNCTIONS %PAMERR);
44
45$COPYRIGHT = ".\\\"-
46.\\\" Copyright (c) 2001-2003 Networks Associates Technology, Inc.
47.\\\" All rights reserved.
48.\\\"
49.\\\" This software was developed for the FreeBSD Project by ThinkSec AS and
50.\\\" Network Associates Laboratories, the Security Research Division of
51.\\\" Network Associates, Inc. under DARPA/SPAWAR contract N66001-01-C-8035
52.\\\" (\"CBOSS\"), as part of the DARPA CHATS research program.
53.\\\"
54.\\\" Redistribution and use in source and binary forms, with or without
55.\\\" modification, are permitted provided that the following conditions
56.\\\" are met:
57.\\\" 1. Redistributions of source code must retain the above copyright
58.\\\"    notice, this list of conditions and the following disclaimer.
59.\\\" 2. Redistributions in binary form must reproduce the above copyright
60.\\\"    notice, this list of conditions and the following disclaimer in the
61.\\\"    documentation and/or other materials provided with the distribution.
62.\\\" 3. The name of the author may not be used to endorse or promote
63.\\\"    products derived from this software without specific prior written
64.\\\"    permission.
65.\\\"
66.\\\" THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
67.\\\" ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
68.\\\" IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
69.\\\" ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
70.\\\" FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
71.\\\" DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
72.\\\" OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
73.\\\" HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
74.\\\" LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
75.\\\" OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
76.\\\" SUCH DAMAGE.
77.\\\"
78.\\\" \$" . "P4" . "\$
79.\\\"";
80
81%PAMERR = (
82    PAM_SUCCESS                 => "Success",
83    PAM_OPEN_ERR                => "Failed to load module",
84    PAM_SYMBOL_ERR              => "Invalid symbol",
85    PAM_SERVICE_ERR             => "Error in service module",
86    PAM_SYSTEM_ERR              => "System error",
87    PAM_BUF_ERR                 => "Memory buffer error",
88    PAM_CONV_ERR                => "Conversation failure",
89    PAM_PERM_DENIED             => "Permission denied",
90    PAM_MAXTRIES                => "Maximum number of tries exceeded",
91    PAM_AUTH_ERR                => "Authentication error",
92    PAM_NEW_AUTHTOK_REQD        => "New authentication token required",
93    PAM_CRED_INSUFFICIENT       => "Insufficient credentials",
94    PAM_AUTHINFO_UNAVAIL        => "Authentication information is unavailable",
95    PAM_USER_UNKNOWN            => "Unknown user",
96    PAM_CRED_UNAVAIL            => "Failed to retrieve user credentials",
97    PAM_CRED_EXPIRED            => "User credentials have expired",
98    PAM_CRED_ERR                => "Failed to set user credentials",
99    PAM_ACCT_EXPIRED            => "User account has expired",
100    PAM_AUTHTOK_EXPIRED         => "Password has expired",
101    PAM_SESSION_ERR             => "Session failure",
102    PAM_AUTHTOK_ERR             => "Authentication token failure",
103    PAM_AUTHTOK_RECOVERY_ERR    => "Failed to recover old authentication token",
104    PAM_AUTHTOK_LOCK_BUSY       => "Authentication token lock busy",
105    PAM_AUTHTOK_DISABLE_AGING   => "Authentication token aging disabled",
106    PAM_NO_MODULE_DATA          => "Module data not found",
107    PAM_IGNORE                  => "Ignore this module",
108    PAM_ABORT                   => "General failure",
109    PAM_TRY_AGAIN               => "Try again",
110    PAM_MODULE_UNKNOWN          => "Unknown module type",
111    PAM_DOMAIN_UNKNOWN          => "Unknown authentication domain",
112);
113
114sub parse_source($) {
115    my $fn = shift;
116
117    local *FILE;
118    my $source;
119    my $func;
120    my $descr;
121    my $type;
122    my $args;
123    my $argnames;
124    my $man;
125    my $inlist;
126    my $inliteral;
127    my %xref;
128    my @errors;
129
130    if ($fn !~ m,\.c$,) {
131        warn("$fn: not C source, ignoring\n");
132        return undef;
133    }
134
135    sysopen(FILE, $fn, O_RDONLY)
136        or die("$fn: open(): $!\n");
137    $source = join('', <FILE>);
138    close(FILE);
139
140    return undef
141        if ($source =~ m/^ \* NOPARSE\s*$/m);
142
143    $func = $fn;
144    $func =~ s,^(?:.*/)?([^/]+)\.c$,$1,;
145    if ($source !~ m,\n \* ([\S ]+)\n \*/\n\n([\S ]+)\n$func\((.*?)\)\n\{,s) {
146        warn("$fn: can't find $func\n");
147        return undef;
148    }
149    ($descr, $type, $args) = ($1, $2, $3);
150    $descr =~ s,^([A-Z][a-z]),lc($1),e;
151    $descr =~ s,[\.\s]*$,,;
152    while ($args =~ s/^((?:[^\(]|\([^\)]*\))*),\s*/$1\" \"/g) {
153        # nothing
154    }
155    $args =~ s/,\s+/, /gs;
156    $args = "\"$args\"";
157
158    %xref = (
159        3 => { 'pam' => 1 },
160    );
161
162    if ($type eq "int") {
163        foreach (split("\n", $source)) {
164            next unless (m/^ \*\s+(!?PAM_[A-Z_]+|=[a-z_]+)\s*$/);
165            push(@errors, $1);
166        }
167        ++$xref{3}->{'pam_strerror'};
168    }
169
170    $argnames = $args;
171    # extract names of regular arguments
172    $argnames =~ s/\"[^\"]+\*?\b(\w+)\"/\"$1\"/g;
173    # extract names of function pointer arguments
174    $argnames =~ s/\"([\w\s\*]+)\(\*?(\w+)\)\([^\)]+\)\"/\"$2\"/g;
175    # escape metacharacters (there shouldn't be any, but...)
176    $argnames =~ s/([\|\[\]\(\)\.\*\+\?])/\\$1/g;
177    # separate argument names with |
178    $argnames =~ s/\" \"/|/g;
179    # and surround with ()
180    $argnames =~ s/^\"(.*)\"$/($1)/;
181    # $argnames is now a regexp that matches argument names
182    $inliteral = $inlist = 0;
183    foreach (split("\n", $source)) {
184        s/\s*$//;
185        if (!defined($man)) {
186            if (m/^\/\*\*$/) {
187                $man = "";
188            }
189            next;
190        }
191        last if (m/^ \*\/$/);
192        s/^ \* ?//;
193        s/\\(.)/$1/gs;
194        if (m/^$/) {
195            if ($man ne "" && $man !~ m/\.Pp\n$/s) {
196                if ($inliteral) {
197                    $man .= "\0\n";
198                } elsif ($inlist) {
199                    $man .= ".El\n.Pp\n";
200                    $inlist = 0;
201                } else {
202                    $man .= ".Pp\n";
203                }
204            }
205            next;
206        }
207        if (m/^>(\w+)(\s+\d)?$/) {
208            my ($page, $sect) = ($1, $2 ? int($2) : 3);
209            ++$xref{$sect}->{$page};
210            next;
211        }
212        if (s/^\s+(=?\w+):\s*/.It $1/) {
213            if ($inliteral) {
214                $man .= ".Ed\n";
215                $inliteral = 0;
216            }
217            if (!$inlist) {
218                $man =~ s/\.Pp\n$//s;
219                $man .= ".Bl -tag -width 18n\n";
220                $inlist = 1;
221            }
222            s/^\.It =([A-Z][A-Z_]+)$/.It Dv $1/gs;
223            $man .= "$_\n";
224            next;
225        } elsif ($inlist && m/^\S/) {
226            $man .= ".El\n.Pp\n";
227            $inlist = 0;
228        } elsif ($inliteral && m/^\S/) {
229            $man .= ".Ed\n";
230            $inliteral = 0;
231        } elsif ($inliteral) {
232            $man .= "$_\n";
233            next;
234        } elsif ($inlist) {
235            s/^\s+//;
236        } elsif (m/^\s+/) {
237            $man .= ".Bd -literal\n";
238            $inliteral = 1;
239            $man .= "$_\n";
240            next;
241        }
242        s/\s*=$func\b\s*/\n.Nm\n/gs;
243        s/\s*=$argnames\b\s*/\n.Fa $1\n/gs;
244        s/\s*=(struct \w+(?: \*)?)\b\s*/\n.Vt $1\n/gs;
245        s/\s*:([a-z_]+)\b\s*/\n.Va $1\n/gs;
246        s/\s*;([a-z_]+)\b\s*/\n.Dv $1\n/gs;
247        while (s/\s*=([a-z_]+)\b\s*/\n.Xr $1 3\n/s) {
248            ++$xref{3}->{$1};
249        }
250        s/\s*\"(?=\w)/\n.Do\n/gs;
251        s/\"(?!\w)\s*/\n.Dc\n/gs;
252        s/\s*=([A-Z][A-Z_]+)\b\s*(?![\.,:;])/\n.Dv $1\n/gs;
253        s/\s*=([A-Z][A-Z_]+)\b([\.,:;]+)\s*/\n.Dv $1 $2\n/gs;
254        s/\s*{([A-Z][a-z] .*?)}\s*/\n.$1\n/gs;
255        $man .= "$_\n";
256    }
257    if (defined($man)) {
258        if ($inlist) {
259            $man .= ".El\n";
260        }
261        if ($inliteral) {
262            $man .= ".Ed\n";
263        }
264        $man =~ s/(\n\.[A-Z][a-z] [\w ]+)\n([\.,:;-]\S*)\s*/$1 $2\n/gs;
265        $man =~ s/\s*$/\n/gm;
266        $man =~ s/\n+/\n/gs;
267        $man =~ s/\0//gs;
268        $man =~ s/\n\n\./\n\./gs;
269        chomp($man);
270    } else {
271        $man = "No description available.";
272    }
273
274    $FUNCTIONS{$func} = {
275        'source'        => $fn,
276        'name'          => $func,
277        'descr'         => $descr,
278        'type'          => $type,
279        'args'          => $args,
280        'man'           => $man,
281        'xref'          => \%xref,
282        'errors'        => \@errors,
283    };
284    if ($source =~ m/^ \* NODOC\s*$/m) {
285        $FUNCTIONS{$func}->{'nodoc'} = 1;
286    }
287    if ($source !~ m/^ \* XSSO \d/m) {
288        $FUNCTIONS{$func}->{'openpam'} = 1;
289    }
290    expand_errors($FUNCTIONS{$func});
291    return $FUNCTIONS{$func};
292}
293
294sub expand_errors($);
295sub expand_errors($) {
296    my $func = shift;           # Ref to function hash
297
298    my %errors;
299    my $ref;
300    my $fn;
301
302    if (defined($func->{'recursed'})) {
303        warn("$func->{'name'}(): loop in error spec\n");
304        return qw();
305    }
306    $func->{'recursed'} = 1;
307
308    foreach (@{$func->{'errors'}}) {
309        if (m/^(PAM_[A-Z_]+)$/) {
310            if (!defined($PAMERR{$1})) {
311                warn("$func->{'name'}(): unrecognized error: $1\n");
312                next;
313            }
314            $errors{$1} = 1;
315        } elsif (m/^!(PAM_[A-Z_]+)$/) {
316            # treat negations separately
317        } elsif (m/^=([a-z_]+)$/) {
318            $ref = $1;
319            if (!defined($FUNCTIONS{$ref})) {
320                $fn = $func->{'source'};
321                $fn =~ s/$func->{'name'}/$ref/;
322                parse_source($fn);
323            }
324            if (!defined($FUNCTIONS{$ref})) {
325                warn("$func->{'name'}(): reference to unknown $ref()\n");
326                next;
327            }
328            foreach (@{$FUNCTIONS{$ref}->{'errors'}}) {
329                $errors{$_} = 1;
330            }
331        } else {
332            warn("$func->{'name'}(): invalid error specification: $_\n");
333        }
334    }
335    foreach (@{$func->{'errors'}}) {
336        if (m/^!(PAM_[A-Z_]+)$/) {
337            delete($errors{$1});
338        }
339    }
340    delete($func->{'recursed'});
341    $func->{'errors'} = [ sort(keys(%errors)) ];
342}
343
344sub genxref($) {
345    my $xref = shift;           # References
346
347    my $mdoc = '';
348    my @refs = ();
349    foreach my $sect (sort(keys(%{$xref}))) {
350        foreach my $page (sort(keys(%{$xref->{$sect}}))) {
351            push(@refs, "$page $sect");
352        }
353    }
354    while ($_ = shift(@refs)) {
355        $mdoc .= ".Xr $_" .
356            (@refs ? " ,\n" : "\n");
357    }
358    return $mdoc;
359}
360
361sub gendoc($) {
362    my $func = shift;           # Ref to function hash
363
364    local *FILE;
365    my $mdoc;
366    my $fn;
367
368    return if defined($func->{'nodoc'});
369
370    $mdoc = "$COPYRIGHT
371.Dd $TODAY
372.Dt " . uc($func->{'name'}) . " 3
373.Os
374.Sh NAME
375.Nm $func->{'name'}
376.Nd $func->{'descr'}
377.Sh LIBRARY
378.Lb libpam
379.Sh SYNOPSIS
380.In sys/types.h
381.In security/pam_appl.h
382";
383    if ($func->{'name'} =~ m/_sm_/) {
384        $mdoc .= ".In security/pam_modules.h\n"
385    }
386    if ($func->{'name'} =~ m/openpam/) {
387        $mdoc .= ".In security/openpam.h\n"
388    }
389    $mdoc .= ".Ft \"$func->{'type'}\"
390.Fn $func->{'name'} $func->{'args'}
391.Sh DESCRIPTION
392$func->{'man'}
393";
394    if ($func->{'type'} eq "int") {
395        $mdoc .= ".Sh RETURN VALUES
396The
397.Nm
398function returns one of the following values:
399.Bl -tag -width 18n
400";
401        my @errors = @{$func->{'errors'}};
402        warn("$func->{'name'}(): no error specification\n")
403            unless(@errors);
404        foreach (@errors) {
405            $mdoc .= ".It Bq Er $_\n$PAMERR{$_}.\n";
406        }
407        $mdoc .= ".El\n";
408    } else {
409        if ($func->{'type'} =~ m/\*$/) {
410            $mdoc .= ".Sh RETURN VALUES
411The
412.Nm
413function returns
414.Dv NULL
415on failure.
416";
417        }
418    }
419    $mdoc .= ".Sh SEE ALSO\n" . genxref($func->{'xref'});
420    $mdoc .= ".Sh STANDARDS\n";
421    if ($func->{'openpam'}) {
422        $mdoc .= "The
423.Nm
424function is an OpenPAM extension.
425";
426    } else {
427        $mdoc .= ".Rs
428.%T \"X/Open Single Sign-On Service (XSSO) - Pluggable Authentication Modules\"
429.%D \"June 1997\"
430.Re
431";
432    }
433    $mdoc .= ".Sh AUTHORS
434The
435.Nm
436function and this manual page were developed for the
437.Fx
438Project by ThinkSec AS and Network Associates Laboratories, the
439Security Research Division of Network Associates, Inc.\& under
440DARPA/SPAWAR contract N66001-01-C-8035
441.Pq Dq CBOSS ,
442as part of the DARPA CHATS research program.
443";
444
445    $fn = "$func->{'name'}.3";
446    if (sysopen(FILE, $fn, O_RDWR|O_CREAT|O_TRUNC)) {
447        print(FILE $mdoc);
448        close(FILE);
449    } else {
450        warn("$fn: open(): $!\n");
451    }
452}
453
454sub readproto($) {
455    my $fn = shift;             # File name
456
457    local *FILE;
458    my %func;
459
460    sysopen(FILE, $fn, O_RDONLY)
461        or die("$fn: open(): $!\n");
462    while (<FILE>) {
463        if (m/^\.Nm ((?:open)?pam_.*?)\s*$/) {
464            $func{'Nm'} = $func{'Nm'} || $1;
465        } elsif (m/^\.Ft (\S.*?)\s*$/) {
466            $func{'Ft'} = $func{'Ft'} || $1;
467        } elsif (m/^\.Fn (\S.*?)\s*$/) {
468            $func{'Fn'} = $func{'Fn'} || $1;
469        }
470    }
471    close(FILE);
472    if ($func{'Nm'}) {
473        $FUNCTIONS{$func{'Nm'}} = \%func;
474    } else {
475        warn("No function found\n");
476    }
477}
478
479sub gensummary($) {
480    my $page = shift;           # Which page to produce
481
482    local *FILE;
483    my $upage;
484    my $func;
485    my %xref;
486
487    sysopen(FILE, "$page.3", O_RDWR|O_CREAT|O_TRUNC)
488        or die("$page.3: $!\n");
489
490    $upage = uc($page);
491    print FILE "$COPYRIGHT
492.Dd $TODAY
493.Dt $upage 3
494.Os
495.Sh NAME
496";
497    my @funcs = sort(keys(%FUNCTIONS));
498    while ($func = shift(@funcs)) {
499        print FILE ".Nm $FUNCTIONS{$func}->{'Nm'}";
500        print FILE " ,"
501                if (@funcs);
502        print FILE "\n";
503    }
504    print FILE ".Nd Pluggable Authentication Modules Library
505.Sh LIBRARY
506.Lb libpam
507.Sh SYNOPSIS\n";
508    if ($page eq 'pam') {
509        print FILE ".In security/pam_appl.h\n";
510    } else {
511        print FILE ".In security/openpam.h\n";
512    }
513    foreach $func (sort(keys(%FUNCTIONS))) {
514        print FILE ".Ft $FUNCTIONS{$func}->{'Ft'}\n";
515        print FILE ".Fn $FUNCTIONS{$func}->{'Fn'}\n";
516    }
517    while (<STDIN>) {
518        if (m/^\.Xr (\S+)\s*(\d)\s*$/) {
519            ++$xref{int($2)}->{$1};
520        }
521        print FILE $_;
522    }
523
524    if ($page eq 'pam') {
525        print FILE ".Sh RETURN VALUES
526The following return codes are defined by
527.In security/pam_constants.h :
528.Bl -tag -width 18n
529";
530        foreach (sort(keys(%PAMERR))) {
531            print FILE ".It Bq Er $_\n$PAMERR{$_}.\n";
532        }
533        print FILE ".El\n";
534    }
535    print FILE ".Sh SEE ALSO
536";
537    if ($page eq 'pam') {
538        ++$xref{3}->{'openpam'};
539    }
540    foreach $func (keys(%FUNCTIONS)) {
541        ++$xref{3}->{$func};
542    }
543    print FILE genxref(\%xref);
544    print FILE ".Sh STANDARDS
545.Rs
546.%T \"X/Open Single Sign-On Service (XSSO) - Pluggable Authentication Modules\"
547.%D \"June 1997\"
548.Re
549.Sh AUTHORS
550The OpenPAM library and this manual page were developed for the
551.Fx
552Project by ThinkSec AS and Network Associates Laboratories, the
553Security Research Division of Network Associates, Inc.\& under
554DARPA/SPAWAR contract N66001-01-C-8035
555.Pq Dq CBOSS ,
556as part of the DARPA CHATS research program.
557";
558    close(FILE);
559}
560
561sub usage() {
562
563    print(STDERR "usage: gendoc [-s] source [...]\n");
564    exit(1);
565}
566
567MAIN:{
568    my %opts;
569
570    usage()
571        unless (@ARGV && getopts("op", \%opts));
572    setlocale(LC_ALL, "en_US.ISO8859-1");
573    $TODAY = strftime("%B %e, %Y", localtime(time()));
574    $TODAY =~ s,\s+, ,g;
575    if ($opts{'o'} || $opts{'p'}) {
576        foreach my $fn (@ARGV) {
577            readproto($fn);
578        }
579        gensummary('openpam')
580            if ($opts{'o'});
581        gensummary('pam')
582            if ($opts{'p'});
583    } else {
584        foreach my $fn (@ARGV) {
585            my $func = parse_source($fn);
586            gendoc($func)
587                if (defined($func));
588        }
589    }
590    exit(0);
591}
Note: See TracBrowser for help on using the repository browser.