xref: /openbsd/libexec/security/security (revision 6d638812)
1#!/usr/bin/perl -T
2
3# $OpenBSD: security,v 1.46 2025/01/12 00:18:15 schwarze Exp $
4#
5# Copyright (c) 2011, 2012, 2014, 2015 Ingo Schwarze <schwarze@openbsd.org>
6# Copyright (c) 2011 Andrew Fresh <andrew@afresh1.com>
7#
8# Permission to use, copy, modify, and distribute this software for any
9# purpose with or without fee is hereby granted, provided that the above
10# copyright notice and this permission notice appear in all copies.
11#
12# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
13# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
14# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
15# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
16# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
17# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
18# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
19
20use warnings;
21use strict;
22
23use Digest::SHA qw(sha256_hex);
24use Errno qw(ENOENT);
25use Fcntl qw(O_RDONLY O_NONBLOCK :mode);
26use File::Basename qw(basename);
27use File::Compare qw(compare);
28use File::Copy qw(copy);
29require File::Find;
30
31use constant {
32	BACKUP_DIR => '/var/backups/',
33	RELINK_DIR => '/usr/share/relink/',
34};
35
36$ENV{PATH} = '/bin:/usr/bin:/sbin:/usr/sbin';
37delete $ENV{ENV};
38umask 077;
39
40my $check_title;
41my $return_code = 0;
42
43sub nag ($$) {
44	my ($cond, $msg) = @_;
45	if ($cond) {
46		if ($check_title) {
47			print "\n$check_title\n";
48			undef $check_title;
49		}
50		print "$msg\n";
51		$return_code = 1;
52	}
53	return $cond;
54}
55
56sub close_or_nag {
57	my ($fh, $cmd) = @_;
58	my $res = close $fh;
59	nag !$res, "$cmd: " .
60	    ($! ? "error closing pipe: $!" : "exit code " . ($? >> 8));
61	return $res;
62}
63
64sub check_access_file {
65	my ($filename, $login) = @_;
66	return unless -e $filename;
67	my $mode = (stat(_))[2];
68	nag $mode & (S_IRUSR | S_IRGRP | S_IROTH) && ! -O $filename,
69	    "Login $login is off but still has a valid shell " .
70	    "and alternate access files in\n" .
71	    "\t home directory are still readable.";
72}
73
74sub check_passwd {
75	my $filename = '/etc/master.passwd';
76	$check_title = "Checking the $filename file:";
77	nag !(open my $fh, '<', $filename), "open: $filename: $!" and return;
78	my (%logins, %uids);
79	while (my $line = <$fh>) {
80		chomp $line;
81		nag $line !~ /\S/,
82		    "Line $. is a blank line."
83		    and next;
84		my @f = split /:/, $line, -1;
85		nag @f != 10,
86		    "Line $. has the wrong number of fields:\n$line";
87		my ($name, $pwd, $uid, $gid, $class, $chg, $exp, $gecos,
88		    $home, $shell) = @f;
89		next if $name =~ /^[+-]/;  # skip YP lines
90		unless (nag $name eq '',
91		    "Line $. has an empty login field:\n$line") {
92			nag $name !~ /^[A-Za-z0-9_][-.A-Za-z0-9_]*\$?$/,
93			    "Login $name has non-alphanumeric characters.";
94			nag $logins{$name}++,
95			    "Duplicate user name $name.";
96		}
97		nag length $name > 31,
98		    "Login $name has more than 31 characters.";
99		nag $pwd eq '' && !($name eq 'anoncvs' &&
100				    $shell =~ /\/anoncvssh$/),
101		    "Login $name has no password.";
102		if ($pwd ne '' &&
103		    $pwd ne 'skey' &&
104		    length $pwd != 13 &&
105		    $pwd !~ /^\$[0-9a-f]+\$/ &&
106		    ($shell eq '' || $shell =~ /sh$/)) {
107			nag -s "/etc/skey/$name",
108			    "Login $name is off but still has a valid " .
109			    "shell and an entry in /etc/skey.";
110			nag -d $home && ! -r $home,
111			    "Login $name is off but still has valid " .
112			    "shell and home directory is unreadable\n" .
113			    "\t by root; cannot check for existence " .
114			    "of alternate access files."
115			or check_access_file "$home/.$_", $name
116			    foreach qw(ssh rhosts shosts);
117		}
118		nag $uid == 0 && $name ne 'root',
119		    "Login $name has a user ID of 0.";
120		nag $uid < 0,
121		    "Login $name has a negative user ID.";
122		nag $uids{$uid}++,
123		    "Login $name has duplicate user ID $uid.";
124		nag $gid < 0,
125		    "Login $name has a negative group ID.";
126		nag $exp != 0 && $exp < time,
127		    "Login $name has expired.";
128	}
129	close $fh;
130}
131
132# Backup the master password file; a special case, the normal backup
133# mechanisms also print out file differences and we don't want to do
134# that because this file has encrypted passwords in it.
135sub backup_passwd {
136	my $base = 'master.passwd';
137	my $orig = "/etc/$base";
138	my $curr = BACKUP_DIR . "$base.current";
139	if (!-s $curr) {
140		# nothing
141	} elsif (compare $curr, $orig) {
142		copy $curr, BACKUP_DIR . "$base.backup";
143	} else {
144		return;
145	}
146	copy $orig, $curr;
147	chown 0, 0, $curr;
148}
149
150# Check the group file syntax.
151sub check_group {
152	my $filename = '/etc/group';
153	$check_title = "Checking the $filename file:";
154	nag !(open my $fh, '<', $filename), "open: $filename: $!" and return;
155	my (%names, $global_yp);
156	while (my $line = <$fh>) {
157		chomp $line;
158		nag $global_yp,
159		    'Global YP inclusion ("+") is not the last line.'
160		    and undef $global_yp;
161		if ($line eq '+') {
162			$global_yp = 1;
163			next;
164		}
165		nag $line !~ /\S/,
166		    "Line $. is a blank line."
167		    and next;
168		my @f = split /:/, $line, -1;
169		nag @f != 4,
170		    "Line $. has the wrong number of fields:\n$line";
171		my ($name, $pwd, $gid, $members) = @f;
172		next if $name =~ /^[+-]/;  # skip YP lines
173		unless (nag $name eq '',
174		    "Line $. has an empty group name field:\n$line") {
175			nag $name !~ /^[A-Za-z0-9_][-.A-Za-z0-9_]*$/,
176			    "Group $name has non-alphanumeric characters.";
177			nag $names{$name}++,
178			    "Duplicate group name $name.";
179		}
180		nag length $name > 31,
181		    "Group $name has more than 31 characters.";
182		nag $gid =~ /[^\d]/,
183		    "Group $name has an invalid group ID.";
184	}
185	close $fh;
186}
187
188sub check_umask {
189	my ($filename) = @_;
190	nag !(open my $fh, '<', $filename), "open: $filename: $!" and return;
191	my $umaskset;
192	while (<$fh>) {
193		next unless /^\s*umask\s+([0-7]+)/;
194		my $umask = "0$1";
195		$umaskset = 1;
196		my ($other, $group) = reverse split '', $umask;
197		nag $group =~ /^[0145]$/,
198		    "Root umask is group writable";
199		nag $other =~ /^[0145]$/,
200		    "Root umask is other writable";
201	}
202	close $fh;
203	return $umaskset;
204}
205
206# This type of test by spawning a shell is messy and fragile.
207# Instead, consider modifying the shells to warn about '.' in the PATH.
208sub check_root_path {
209	my ($path, $filename) = @_;
210	nag !(defined $path && $path =~ s/^PATH=[:\s]*//),
211	    "Failed to find PATH in $filename."
212	    and return;
213	foreach my $dir (split /[:\s]+/, $path) {
214		nag $dir eq '.', "The root path includes ." and next;
215		next unless -d $dir;
216		my $mode = (stat(_))[2];
217		nag $mode & S_IWGRP,
218		    "Root path directory $dir is group writable.";
219		nag $mode & S_IWOTH,
220		    "Root path directory $dir is other writable.";
221	}
222}
223
224# Check for umask values and root paths in startup files.
225sub check_csh {
226	my @list = qw(/etc/csh.cshrc /etc/csh.login /root/.cshrc /root/.login);
227	$check_title = "Checking root csh paths, umask values:\n@list";
228
229	my $umaskset = 0;
230	foreach my $filename (@list) {
231		next unless -s $filename;
232		$umaskset = 1 if check_umask $filename;
233
234		nag !(open my $fh, '-|', qw(/bin/csh -f -c),
235			"eval 'source $filename' >& /dev/null; " .
236			"echo PATH=\$path"),
237		    "cannot spawn /bin/csh: $!"
238		    and next;
239		my @output = <$fh>;
240		close_or_nag $fh, "csh $filename" or next;
241		chomp @output;
242		check_root_path pop @output, $filename;
243	}
244	nag !$umaskset,
245	    "\nRoot csh startup files do not set the umask.";
246}
247
248sub check_sh {
249	my @list = qw(/etc/profile /root/.profile);
250	$check_title = "Checking root sh paths, umask values:\n@list";
251
252	my @env_path;
253	my $umaskset = 0;
254	foreach my $filename (@list) {
255		next unless -s $filename;
256		$umaskset ||= check_umask($filename);
257
258		nag !(open my $fh, '-|', qw(/bin/sh -c),
259			". $filename > /dev/null; " .
260			"echo ENV=\$ENV; echo PATH=\$PATH"),
261		    "cannot spawn /bin/sh: $!"
262		    and next;
263		my @output = <$fh>;
264		close_or_nag $fh, "sh $filename" or next;
265		chomp @output;
266		check_root_path pop @output, $filename;
267
268		my $env = pop @output;
269		nag !(defined $env && $env =~ /^ENV=\s*(\S*)/),
270		    "Failed to find ENV in $filename."
271		    and next;
272		push @env_path, $1 if $1 ne '';
273	}
274	nag !$umaskset,
275	    "\nRoot sh startup files do not set the umask.";
276	return @env_path;
277}
278
279sub check_ksh {
280	my @list = ('/etc/ksh.kshrc', @_);
281	$check_title = "Checking root ksh paths, umask values:\n@list";
282
283	# Usually, we are at HOME anyway, but for the ENV check, this
284	# is particularly important, so make sure we are really there.
285	chdir '/root';
286
287	# A good .kshrc will not have a umask or path,
288	# that being set in .profile; check anyway.
289	foreach my $filename (@list) {
290		next unless -s $filename;
291		check_umask($filename);
292
293		nag !(open my $fh, '-|', qw(/bin/ksh -c),
294			". $filename > /dev/null; echo PATH=\$PATH"),
295		    "cannot spawn /bin/ksh: $!"
296		    and next;
297		my @output = <$fh>;
298		close_or_nag $fh, "ksh $filename" or next;
299		chomp @output;
300		check_root_path pop @output, $filename;
301	}
302}
303
304# Uudecode should not be in the /etc/mail/aliases file.
305sub check_mail_aliases {
306	my $filename = '/etc/mail/aliases';
307	nag !(open my $fh, '<', $filename), "open: $filename: $!" and return;
308	no warnings 'uninitialized';
309	nag /^((?:uu)?decode)/,
310	    "There is an entry for $1 in the $filename file."
311	    while <$fh>;
312	close $fh;
313}
314
315# hostname.if files may contain secrets and should not be world-readable.
316sub check_hostname_if {
317	while (my $filename = glob '/etc/hostname.*') {
318		next unless -e $filename;
319		my $mode = (stat(_))[2];
320		nag $mode & S_IRWXO,
321		    "$filename is world readable.";
322	}
323}
324
325# hosts.lpd should not have + signs.
326sub check_hosts_lpd {
327	my $filename = '/etc/hosts.lpd';
328	-s $filename or return;
329	nag !(open my $fh, '<', $filename), "open: $filename: $!" and return;
330	nag /^\+/ && !/^\+@/,
331	    "Plus sign in $filename file."
332	    while <$fh>;
333	close $fh;
334}
335
336sub find_homes {
337	my $filename = '/etc/passwd';
338	nag !(open my $fh, '<', $filename),
339	    "open: $filename: $!"
340	    and return [];
341	my $homes = [];
342	while (<$fh>) {
343		my $entry = [ @{[split /:/]}[0,2,5] ];
344		chomp;
345		nag !defined $entry->[2],
346		    "Incomplete line \"$_\" in $filename."
347		    and next;
348		chomp $entry->[2];
349		push @$homes, $entry;
350	}
351	close $fh;
352	return $homes;
353}
354
355# Check for special users with .rhosts/.shosts files.
356# Only root should have .rhosts/.shosts files.
357sub check_rhosts_owner {
358	my ($name, $uid, $home) = @_;
359	return if $name =~ /^[+-]/;  # skip YP lines
360	foreach my $base (qw(rhosts shosts)) {
361		my $filename = "$home/.$base";
362		next unless -s $filename;
363		nag ! -O $filename &&
364		    ($name eq 'ftp' || ($uid < 100 && $name ne 'root')),
365		    "$filename is not owned by root.";
366	}
367}
368
369# Also, .rhosts/.shosts files should not have plus signs.
370sub check_rhosts_content {
371	my ($name, $uid, $home) = @_;
372	foreach my $base (qw(rhosts shosts)) {
373		my $filename = "$home/.$base";
374		next unless -s $filename;
375		nag !sysopen(my $fh, $filename, O_RDONLY | O_NONBLOCK),
376		    "open: $filename: $!"
377		    and next;
378		nag !(-f $fh),
379		    "$filename is not a regular file"
380		    and next;
381		local $_;
382		nag /^\+\s*$/,
383		    "$filename has + sign in it."
384		    while <$fh>;
385		close $fh;
386	}
387}
388
389# Home directories should not be owned by someone else or writeable.
390sub check_homedir {
391	my ($name, $uid, $home) = @_;
392	return if $name =~ /^[+-]/;  # skip YP lines
393	return unless -d $home;
394	my ($mode, $fuid) = (stat(_))[2,4];
395	nag $fuid && $fuid != $uid,
396	    "user $name home directory is owned by " .
397	    ((getpwuid $fuid)[0] // $fuid);
398	nag $mode & S_IWGRP,
399	    "user $name home directory is group writable";
400	nag $mode & S_IWOTH,
401	    "user $name home directory is other writable";
402}
403
404# Files that should not be owned by someone else or readable.
405sub check_dot_readable {
406	my ($name, $uid, $home) = @_;
407	return if $name =~ /^[+-]/;  # skip YP lines
408	foreach my $f (qw(
409	    .netrc .rhosts .gnupg/secring.gpg .gnupg/random_seed
410	    .pgp/secring.pgp .shosts .ssh/identity .ssh/id_dsa .ssh/id_ecdsa
411	    .ssh/id_rsa .ssh/id_ed25519
412	)) {
413		next unless -e "$home/$f";
414		my ($mode, $fuid) = (stat(_))[2,4];
415		nag $fuid && $fuid != $uid,
416		    "user $name $f file is owned by " .
417		    ((getpwuid $fuid)[0] // $fuid);
418		nag $mode & S_IRGRP,
419		    "user $name $f file is group readable";
420		nag $mode & S_IROTH,
421		    "user $name $f file is other readable";
422		nag $mode & S_IWGRP,
423		    "user $name $f file is group writable";
424		nag $mode & S_IWOTH,
425		    "user $name $f file is other writable";
426	}
427}
428
429# Files that should not be owned by someone else or writeable.
430sub check_dot_writeable {
431	my ($name, $uid, $home) = @_;
432	return if $name =~ /^[+-]/;  # skip YP lines
433	foreach my $f (qw(
434	    .bashrc .bash_profile .bash_login .bash_logout .cshrc
435	    .emacs .exrc .forward .fvwmrc .inputrc .kshrc .login
436	    .logout .nexrc .profile .screenrc .ssh .ssh/config
437	    .ssh/authorized_keys .ssh/authorized_keys2 .ssh/environment
438	    .ssh/known_hosts .ssh/rc .tcshrc .twmrc .xsession .xinitrc
439	    .Xdefaults .Xauthority
440        )) {
441		next unless -e "$home/$f";
442		my ($mode, $fuid) = (stat(_))[2,4];
443		nag $fuid && $fuid != $uid,
444		    "user $name $f file is owned by " .
445		    ((getpwuid $fuid)[0] // $fuid);
446		nag $mode & S_IWGRP,
447		    "user $name $f file is group writable";
448		nag $mode & S_IWOTH,
449		    "user $name $f file is other writable";
450	}
451}
452
453# Mailboxes should be owned by the user and unreadable.
454sub check_mailboxes {
455	my $dir = '/var/mail';
456	nag !(opendir my $dh, $dir), "opendir: $dir: $!" and return;
457	foreach my $name (readdir $dh) {
458		next if $name =~ /^\.\.?$/;
459		next if $name =~ /.\.lock$/;
460		next if $name eq 'quota.user';
461		next if $name eq 'quota.group';
462		my ($mode, $fuid, $fgid) = (stat "$dir/$name")[2,4,5];
463		unless (defined $mode) {
464			nag !$!{ENOENT}, "stat: $dir/$name: $!";
465			next;
466		}
467		next if S_ISDIR($mode);
468		my $fname = (getpwuid $fuid)[0] // $fuid;
469		my $gname = (getgrgid $fgid)[0] // $fgid;
470		nag $fname ne $name,
471		    "user $name mailbox is owned by $fname";
472		nag S_IMODE($mode) != (S_IRUSR | S_IWUSR),
473		    sprintf 'user %s mailbox is %s, group %s',
474		        $name, strmode($mode), $gname;
475	}
476	closedir $dh;
477}
478
479# File systems should not be globally exported.
480sub check_exports {
481	my $filename = '/etc/exports';
482	return unless -e $filename;
483	nag !(open my $fh, '<', $filename), "open: $filename: $!" and return;
484
485	LINE: while (<$fh>) {
486		chomp;
487		next if /^(?:#|$)/;
488
489		my @fs;
490		my $readonly = 0;
491		foreach (split) {
492			if (/^\//)                   { push @fs, $_; }
493			elsif ($_ eq '-ro')          { $readonly = 1; }
494			elsif (/^(?:[^-]|-network)/) { next LINE; }
495		}
496
497		nag 1, "File system @fs globally exported, "
498		    . ($readonly ? 'read-only.' : 'read-write.');
499	}
500	close $fh;
501}
502
503sub strmode_x {
504	my ($mode, $x, $s) = @_;
505	$x &= $mode;
506	$s &= $mode;
507	return ($x && $s) ? 's' : $x ? 'x' : $s ? 'S' : '-';
508}
509
510sub strmode {
511	my ($mode) = @_;
512
513	my %types = (
514		S_IFDIR,  'd',    # directory
515		S_IFCHR,  'c',    # character special
516		S_IFBLK,  'b',    # block special
517		S_IFREG,  '-',    # regular
518		S_IFLNK,  'l',    # symbolic link
519		S_IFSOCK, 's',    # socket
520		S_IFIFO,  'p',    # fifo
521	);
522
523	return
524	      ($types{ $mode & S_IFMT } || '?')
525	    . (($mode & S_IRUSR) ? 'r' : '-')
526	    . (($mode & S_IWUSR) ? 'w' : '-')
527	    . (strmode_x $mode, S_IXUSR, S_ISUID)
528	    . (($mode & S_IRGRP) ? 'r' : '-')
529	    . (($mode & S_IWGRP) ? 'w' : '-')
530	    . (strmode_x $mode, S_IXGRP, S_ISGID)
531	    . (($mode & S_IROTH) ? 'r' : '-')
532	    . (($mode & S_IWOTH) ? 'w' : '-')
533	    . (strmode_x $mode, S_IXOTH, S_ISVTX);
534}
535
536sub find_special_files {
537	my (%skip, @fs);
538
539	%skip = map { $_ => 1 } split ' ', $ENV{SUIDSKIP}
540	    if $ENV{SUIDSKIP};
541
542	# Add mount points of non-local file systems
543	# to the list of directories to skip.
544	nag !(open my $fh, '-|', 'mount'),
545	    "cannot spawn mount: $!"
546	    and return;
547	while (<$fh>) {
548		my ($path, $opt) = /\son\s+(.*?)\s+type\s+\w+(.*)/;
549		push @fs, $path if $path && $opt =~ /local/ &&
550		    !($opt =~ /nodev/ && $opt =~ /nosuid/);
551	}
552	close_or_nag $fh, "mount" or return;
553	return unless @fs;
554
555	my $setuid_files = {};
556	my $device_files = {};
557	my $uudecode_is_setuid = 0;
558
559	File::Find::find({no_chdir => 1, wanted => sub {
560
561		if ($skip{$_}) {
562			$File::Find::prune = 1;
563			return;
564		}
565
566		my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
567		    $atime, $mtime, $ctime, $blksize, $blocks) = lstat;
568		if (defined $dev) {
569			no warnings 'once';
570			if ($dev != $File::Find::topdev) {
571				$File::Find::prune = 1;
572				return;
573			}
574		} else {
575			nag !$!{ENOENT}, "stat: $_: $!";
576			return;
577		}
578
579		# SUID/SGID files
580		my $file = {};
581		if (-f _ && $mode & (S_ISUID | S_ISGID)) {
582			return if -e RELINK_DIR . $_;
583			$setuid_files->{$File::Find::name} = $file;
584			$uudecode_is_setuid = 1
585			    if basename($_) eq 'uudecode';
586		}
587
588		# Special Files
589		elsif (!-d _ && !-f _ && !-l _ && !-S _ && !-p _ ) {
590			$device_files->{$File::Find::name} = $file;
591			$file->{major} = (($rdev >> 8) & 0xff) . ',';
592			$file->{minor} = (($rdev >> 8) & 0xffff00) |
593			    ($rdev & 0xff);
594		} else {
595			return;
596		}
597
598		$file->{mode}    = $mode;
599		$file->{strmode} = strmode $mode;
600		$file->{nlink}   = $nlink;
601		$file->{user}    = (getpwuid $uid)[0] // $uid;
602		$file->{group}   = (getgrgid $gid)[0] // $gid;
603		$file->{size}    = $size;
604		@$file{qw(wday mon day time year)} =
605		    split ' ', localtime $mtime;
606	}}, @fs);
607
608	nag $uudecode_is_setuid, 'Uudecode is setuid.';
609	return $setuid_files, $device_files;
610}
611
612sub adjust_columns {
613	my (@table) = @_;
614
615	my @s;
616	foreach my $row (@table) {
617		for (0 .. $#$row) {
618			$s[$_] = length $row->[$_]
619			    if (!$s[$_] || length $row->[$_] > $s[$_]);
620		}
621	}
622	$s[-1] = '0';
623	my $fmt = join ' ', map { m/(\d+)/ && "%-$1s"} @s;
624
625	return map { sprintf $fmt, @$_ } @table;
626}
627
628# Display any changes in setuid/setgid files and devices.
629sub check_filelist {
630	my ($files, $mode) = @_;
631	my $current = BACKUP_DIR . "$mode.current";
632	my $backup  = BACKUP_DIR . "$mode.backup";
633	my @fields  = (
634	    qw(strmode nlink user group),
635	    $mode eq 'device' ?  qw(major minor) : 'size',
636	    qw(mon day time year)
637	);
638
639	my %current;
640	if (-s $current) {
641		nag !(open my $fh, '<', $current), "open: $current: $!"
642		    and return;
643		while (<$fh>) {
644			chomp;
645			my (%f, $file);
646			(@f{@fields}, $file) = split ' ', $_, @fields + 1;
647			$current{$file} = \%f;
648		}
649		close $fh;
650	}
651
652	my %changed;
653	foreach my $f (sort keys %$files) {
654		if (my $old = delete $current{$f}) {
655			next if $mode eq 'device' &&
656			    !S_ISBLK($files->{$f}{mode});
657			foreach my $k (@fields) {
658				next if $old->{$k} eq $files->{$f}{$k};
659				push @{$changed{changes}},
660				    [ @$old{@fields}, $f ],
661				    [ @{$files->{$f}}{@fields}, $f ];
662				last;
663			}
664			next;
665		}
666		push @{$changed{additions}}, [ @{$files->{$f}}{@fields}, $f ];
667	}
668	foreach my $f (sort keys %current) {
669		next if $mode eq 'setuid' && -e RELINK_DIR . $f;
670		push @{$changed{deletions}}, [ @{$current{$f}}{@fields}, $f ];
671	};
672
673	foreach my $k (qw( additions deletions changes )) {
674		next unless exists $changed{$k};
675		$mode = 'block device' if $mode eq 'device' && $k eq 'changes';
676		$check_title = (ucfirst $mode) . " $k:";
677		nag 1, $_ for adjust_columns @{$changed{$k}};
678	}
679
680	return if !%changed;
681	copy $current, $backup;
682
683	nag !(open my $fh, '>', $current), "open: $current: $!" and return;
684	print $fh "@{$files->{$_}}{@fields} $_\n" foreach sort keys %$files;
685	close $fh;
686}
687
688# Check for block and character disk devices that are readable or writeable
689# or not owned by root.operator.
690sub check_disks {
691	my ($files) = @_;
692
693	my $disk_re = qr/
694	    \/
695	    (?:ccd|dk|fd|hd|hk|hp|jb|kra|ra|rb|rd|rl|rx|rz|sd|up|vnd|wd|xd)
696	    \d+ [B-H]? [a-p]
697	    $
698	/x;
699
700	foreach my $file (sort keys %$files) {
701		next if $file !~ /$disk_re/;
702		my $f = $files->{$file};
703		nag $f->{user} ne 'root' || $f->{group} ne 'operator' ||
704			S_IMODE($f->{mode}) != (S_IRUSR | S_IWUSR | S_IRGRP),
705		    sprintf("Disk %s is user %s, group %s, permissions %s.",
706			$file, $f->{user}, $f->{group}, $f->{strmode});
707	}
708}
709
710# Check special files and system binaries.
711#
712# Create the mtree tree specifications using:
713#
714#       mtree -cx -p DIR -K sha256digest,type > /etc/mtree/DIR.secure
715#       chown root:wheel /etc/mtree/DIR.secure
716#       chmod 600 /etc/mtree/DIR.secure
717#
718# Note, this is not complete protection against Trojan horsed binaries, as
719# the hacker can modify the tree specification to match the replaced binary.
720# For details on really protecting yourself against modified binaries, see
721# the mtree(8) manual page.
722sub check_mtree {
723	nag !-d '/etc/mtree', '/etc/mtree is missing' and return;
724
725	if (open my $fh, '-|', qw(mtree -e -l -p / -f /etc/mtree/special)) {
726		nag 1, $_ for map { chomp; $_ } <$fh>;
727		close_or_nag $fh, "mtree special";
728	} else { nag 1, "cannot spawn mtree: $!"; }
729
730	while (my $filename = glob '/etc/mtree/*.secure') {
731		nag !(open my $fh, '<', $filename),
732		    "open: $filename: $!"
733		    and next;
734
735		my $tree;
736		while (<$fh>) {
737			last unless /^#/;
738			($tree) = /^#\s+tree:\s+(.*)/ and last;
739		}
740		next unless $tree;
741
742		$check_title = "Checking system binaries in $tree:";
743		nag !(open $fh, '-|', 'mtree', '-f', $filename, '-p', $tree),
744		    "cannot spawn mtree: $!"
745		    and next;
746		nag 1, $_ for map { chomp; $_ } <$fh>;
747		close_or_nag $fh, "mtree $filename";
748	}
749}
750
751sub diff {
752	nag !(open my $fh, '-|', qw(diff -ua), @_),
753	    "cannot spawn diff: $!"
754	    and return;
755	local $/;
756	my $diff = <$fh>;
757	{
758		close $fh and last;
759		nag $!, "diff: error closing pipe: $!" and last;
760		nag $? >> 8 > 1, "diff: exit code " . ($? >> 8);
761	}
762	return nag !!$diff, $diff;
763}
764
765sub backup_if_changed {
766	my ($orig) = @_;
767
768	my ($backup) = $orig =~ /(.*)/;
769	if (index $backup, BACKUP_DIR) {
770		$backup =~ s{^/}{};
771		$backup =~ s{/}{_}g;
772		$backup = BACKUP_DIR . $backup;
773	}
774	my $current = "$backup.current";
775	$backup .= '.backup';
776	my $last = -s $current ? $current : '/dev/null';
777	$orig    = '/dev/null' unless -s $orig;
778
779	diff $last, $orig or return;
780
781	if (-s $current) {
782		copy $current, $backup;
783		chown 0, 0, $backup;
784	}
785	if ($orig eq '/dev/null') {
786		unlink $current;
787	} else {
788		copy $orig, $current;
789		chown 0, 0, $current;
790	}
791}
792
793sub backup_digest {
794	my ($orig) = @_;
795
796	my ($backup) = $orig =~ m{^/?(.*)};
797	$backup =~ s{/}{_}g;
798	my $current = BACKUP_DIR . "$backup.current.sha256";
799	$backup = BACKUP_DIR . "$backup.backup.sha256";
800
801	my $digest_new = 0;
802	if (-s $orig) {
803		if (open my $fh, '<', $orig) {
804			binmode $fh;
805			local $/;
806			$digest_new = sha256_hex(<$fh>);
807			close $fh;
808		} else { nag 1, "open: $orig: $!"; }
809	}
810
811	my $digest_old = 0;
812	if (-s $current) {
813		if (open my $fh, '<', $current) {
814			$digest_old = <$fh>;
815			close $fh;
816			chomp $digest_old;
817		} else { nag 1, "open: $current: $!"; }
818	}
819
820	return if $digest_old eq $digest_new;
821
822	if ($digest_old && $digest_new) {
823		copy $current, $backup;
824		chown 0, 0, $backup;
825		chmod 0600, $backup;
826	} elsif ($digest_old) {
827		$check_title = "======\n$orig removed SHA-256 checksum\n======";
828		unlink $current;
829	} elsif ($digest_new) {
830		$check_title = "======\n$orig new SHA-256 checksum\n======";
831	}
832
833	if ($digest_new) {
834		if (open my $fh, '>', $current) {
835			print $fh "$digest_new\n";
836			close $fh;
837		} else { nag 1, "open: $current: $!\n"; }
838		chown 0, 0, $current;
839		chmod 0600, $current;
840	}
841
842	nag $digest_old, "OLD: $digest_old";
843	nag $digest_new, "NEW: $digest_new";
844}
845
846# List of files that get backed up and checked for any modifications.  Each
847# file is expected to have two backups, /var/backups/file.{current,backup}.
848# Any changes cause the files to rotate.
849sub check_changelist {
850	my $filename = '/etc/changelist';
851	-s $filename or return;
852	nag !(open my $fh, '<', $filename), "open: $filename: $!" and return;
853
854	my @relative;
855	while (<$fh>) {
856		next if /^(?:#|\s*$)/;
857		chomp;
858		my $plus = s/^\+//;
859		unless (/^\//) {
860			push @relative, $_;
861			next;
862		}
863		my $tilda = /~$/;
864
865		foreach (glob) {
866			next if $_ eq '/etc/master.passwd';
867			next if /~$/ && !$tilda;
868			next if -d $_;
869
870			if ($plus) {
871				$check_title =
872				    "======\n$_ SHA-256 checksums\n======";
873				backup_digest $_;
874			} else {
875				$check_title =
876				    "======\n$_ diffs (-OLD  +NEW)\n======";
877				backup_if_changed $_;
878			}
879		}
880	}
881	close $fh;
882
883	$check_title = "Skipped relative paths in changelist(5):";
884	nag 1, $_ foreach @relative;
885}
886
887# Make backups of the labels for any mounted disks
888# and produce diffs when they change.
889sub check_disklabels {
890	nag !(open my $fh, '-|', qw(df -ln)),
891	    "cannot spawn df: $!"
892	    and return;
893	my %disks;
894	@disks{map m{^/dev/(\w*\d*)[a-p]}, <$fh>} = ();
895	close_or_nag $fh, "df";
896
897	unless (nag !(open my $fh, '-|', qw(bioctl softraid0)),
898	    "cannot spawn bioctl: $!") {
899		@disks{map m{<(\w*\d*)[a-p]>}, <$fh>} = ();
900		close_or_nag $fh, "bioctl";
901	}
902
903	foreach my $disk (sort keys %disks) {
904		$check_title = "======\n$disk diffs (-OLD  +NEW)\n======";
905		my $filename = BACKUP_DIR . "disklabel.$disk";
906		system "disklabel $disk > $filename";
907		backup_if_changed $filename;
908		unlink $filename;
909		$filename = BACKUP_DIR . "fdisk.$disk";
910		system "fdisk -v $disk > $filename";
911		backup_if_changed $filename;
912		unlink $filename;
913	}
914}
915
916# Backup the list of installed packages and produce diffs when it changes.
917sub check_pkglist {
918	$check_title = "======\nPackage list changes (-OLD  +NEW)\n======";
919	my $filename = BACKUP_DIR . 'pkglist';
920	system "pkg_info > $filename 2>&1";
921	backup_if_changed $filename;
922	unlink $filename;
923}
924
925# main program
926check_passwd;
927backup_passwd;
928check_group;
929check_csh;
930check_ksh(check_sh);
931$check_title = "Checking configuration files:";
932check_mail_aliases;
933check_hostname_if;
934check_hosts_lpd;
935$check_title = "Checking for special users with .rhosts/.shosts files.";
936my $homes = find_homes;
937check_rhosts_owner @$_ foreach @$homes;
938$check_title = "Checking .rhosts/.shosts files syntax.";
939check_rhosts_content @$_ foreach @$homes;
940$check_title = "Checking home directories.";
941check_homedir @$_ foreach @$homes;
942$check_title = "Checking dot files.";
943check_dot_readable @$_ foreach @$homes;
944check_dot_writeable @$_ foreach @$homes;
945$check_title = "Checking mailbox ownership.";
946check_mailboxes;
947$check_title = "Checking for globally exported file systems.";
948check_exports;
949$check_title = "Setuid/device find errors:";
950my ($setuid_files, $device_files) = find_special_files;
951$check_title = "Checking setuid/setgid files and devices:";
952check_filelist $setuid_files, 'setuid' if $setuid_files;
953$check_title = "Checking disk ownership and permissions.";
954check_disks $device_files;
955check_filelist $device_files, 'device' if $device_files;
956$check_title = "Checking special files and directories.\n" .
957    "Output format is:\n\tfilename:\n\t\tcriteria (shouldbe, reallyis)";
958check_mtree;
959$check_title = "Backing up and comparing configuration files.";
960check_changelist;
961$check_title = "Checking disklabels of mounted disks:";
962check_disklabels;
963check_pkglist;
964exit $return_code;
965