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