1#!/usr/bin/perl -w
2#-
3# Copyright (c) 2002-2003 Networks Associates Technology, Inc.
4# Copyright (c) 2004-2007 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 408 2007-12-21 11:36:24Z 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-2007 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}
602