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