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

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

Update copyright and release notes.

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