mirror of
https://gitlab.com/apparmor/apparmor.git
synced 2025-03-04 16:35:02 +01:00
6695 lines
214 KiB
Perl
Executable file
6695 lines
214 KiB
Perl
Executable file
# $Id$
|
|
#
|
|
# ----------------------------------------------------------------------
|
|
# Copyright (c) 2006 Novell, Inc. All Rights Reserved.
|
|
#
|
|
# This program is free software; you can redistribute it and/or
|
|
# modify it under the terms of version 2 of the GNU General Public
|
|
# License as published by the Free Software Foundation.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this program; if not, contact Novell, Inc.
|
|
#
|
|
# To contact Novell about this file by physical or electronic mail,
|
|
# you may find current contact information at www.novell.com.
|
|
# ----------------------------------------------------------------------
|
|
|
|
package Immunix::SubDomain;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Carp;
|
|
use Cwd qw(cwd realpath);
|
|
use File::Basename;
|
|
use File::Temp qw/ tempfile tempdir /;
|
|
use Data::Dumper;
|
|
|
|
use Locale::gettext;
|
|
use POSIX;
|
|
use Storable qw(dclone);
|
|
|
|
use Term::ReadKey;
|
|
|
|
use Immunix::Severity;
|
|
use Immunix::Repository;
|
|
use Immunix::Config;
|
|
use LibAppArmor;
|
|
|
|
require Exporter;
|
|
our @ISA = qw(Exporter);
|
|
our @EXPORT = qw(
|
|
%sd
|
|
%qualifiers
|
|
%include
|
|
%helpers
|
|
|
|
$filename
|
|
$profiledir
|
|
$parser
|
|
$logger
|
|
$UI_Mode
|
|
$running_under_genprof
|
|
|
|
which
|
|
getprofilefilename
|
|
get_full_path
|
|
fatal_error
|
|
get_pager
|
|
|
|
getprofileflags
|
|
setprofileflags
|
|
complain
|
|
enforce
|
|
|
|
autodep
|
|
reload
|
|
|
|
UI_GetString
|
|
UI_GetFile
|
|
UI_YesNo
|
|
UI_ShortMessage
|
|
UI_LongMessage
|
|
|
|
UI_Important
|
|
UI_Info
|
|
UI_PromptUser
|
|
display_changes
|
|
getkey
|
|
|
|
do_logprof_pass
|
|
|
|
loadincludes
|
|
readprofile
|
|
readprofiles
|
|
writeprofile
|
|
serialize_profile
|
|
attach_profile_data
|
|
parse_repo_profile
|
|
activate_repo_profiles
|
|
|
|
check_for_subdomain
|
|
|
|
setup_yast
|
|
shutdown_yast
|
|
GetDataFromYast
|
|
SendDataToYast
|
|
|
|
checkProfileSyntax
|
|
checkIncludeSyntax
|
|
check_qualifiers
|
|
|
|
isSkippableFile
|
|
isSkippableDir
|
|
);
|
|
|
|
our $confdir = "/etc/apparmor";
|
|
|
|
our $running_under_genprof = 0;
|
|
|
|
our $DEBUGGING;
|
|
|
|
our $unimplemented_warning = 0;
|
|
|
|
# keep track of if we're running under yast or not - default to text mode
|
|
our $UI_Mode = "text";
|
|
|
|
our $sevdb;
|
|
|
|
# initialize Term::ReadLine if it's available
|
|
our $term;
|
|
eval {
|
|
require Term::ReadLine;
|
|
import Term::ReadLine;
|
|
$term = new Term::ReadLine 'AppArmor';
|
|
};
|
|
|
|
# initialize the local poo
|
|
setlocale(LC_MESSAGES, "")
|
|
unless defined(LC_MESSAGES);
|
|
textdomain("apparmor-utils");
|
|
|
|
# where do we get our log messages from?
|
|
our $filename;
|
|
|
|
our $cfg;
|
|
our $repo_cfg;
|
|
|
|
our $parser;
|
|
our $ldd;
|
|
our $logger;
|
|
our $profiledir;
|
|
our $extraprofiledir;
|
|
|
|
# we keep track of the included profile fragments with %include
|
|
my %include;
|
|
|
|
my %existing_profiles;
|
|
|
|
our $seenevents = 0;
|
|
|
|
|
|
# these are globs that the user specifically entered. we'll keep track of
|
|
# them so that if one later matches, we'll suggest it again.
|
|
our @userglobs;
|
|
|
|
### THESE VARIABLES ARE USED WITHIN LOGPROF
|
|
our %t;
|
|
our %transitions;
|
|
our %sd; # we keep track of the original profiles in %sd
|
|
our %original_sd;
|
|
our %extras; # inactive profiles from extras
|
|
|
|
my @log;
|
|
my %pid;
|
|
|
|
my %seen;
|
|
my %profilechanges;
|
|
my %prelog;
|
|
my %log;
|
|
my %changed;
|
|
my @created;
|
|
my %skip;
|
|
our %helpers; # we want to preserve this one between passes
|
|
|
|
### THESE VARIABLES ARE USED WITHIN LOGPROF
|
|
|
|
my %filelist; # file level stuff including variables in config files
|
|
|
|
my $AA_MAY_EXEC = 1;
|
|
my $AA_MAY_WRITE = 2;
|
|
my $AA_MAY_READ = 4;
|
|
my $AA_MAY_APPEND = 8;
|
|
my $AA_MAY_LINK = 16;
|
|
my $AA_MAY_LOCK = 32;
|
|
my $AA_EXEC_MMAP = 64;
|
|
my $AA_EXEC_UNSAFE = 128;
|
|
my $AA_EXEC_INHERIT = 256;
|
|
my $AA_EXEC_UNCONFINED = 512;
|
|
my $AA_EXEC_PROFILE = 1024;
|
|
my $AA_EXEC_CHILD = 2048;
|
|
my $AA_EXEC_NT = 4096;
|
|
my $AA_LINK_SUBSET = 8192;
|
|
|
|
my $AA_OTHER_SHIFT = 14;
|
|
my $AA_USER_MASK = 16384 -1;
|
|
|
|
my $AA_EXEC_TYPE = $AA_MAY_EXEC | $AA_EXEC_UNSAFE | $AA_EXEC_INHERIT |
|
|
$AA_EXEC_UNCONFINED | $AA_EXEC_PROFILE | $AA_EXEC_CHILD | $AA_EXEC_NT;
|
|
|
|
my $ALL_AA_EXEC_TYPE = $AA_EXEC_TYPE;
|
|
|
|
my %MODE_HASH = (
|
|
x => $AA_MAY_EXEC,
|
|
X => $AA_MAY_EXEC,
|
|
w => $AA_MAY_WRITE,
|
|
W => $AA_MAY_WRITE,
|
|
r => $AA_MAY_READ,
|
|
R => $AA_MAY_READ,
|
|
a => $AA_MAY_APPEND,
|
|
A => $AA_MAY_APPEND,
|
|
l => $AA_MAY_LINK,
|
|
L => $AA_MAY_LINK,
|
|
k => $AA_MAY_LOCK,
|
|
K => $AA_MAY_LOCK,
|
|
m => $AA_EXEC_MMAP,
|
|
M => $AA_EXEC_MMAP,
|
|
# Unsafe => 128,
|
|
i => $AA_EXEC_INHERIT,
|
|
I => $AA_EXEC_INHERIT,
|
|
u => $AA_EXEC_UNCONFINED + $AA_EXEC_UNSAFE, # U + Unsafe
|
|
U => $AA_EXEC_UNCONFINED,
|
|
p => $AA_EXEC_PROFILE + $AA_EXEC_UNSAFE, # P + Unsafe
|
|
P => $AA_EXEC_PROFILE,
|
|
c => $AA_EXEC_CHILD + $AA_EXEC_UNSAFE,
|
|
C => $AA_EXEC_CHILD,
|
|
n => $AA_EXEC_NT + $AA_EXEC_UNSAFE,
|
|
N => $AA_EXEC_NT,
|
|
);
|
|
|
|
sub debug ($) {
|
|
my $message = shift;
|
|
chomp($message);
|
|
|
|
print DEBUG "$message\n" if $DEBUGGING;
|
|
}
|
|
|
|
my %arrows = ( A => "UP", B => "DOWN", C => "RIGHT", D => "LEFT" );
|
|
|
|
sub getkey {
|
|
# change to raw mode
|
|
ReadMode(4);
|
|
|
|
my $key = ReadKey(0);
|
|
|
|
# decode arrow key control sequences
|
|
if ($key eq "\x1B") {
|
|
$key = ReadKey(0);
|
|
if ($key eq "[") {
|
|
$key = ReadKey(0);
|
|
if ($arrows{$key}) {
|
|
$key = $arrows{$key};
|
|
}
|
|
}
|
|
}
|
|
|
|
# return to cooked mode
|
|
ReadMode(0);
|
|
return $key;
|
|
}
|
|
|
|
BEGIN {
|
|
# set things up to log extra info if they want...
|
|
if ($ENV{LOGPROF_DEBUG}) {
|
|
$DEBUGGING = 1;
|
|
open(DEBUG, ">/var/log/apparmor/logprof_debug_$$.log");
|
|
my $oldfd = select(DEBUG);
|
|
$| = 1;
|
|
select($oldfd);
|
|
} else {
|
|
$DEBUGGING = 0;
|
|
}
|
|
}
|
|
|
|
END {
|
|
$DEBUGGING && debug "Exiting...";
|
|
|
|
# close the debug log if necessary
|
|
close(DEBUG) if $DEBUGGING;
|
|
}
|
|
|
|
# returns true if the specified program contains references to LD_PRELOAD or
|
|
# LD_LIBRARY_PATH to give the PX/UX code better suggestions
|
|
sub check_for_LD_XXX ($) {
|
|
my $file = shift;
|
|
|
|
return undef unless -f $file;
|
|
|
|
# limit our checking to programs/scripts under 10k to speed things up a bit
|
|
my $size = -s $file;
|
|
return undef unless ($size && $size < 10000);
|
|
|
|
my $found = undef;
|
|
if (open(F, $file)) {
|
|
while (<F>) {
|
|
$found = 1 if /LD_(PRELOAD|LIBRARY_PATH)/;
|
|
}
|
|
close(F);
|
|
}
|
|
|
|
return $found;
|
|
}
|
|
|
|
sub fatal_error ($) {
|
|
my $message = shift;
|
|
|
|
my $details = "$message\n";
|
|
|
|
if ($DEBUGGING) {
|
|
|
|
# we'll include the stack backtrace if we're debugging...
|
|
$details = Carp::longmess($message);
|
|
|
|
# write the error to the log
|
|
print DEBUG $details;
|
|
}
|
|
|
|
# we'll just shoot ourselves in the head if it was one of the yast
|
|
# interface functions that ran into an error. it gets really ugly if
|
|
# the yast frontend goes away and we try to notify the user of that
|
|
# problem by trying to send the yast frontend a pretty dialog box
|
|
my $caller = (caller(1))[3];
|
|
|
|
exit 1 if defined($caller) && $caller =~ /::(Send|Get)Data(To|From)Yast$/;
|
|
|
|
# tell the user what the hell happened
|
|
UI_Important($details);
|
|
|
|
# make sure the frontend exits cleanly...
|
|
shutdown_yast();
|
|
|
|
# die a horrible flaming death
|
|
exit 1;
|
|
}
|
|
|
|
sub setup_yast {
|
|
|
|
# set up the yast connection if we're running under yast...
|
|
if ($ENV{YAST_IS_RUNNING}) {
|
|
|
|
# load the yast module if available.
|
|
eval { require ycp; };
|
|
unless ($@) {
|
|
import ycp;
|
|
|
|
$UI_Mode = "yast";
|
|
|
|
# let the frontend know that we're starting
|
|
SendDataToYast({
|
|
type => "initial_handshake",
|
|
status => "backend_starting"
|
|
});
|
|
|
|
# see if the frontend is just starting up also...
|
|
my ($ypath, $yarg) = GetDataFromYast();
|
|
unless ($yarg
|
|
&& (ref($yarg) eq "HASH")
|
|
&& ($yarg->{type} eq "initial_handshake")
|
|
&& ($yarg->{status} eq "frontend_starting"))
|
|
{
|
|
|
|
# something's broken, die a horrible, painful death
|
|
fatal_error "Yast frontend is out of sync from backend agent.";
|
|
}
|
|
$DEBUGGING && debug "Initial handshake ok";
|
|
|
|
# the yast connection seems to be working okay
|
|
return 1;
|
|
}
|
|
|
|
}
|
|
|
|
# couldn't init yast
|
|
return 0;
|
|
}
|
|
|
|
sub shutdown_yast {
|
|
if ($UI_Mode eq "yast") {
|
|
SendDataToYast({ type => "final_shutdown" });
|
|
my ($ypath, $yarg) = GetDataFromYast();
|
|
}
|
|
}
|
|
|
|
sub check_for_subdomain () {
|
|
|
|
my ($support_subdomainfs, $support_securityfs);
|
|
if (open(MOUNTS, "/proc/filesystems")) {
|
|
while (<MOUNTS>) {
|
|
$support_subdomainfs = 1 if m/subdomainfs/;
|
|
$support_securityfs = 1 if m/securityfs/;
|
|
}
|
|
close(MOUNTS);
|
|
}
|
|
|
|
my $sd_mountpoint = "";
|
|
if (open(MOUNTS, "/proc/mounts")) {
|
|
while (<MOUNTS>) {
|
|
if ($support_subdomainfs) {
|
|
$sd_mountpoint = $1 if m/^\S+\s+(\S+)\s+subdomainfs\s/;
|
|
} elsif ($support_securityfs) {
|
|
if (m/^\S+\s+(\S+)\s+securityfs\s/) {
|
|
if (-e "$1/apparmor") {
|
|
$sd_mountpoint = "$1/apparmor";
|
|
} elsif (-e "$1/subdomain") {
|
|
$sd_mountpoint = "$1/subdomain";
|
|
}
|
|
}
|
|
}
|
|
}
|
|
close(MOUNTS);
|
|
}
|
|
|
|
# make sure that subdomain is actually mounted there
|
|
$sd_mountpoint = undef unless -f "$sd_mountpoint/profiles";
|
|
|
|
return $sd_mountpoint;
|
|
}
|
|
|
|
sub which ($) {
|
|
my $file = shift;
|
|
|
|
foreach my $dir (split(/:/, $ENV{PATH})) {
|
|
return "$dir/$file" if -x "$dir/$file";
|
|
}
|
|
|
|
return undef;
|
|
}
|
|
|
|
# we need to convert subdomain regexps to perl regexps
|
|
sub convert_regexp ($) {
|
|
my $regexp = shift;
|
|
|
|
# escape regexp-special characters we don't support
|
|
$regexp =~ s/(?<!\\)(\.|\+|\$)/\\$1/g;
|
|
|
|
# * and ** globs can't collapse to match an empty string when they're
|
|
# the only part of the glob at a specific directory level, which
|
|
# complicates things a little.
|
|
|
|
# ** globs match multiple directory levels
|
|
$regexp =~ s{(?<!\\)\*\*+}{
|
|
my ($pre, $post) = ($`, $');
|
|
if (($pre =~ /\/$/) && (!$post || $post =~ /^\//)) {
|
|
'SD_INTERNAL_MULTI_REQUIRED';
|
|
} else {
|
|
'SD_INTERNAL_MULTI_OPTIONAL';
|
|
}
|
|
}gex;
|
|
|
|
# convert * globs to match anything at the current path level
|
|
$regexp =~ s{(?<!\\)\*}{
|
|
my ($pre, $post) = ($`, $');
|
|
if (($pre =~ /\/$/) && (!$post || $post =~ /^\//)) {
|
|
'SD_INTERNAL_SINGLE_REQUIRED';
|
|
} else {
|
|
'SD_INTERNAL_SINGLE_OPTIONAL';
|
|
}
|
|
}gex;
|
|
|
|
# convert ? globs to match a single character at current path level
|
|
$regexp =~ s/(?<!\\)\?/[^\/]/g;
|
|
|
|
# convert {foo,baz} to (foo|baz)
|
|
$regexp =~ y/\{\}\,/\(\)\|/ if $regexp =~ /\{.*\,.*\}/;
|
|
|
|
# convert internal markers to their appropriate regexp equivalents
|
|
$regexp =~ s/SD_INTERNAL_SINGLE_OPTIONAL/[^\/]*/g;
|
|
$regexp =~ s/SD_INTERNAL_SINGLE_REQUIRED/[^\/]+/g;
|
|
$regexp =~ s/SD_INTERNAL_MULTI_OPTIONAL/.*/g;
|
|
$regexp =~ s/SD_INTERNAL_MULTI_REQUIRED/[^\/].*/g;
|
|
|
|
return $regexp;
|
|
}
|
|
|
|
sub get_full_path ($) {
|
|
my $originalpath = shift;
|
|
|
|
my $path = $originalpath;
|
|
|
|
# keep track so we can break out of loops
|
|
my $linkcount = 0;
|
|
|
|
# if we don't have any directory foo, look in the current dir
|
|
$path = cwd() . "/$path" if $path !~ m/\//;
|
|
|
|
# beat symlinks into submission
|
|
while (-l $path) {
|
|
|
|
if ($linkcount++ > 64) {
|
|
fatal_error "Followed too many symlinks resolving $originalpath";
|
|
}
|
|
|
|
# split out the directory/file components
|
|
if ($path =~ m/^(.*)\/(.+)$/) {
|
|
my ($dir, $file) = ($1, $2);
|
|
|
|
# figure out where the link is pointing...
|
|
my $link = readlink($path);
|
|
if ($link =~ /^\//) {
|
|
# if it's an absolute link, just replace it
|
|
$path = $link;
|
|
} else {
|
|
# if it's relative, let abs_path handle it
|
|
$path = $dir . "/$link";
|
|
}
|
|
}
|
|
}
|
|
|
|
if (-f $path) {
|
|
my ($dir, $file) = $path =~ m/^(.*)\/(.+)$/;
|
|
$path = realpath($dir) . "/$file";
|
|
} else {
|
|
$path = realpath($path);
|
|
}
|
|
|
|
return $path;
|
|
}
|
|
|
|
sub findexecutable ($) {
|
|
my $bin = shift;
|
|
|
|
my $fqdbin;
|
|
if (-e $bin) {
|
|
$fqdbin = get_full_path($bin);
|
|
chomp($fqdbin);
|
|
} else {
|
|
if ($bin !~ /\//) {
|
|
my $which = which($bin);
|
|
if ($which) {
|
|
$fqdbin = get_full_path($which);
|
|
}
|
|
}
|
|
}
|
|
|
|
unless ($fqdbin && -e $fqdbin) {
|
|
return undef;
|
|
}
|
|
|
|
return $fqdbin;
|
|
}
|
|
|
|
sub name_to_prof_filename($) {
|
|
my $bin = shift;
|
|
my $filename;
|
|
|
|
unless ($bin =~ /^($profiledir)/) {
|
|
my $fqdbin = findexecutable($bin);
|
|
if ($fqdbin) {
|
|
$filename = getprofilefilename($fqdbin);
|
|
return ($filename, $fqdbin) if -f $filename;
|
|
}
|
|
}
|
|
|
|
if ($bin =~ /^$profiledir(.*)/) {
|
|
my $profile = $1;
|
|
return ($bin, $profile);
|
|
} elsif ($bin =~ /^\//) {
|
|
$filename = getprofilefilename($bin);
|
|
return ($filename, $bin);
|
|
} else {
|
|
# not an absolute path try it as a profile_
|
|
$bin = $1 if ($bin !~ /^profile_(.*)/);
|
|
$filename = getprofilefilename($bin);
|
|
return ($filename, "profile_${bin}");
|
|
}
|
|
return undef;
|
|
}
|
|
|
|
sub complain ($) {
|
|
my $bin = shift;
|
|
|
|
return if (!$bin);
|
|
|
|
my ($filename, $name) = name_to_prof_filename($bin)
|
|
or fatal_error(sprintf(gettext('Can\'t find %s.'), $bin));
|
|
|
|
UI_Info(sprintf(gettext('Setting %s to complain mode.'), $name));
|
|
|
|
setprofileflags($filename, "complain");
|
|
}
|
|
|
|
sub enforce ($) {
|
|
my $bin = shift;
|
|
|
|
return if (!$bin);
|
|
|
|
my ($filename, $name) = name_to_prof_filename($bin)
|
|
or fatal_error(sprintf(gettext('Can\'t find %s.'), $bin));
|
|
|
|
UI_Info(sprintf(gettext('Setting %s to enforce mode.'), $name));
|
|
|
|
setprofileflags($filename, "");
|
|
}
|
|
|
|
sub head ($) {
|
|
my $file = shift;
|
|
|
|
my $first = "";
|
|
if (open(FILE, $file)) {
|
|
$first = <FILE>;
|
|
close(FILE);
|
|
}
|
|
|
|
return $first;
|
|
}
|
|
|
|
sub get_output (@) {
|
|
my ($program, @args) = @_;
|
|
|
|
my $ret = -1;
|
|
|
|
my $pid;
|
|
my @output;
|
|
|
|
if (-x $program) {
|
|
$pid = open(KID_TO_READ, "-|");
|
|
unless (defined $pid) {
|
|
fatal_error "can't fork: $!";
|
|
}
|
|
|
|
if ($pid) {
|
|
while (<KID_TO_READ>) {
|
|
chomp;
|
|
push @output, $_;
|
|
}
|
|
close(KID_TO_READ);
|
|
$ret = $?;
|
|
} else {
|
|
($>, $)) = ($<, $();
|
|
open(STDERR, ">&STDOUT")
|
|
|| fatal_error "can't dup stdout to stderr";
|
|
exec($program, @args) || fatal_error "can't exec program: $!";
|
|
|
|
# NOTREACHED
|
|
}
|
|
}
|
|
|
|
return ($ret, @output);
|
|
}
|
|
|
|
sub get_reqs ($) {
|
|
my $file = shift;
|
|
|
|
my @reqs;
|
|
my ($ret, @ldd) = get_output($ldd, $file);
|
|
|
|
if ($ret == 0) {
|
|
for my $line (@ldd) {
|
|
last if $line =~ /not a dynamic executable/;
|
|
last if $line =~ /cannot read header/;
|
|
last if $line =~ /statically linked/;
|
|
|
|
# avoid new kernel 2.6 poo
|
|
next if $line =~ /linux-(gate|vdso(32|64)).so/;
|
|
|
|
if ($line =~ /^\s*\S+ => (\/\S+)/) {
|
|
push @reqs, $1;
|
|
} elsif ($line =~ /^\s*(\/\S+)/) {
|
|
push @reqs, $1;
|
|
}
|
|
}
|
|
}
|
|
|
|
return @reqs;
|
|
}
|
|
|
|
sub handle_binfmt ($$) {
|
|
my ($profile, $fqdbin) = @_;
|
|
|
|
my %reqs;
|
|
my @reqs = get_reqs($fqdbin);
|
|
|
|
while (my $library = shift @reqs) {
|
|
|
|
$library = get_full_path($library);
|
|
|
|
push @reqs, get_reqs($library) unless $reqs{$library}++;
|
|
|
|
# does path match anything pulled in by includes in original profile?
|
|
my $combinedmode = match_prof_incs_to_path($profile, 'allow', $library);
|
|
|
|
# if we found any matching entries, do the modes match?
|
|
next if $combinedmode;
|
|
|
|
$library = globcommon($library);
|
|
chomp $library;
|
|
next unless $library;
|
|
|
|
$profile->{allow}{path}->{$library}{mode} |= str_to_mode("mr");
|
|
$profile->{allow}{path}->{$library}{audit} |= 0;
|
|
}
|
|
}
|
|
|
|
sub get_inactive_profile {
|
|
my $fqdbin = shift;
|
|
if ( $extras{$fqdbin} ) {
|
|
return {$fqdbin => $extras{$fqdbin}};
|
|
}
|
|
}
|
|
|
|
|
|
|
|
sub create_new_profile {
|
|
my $fqdbin = shift;
|
|
|
|
my $profile;
|
|
if ($fqdbin =~ /^\// ) {
|
|
$profile = {
|
|
$fqdbin => {
|
|
flags => "complain",
|
|
include => { "abstractions/base" => 1 },
|
|
path => { $fqdbin => { mode => str_to_mode("mr") } },
|
|
}
|
|
};
|
|
} else {
|
|
$profile = {
|
|
$fqdbin => {
|
|
flags => "complain",
|
|
include => { "abstractions/base" => 1 },
|
|
}
|
|
};
|
|
}
|
|
|
|
# if the executable exists on this system, pull in extra dependencies
|
|
if (-f $fqdbin) {
|
|
my $hashbang = head($fqdbin);
|
|
if ($hashbang && $hashbang =~ /^#!\s*(\S+)/) {
|
|
my $interpreter = get_full_path($1);
|
|
$profile->{$fqdbin}{allow}{path}->{$interpreter}{mode} |= str_to_mode("ix");
|
|
$profile->{$fqdbin}{allow}{path}->{$interpreter}{audit} |= 0;
|
|
if ($interpreter =~ /perl/) {
|
|
$profile->{$fqdbin}{include}->{"abstractions/perl"} = 1;
|
|
} elsif ($interpreter =~ m/\/bin\/(bash|sh)/) {
|
|
$profile->{$fqdbin}{include}->{"abstractions/bash"} = 1;
|
|
}
|
|
handle_binfmt($profile->{$fqdbin}, $interpreter);
|
|
} else {
|
|
handle_binfmt($profile->{$fqdbin}, $fqdbin);
|
|
}
|
|
}
|
|
|
|
# create required infrastructure hats if it's a known change_hat app
|
|
for my $hatglob (keys %{$cfg->{required_hats}}) {
|
|
if ($fqdbin =~ /$hatglob/) {
|
|
for my $hat (sort split(/\s+/, $cfg->{required_hats}{$hatglob})) {
|
|
$profile->{$hat} = { flags => "complain" };
|
|
}
|
|
}
|
|
}
|
|
push @created, $fqdbin;
|
|
return { $fqdbin => $profile };
|
|
}
|
|
|
|
sub delete_profile ($) {
|
|
my $profile = shift;
|
|
my $profilefile = getprofilefilename( $profile );
|
|
if ( -e $profilefile ) {
|
|
unlink( $profilefile );
|
|
}
|
|
if ( defined $sd{$profile} ) {
|
|
delete $sd{$profile};
|
|
}
|
|
}
|
|
|
|
sub get_profile {
|
|
my $fqdbin = shift;
|
|
my $profile_data;
|
|
|
|
my $distro = $cfg->{repository}{distro};
|
|
my $repo_url = $cfg->{repository}{url};
|
|
my @profiles;
|
|
my %profile_hash;
|
|
|
|
if (repo_is_enabled()) {
|
|
my $results;
|
|
UI_BusyStart( gettext("Connecting to repository.....") );
|
|
|
|
my ($status_ok,$ret) =
|
|
fetch_profiles_by_name($repo_url, $distro, $fqdbin );
|
|
UI_BusyStop();
|
|
if ( $status_ok ) {
|
|
%profile_hash = %$ret;
|
|
} else {
|
|
my $errmsg =
|
|
sprintf(gettext("WARNING: Error fetching profiles from the repository:\n%s\n"),
|
|
$ret?$ret:gettext("UNKNOWN ERROR"));
|
|
UI_Important( $errmsg );
|
|
}
|
|
}
|
|
|
|
my $inactive_profile = get_inactive_profile($fqdbin);
|
|
if ( defined $inactive_profile && $inactive_profile ne "" ) {
|
|
# set the profile to complain mode
|
|
my $uname = gettext( "Inactive local profile for ") . $fqdbin;
|
|
$inactive_profile->{$fqdbin}{$fqdbin}{flags} = "complain";
|
|
# inactive profiles store where they came from
|
|
delete $inactive_profile->{$fqdbin}{$fqdbin}{filename};
|
|
$profile_hash{$uname} =
|
|
{
|
|
"username" => $uname,
|
|
"profile_type" => "INACTIVE_LOCAL",
|
|
"profile" => serialize_profile($inactive_profile->{$fqdbin},
|
|
$fqdbin
|
|
),
|
|
"profile_data" => $inactive_profile,
|
|
};
|
|
}
|
|
|
|
return undef if ( keys %profile_hash == 0 ); # No repo profiles, no inactive
|
|
# profile
|
|
my @options;
|
|
my @tmp_list;
|
|
my $preferred_present = 0;
|
|
my $preferred_user = $cfg->{repository}{preferred_user} || "NOVELL";
|
|
|
|
foreach my $p ( keys %profile_hash ) {
|
|
if ( $profile_hash{$p}->{username} eq $preferred_user ) {
|
|
$preferred_present = 1;
|
|
} else {
|
|
push @tmp_list, $profile_hash{$p}->{username};
|
|
}
|
|
}
|
|
|
|
if ( $preferred_present ) {
|
|
push @options, $preferred_user;
|
|
}
|
|
push @options, @tmp_list;
|
|
|
|
my $q = {};
|
|
$q->{headers} = [];
|
|
push @{ $q->{headers} }, gettext("Profile"), $fqdbin;
|
|
|
|
$q->{functions} = [ "CMD_VIEW_PROFILE", "CMD_USE_PROFILE",
|
|
"CMD_CREATE_PROFILE", "CMD_ABORT", "CMD_FINISHED" ];
|
|
|
|
$q->{default} = "CMD_VIEW_PROFILE";
|
|
|
|
$q->{options} = [@options];
|
|
$q->{selected} = 0;
|
|
|
|
my ($p, $ans, $arg);
|
|
do {
|
|
($ans, $arg) = UI_PromptUser($q);
|
|
$p = $profile_hash{$options[$arg]};
|
|
for (my $i = 0; $i < scalar(@options); $i++) {
|
|
if ($options[$i] eq $options[$arg]) {
|
|
$q->{selected} = $i;
|
|
}
|
|
}
|
|
|
|
if ($ans eq "CMD_VIEW_PROFILE") {
|
|
if ($UI_Mode eq "yast") {
|
|
SendDataToYast(
|
|
{
|
|
type => "dialog-view-profile",
|
|
user => $options[$arg],
|
|
profile => $p->{profile},
|
|
profile_type => $p->{profile_type}
|
|
}
|
|
);
|
|
my ($ypath, $yarg) = GetDataFromYast();
|
|
} else {
|
|
my $pager = get_pager();
|
|
open(PAGER, "| $pager");
|
|
print PAGER gettext("Profile submitted by") .
|
|
" $options[$arg]:\n\n" . $p->{profile} . "\n\n";
|
|
close(PAGER);
|
|
}
|
|
} elsif ($ans eq "CMD_USE_PROFILE") {
|
|
if ( $p->{profile_type} eq "INACTIVE_LOCAL" ) {
|
|
$profile_data = $p->{profile_data};
|
|
push @created, $fqdbin; # This really is ugly here
|
|
# need to find a better place to mark
|
|
# this as newly created
|
|
} else {
|
|
$profile_data =
|
|
parse_repo_profile($fqdbin, $repo_url, $p);
|
|
}
|
|
}
|
|
} until ($ans =~ /^CMD_(USE_PROFILE|CREATE_PROFILE)$/);
|
|
|
|
return $profile_data;
|
|
}
|
|
|
|
sub activate_repo_profiles ($$$) {
|
|
my ($url,$profiles,$complain) = @_;
|
|
|
|
readprofiles();
|
|
eval {
|
|
for my $p ( @$profiles ) {
|
|
my $pname = $p->[0];
|
|
my $profile_data = parse_repo_profile( $pname, $url, $p->[1] );
|
|
attach_profile_data(\%sd, $profile_data);
|
|
writeprofile($pname);
|
|
if ( $complain ) {
|
|
my $filename = getprofilefilename($pname);
|
|
setprofileflags($filename, "complain");
|
|
UI_Info(sprintf(gettext('Setting %s to complain mode.'),
|
|
$pname));
|
|
}
|
|
}
|
|
};
|
|
# if there were errors....
|
|
if ($@) {
|
|
$@ =~ s/\n$//;
|
|
print STDERR sprintf(gettext("Error activating profiles: %s\n"), $@);
|
|
}
|
|
}
|
|
|
|
sub autodep_base($$) {
|
|
my ($bin, $pname) = @_;
|
|
%extras = ();
|
|
|
|
$bin = $pname if (! $bin) && ($pname =~ /^\//);
|
|
|
|
unless ($repo_cfg || not defined $cfg->{repository}{url}) {
|
|
$repo_cfg = read_config("repository.conf");
|
|
if ( (not defined $repo_cfg->{repository}) ||
|
|
($repo_cfg->{repository}{enabled} eq "later") ) {
|
|
UI_ask_to_enable_repo();
|
|
}
|
|
}
|
|
|
|
my $fqdbin;
|
|
if ($bin) {
|
|
# findexecutable() might fail if we're running on a different system
|
|
# than the logs were collected on. ugly. we'll just hope for the best.
|
|
$fqdbin = findexecutable($bin) || $bin;
|
|
|
|
# try to make sure we have a full path in case findexecutable failed
|
|
return unless $fqdbin =~ /^\//;
|
|
|
|
# ignore directories
|
|
return if -d $fqdbin;
|
|
}
|
|
|
|
$pname = $fqdbin if $fqdbin;
|
|
|
|
my $profile_data;
|
|
|
|
readinactiveprofiles(); # need to read the profiles to see if an
|
|
# inactive local profile is present
|
|
$profile_data = eval { get_profile($pname) };
|
|
|
|
unless ($profile_data) {
|
|
$profile_data = create_new_profile($pname);
|
|
}
|
|
|
|
my $file = getprofilefilename($pname);
|
|
|
|
# stick the profile into our data structure.
|
|
attach_profile_data(\%sd, $profile_data);
|
|
# and store a "clean" version also so we can display the changes we've
|
|
# made during this run
|
|
attach_profile_data(\%original_sd, $profile_data);
|
|
|
|
if (-f "$profiledir/tunables/global") {
|
|
unless (exists $filelist{$file}) {
|
|
$filelist{$file} = { };
|
|
}
|
|
$filelist{$file}{include}{'tunables/global'} = 1; # sorry
|
|
}
|
|
|
|
# write out the profile...
|
|
writeprofile_ui_feedback($pname);
|
|
}
|
|
|
|
sub autodep ($) {
|
|
my $bin = shift;
|
|
return autodep_base($bin, "");
|
|
}
|
|
|
|
sub getprofilefilename ($) {
|
|
my $profile = shift;
|
|
|
|
my $filename = $profile;
|
|
if ($filename =~ /^\//) {
|
|
$filename =~ s/^\///; # strip leading /
|
|
} else {
|
|
$filename = "profile_$filename";
|
|
}
|
|
$filename =~ s/\//./g; # convert /'s to .'s
|
|
|
|
return "$profiledir/$filename";
|
|
}
|
|
|
|
sub setprofileflags ($$) {
|
|
my $filename = shift;
|
|
my $newflags = shift;
|
|
|
|
if (open(PROFILE, "$filename")) {
|
|
if (open(NEWPROFILE, ">$filename.new")) {
|
|
while (<PROFILE>) {
|
|
if (m/^\s*(("??\/.+?"??)|(profile\s+("??.+?"??)))\s+(flags=\(.+\)\s+)*\{\s*$/) {
|
|
my ($binary, $flags) = ($1, $5);
|
|
|
|
if ($newflags) {
|
|
$_ = "$binary flags=($newflags) {\n";
|
|
} else {
|
|
$_ = "$binary {\n";
|
|
}
|
|
} elsif (m/^(\s*\^\S+)\s+(flags=\(.+\)\s+)*\{\s*$/) {
|
|
my ($hat, $flags) = ($1, $2);
|
|
|
|
if ($newflags) {
|
|
$_ = "$hat flags=($newflags) {\n";
|
|
} else {
|
|
$_ = "$hat {\n";
|
|
}
|
|
}
|
|
print NEWPROFILE;
|
|
}
|
|
close(NEWPROFILE);
|
|
rename("$filename.new", "$filename");
|
|
}
|
|
close(PROFILE);
|
|
}
|
|
}
|
|
|
|
sub profile_exists($) {
|
|
my $program = shift || return 0;
|
|
|
|
# if it's already in the cache, return true
|
|
return 1 if $existing_profiles{$program};
|
|
|
|
# if the profile exists, mark it in the cache and return true
|
|
my $profile = getprofilefilename($program);
|
|
if (-e $profile) {
|
|
$existing_profiles{$program} = 1;
|
|
return 1;
|
|
}
|
|
|
|
# couldn't find a profile, so we'll return false
|
|
return 0;
|
|
}
|
|
|
|
sub sync_profiles {
|
|
|
|
my ($user, $pass) = get_repo_user_pass();
|
|
return unless ( $user && $pass );
|
|
|
|
my @repo_profiles;
|
|
my @changed_profiles;
|
|
my @new_profiles;
|
|
my $serialize_opts = { };
|
|
my ($status_ok,$ret) =
|
|
fetch_profiles_by_user($cfg->{repository}{url},
|
|
$cfg->{repository}{distro},
|
|
$user
|
|
);
|
|
if ( !$status_ok ) {
|
|
my $errmsg =
|
|
sprintf(gettext("WARNING: Error syncronizing profiles with the repository:\n%s\n"),
|
|
$ret?$ret:gettext("UNKNOWN ERROR"));
|
|
UI_Important($errmsg);
|
|
return;
|
|
} else {
|
|
my $users_repo_profiles = $ret;
|
|
$serialize_opts->{NO_FLAGS} = 1;
|
|
#
|
|
# Find changes made to non-repo profiles
|
|
#
|
|
for my $profile (sort keys %sd) {
|
|
if (is_repo_profile($sd{$profile}{$profile})) {
|
|
push @repo_profiles, $profile;
|
|
}
|
|
if ( grep(/^$profile$/, @created) ) {
|
|
my $p_local = serialize_profile($sd{$profile},
|
|
$profile,
|
|
$serialize_opts);
|
|
if ( not defined $users_repo_profiles->{$profile} ) {
|
|
push @new_profiles, [ $profile, $p_local, "" ];
|
|
} else {
|
|
my $p_repo = $users_repo_profiles->{$profile}->{profile};
|
|
if ( $p_local ne $p_repo ) {
|
|
push @changed_profiles, [ $profile, $p_local, $p_repo ];
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
#
|
|
# Find changes made to local profiles with repo metadata
|
|
#
|
|
if (@repo_profiles) {
|
|
for my $profile (@repo_profiles) {
|
|
my $p_local = serialize_profile($sd{$profile},
|
|
$profile,
|
|
$serialize_opts);
|
|
if ( not exists $users_repo_profiles->{$profile} ) {
|
|
push @new_profiles, [ $profile, $p_local, "" ];
|
|
} else {
|
|
my $p_repo = "";
|
|
if ( $sd{$profile}{$profile}{repo}{user} eq $user ) {
|
|
$p_repo = $users_repo_profiles->{$profile}->{profile};
|
|
} else {
|
|
my ($status_ok,$ret) =
|
|
fetch_profile_by_id($cfg->{repository}{url},
|
|
$sd{$profile}{$profile}{repo}{id}
|
|
);
|
|
if ( $status_ok ) {
|
|
$p_repo = $ret->{profile};
|
|
} else {
|
|
my $errmsg =
|
|
sprintf(
|
|
gettext("WARNING: Error syncronizing profiles with the repository:\n%s\n"),
|
|
$ret?$ret:gettext("UNKNOWN ERROR"));
|
|
UI_Important($errmsg);
|
|
next;
|
|
}
|
|
}
|
|
if ( $p_repo ne $p_local ) {
|
|
push @changed_profiles, [ $profile, $p_local, $p_repo ];
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
if ( @changed_profiles ) {
|
|
submit_changed_profiles( \@changed_profiles );
|
|
}
|
|
if ( @new_profiles ) {
|
|
submit_created_profiles( \@new_profiles );
|
|
}
|
|
}
|
|
}
|
|
|
|
sub submit_created_profiles {
|
|
my $new_profiles = shift;
|
|
my $url = $cfg->{repository}{url};
|
|
|
|
if ($UI_Mode eq "yast") {
|
|
my $title = gettext("New profiles");
|
|
my $explanation =
|
|
gettext("Please choose the newly created profiles that you would".
|
|
" like\nto store in the repository");
|
|
yast_select_and_upload_profiles($title,
|
|
$explanation,
|
|
$new_profiles);
|
|
} else {
|
|
my $title =
|
|
gettext("Submit newly created profiles to the repository");
|
|
my $explanation =
|
|
gettext("Would you like to upload the newly created profiles?");
|
|
console_select_and_upload_profiles($title,
|
|
$explanation,
|
|
$new_profiles);
|
|
}
|
|
}
|
|
|
|
sub submit_changed_profiles {
|
|
my $changed_profiles = shift;
|
|
my $url = $cfg->{repository}{url};
|
|
if (@$changed_profiles) {
|
|
if ($UI_Mode eq "yast") {
|
|
my $explanation =
|
|
gettext("Select which of the changed profiles you would".
|
|
" like to upload\nto the repository");
|
|
my $title = gettext("Changed profiles");
|
|
yast_select_and_upload_profiles($title,
|
|
$explanation,
|
|
$changed_profiles);
|
|
} else {
|
|
my $title =
|
|
gettext("Submit changed profiles to the repository");
|
|
my $explanation =
|
|
gettext("The following profiles from the repository were".
|
|
" changed.\nWould you like to upload your changes?");
|
|
console_select_and_upload_profiles($title,
|
|
$explanation,
|
|
$changed_profiles);
|
|
}
|
|
}
|
|
}
|
|
|
|
sub yast_select_and_upload_profiles {
|
|
|
|
my ($title, $explanation, $profiles_ref) = @_;
|
|
my $url = $cfg->{repository}{url};
|
|
my %profile_changes;
|
|
my @profiles = @$profiles_ref;
|
|
|
|
foreach my $prof (@profiles) {
|
|
$profile_changes{ $prof->[0] } =
|
|
get_profile_diff($prof->[2], $prof->[1]);
|
|
}
|
|
|
|
my (@selected_profiles, $changelog, $changelogs, $single_changelog);
|
|
SendDataToYast(
|
|
{
|
|
type => "dialog-select-profiles",
|
|
title => $title,
|
|
explanation => $explanation,
|
|
default_select => "false",
|
|
disable_ask_upload => "true",
|
|
profiles => \%profile_changes
|
|
}
|
|
);
|
|
my ($ypath, $yarg) = GetDataFromYast();
|
|
if ($yarg->{STATUS} eq "cancel") {
|
|
return;
|
|
} else {
|
|
my $selected_profiles_ref = $yarg->{PROFILES};
|
|
@selected_profiles = @$selected_profiles_ref;
|
|
$changelogs = $yarg->{CHANGELOG};
|
|
if (defined $changelogs->{SINGLE_CHANGELOG}) {
|
|
$changelog = $changelogs->{SINGLE_CHANGELOG};
|
|
$single_changelog = 1;
|
|
}
|
|
}
|
|
|
|
for my $profile (@selected_profiles) {
|
|
my ($user, $pass) = get_repo_user_pass();
|
|
my $profile_string = serialize_profile($sd{$profile}, $profile);
|
|
if (!$single_changelog) {
|
|
$changelog = $changelogs->{$profile};
|
|
}
|
|
my ($status_ok, $ret) = upload_profile( $url,
|
|
$user,
|
|
$pass,
|
|
$cfg->{repository}{distro},
|
|
$profile,
|
|
$profile_string,
|
|
$changelog
|
|
);
|
|
if ($status_ok) {
|
|
my $newprofile = $ret;
|
|
my $newid = $newprofile->{id};
|
|
set_repo_info($sd{$profile}{$profile}, $url, $user, $newid);
|
|
writeprofile_ui_feedback($profile);
|
|
} else {
|
|
my $errmsg =
|
|
sprintf(
|
|
gettext("WARNING: An error occured while uploading the profile %s\n%s\n"),
|
|
$profile, $ret?$ret:gettext("UNKNOWN ERROR"));
|
|
UI_Important( $errmsg );
|
|
}
|
|
}
|
|
UI_Info(gettext("Uploaded changes to repository."));
|
|
|
|
# Check to see if unselected profiles should be marked as local only
|
|
# this is outside of the main repo code as we want users to be able to mark
|
|
# profiles as local only even if they aren't able to connect to the repo.
|
|
if (defined $yarg->{NEVER_ASK_AGAIN}) {
|
|
my @unselected_profiles;
|
|
foreach my $prof (@profiles) {
|
|
if ( grep(/^$prof->[0]$/, @selected_profiles) == 0 ) {
|
|
push @unselected_profiles, $prof->[0];
|
|
}
|
|
}
|
|
set_profiles_local_only( @unselected_profiles );
|
|
}
|
|
}
|
|
|
|
sub console_select_and_upload_profiles {
|
|
my ($title, $explanation, $profiles_ref) = @_;
|
|
my $url = $cfg->{repository}{url};
|
|
my @profiles = @$profiles_ref;
|
|
my $q = {};
|
|
$q->{title} = $title;
|
|
$q->{headers} = [ gettext("Repository"), $url, ];
|
|
|
|
$q->{explanation} = $explanation;
|
|
|
|
$q->{functions} = [ "CMD_UPLOAD_CHANGES",
|
|
"CMD_VIEW_CHANGES",
|
|
"CMD_ASK_LATER",
|
|
"CMD_ASK_NEVER",
|
|
"CMD_ABORT", ];
|
|
|
|
$q->{default} = "CMD_VIEW_CHANGES";
|
|
|
|
$q->{options} = [ map { $_->[0] } @profiles ];
|
|
$q->{selected} = 0;
|
|
|
|
my ($ans, $arg);
|
|
do {
|
|
($ans, $arg) = UI_PromptUser($q);
|
|
|
|
if ($ans eq "CMD_VIEW_CHANGES") {
|
|
display_changes($profiles[$arg]->[2], $profiles[$arg]->[1]);
|
|
}
|
|
} until $ans =~ /^CMD_(UPLOAD_CHANGES|ASK_NEVER|ASK_LATER)/;
|
|
|
|
if ($ans eq "CMD_ASK_NEVER") {
|
|
set_profiles_local_only( map { $_->[0] } @profiles );
|
|
} elsif ($ans eq "CMD_UPLOAD_CHANGES") {
|
|
my $changelog = UI_GetString(gettext("Changelog Entry: "), "");
|
|
my ($user, $pass) = get_repo_user_pass();
|
|
if ($user && $pass) {
|
|
for my $p_data (@profiles) {
|
|
my $profile = $p_data->[0];
|
|
my $profile_string = $p_data->[1];
|
|
my ($status_ok,$ret) =
|
|
upload_profile( $url,
|
|
$user,
|
|
$pass,
|
|
$cfg->{repository}{distro},
|
|
$profile,
|
|
$profile_string,
|
|
$changelog
|
|
);
|
|
if ($status_ok) {
|
|
my $newprofile = $ret;
|
|
my $newid = $newprofile->{id};
|
|
set_repo_info($sd{$profile}{$profile}, $url, $user, $newid);
|
|
writeprofile_ui_feedback($profile);
|
|
UI_Info(
|
|
sprintf(gettext("Uploaded %s to repository."), $profile)
|
|
);
|
|
} else {
|
|
my $errmsg =
|
|
sprintf(
|
|
gettext("WARNING: An error occured while uploading the profile %s\n%s\n"),
|
|
$profile, $ret?$ret:gettext("UNKNOWN ERROR"));
|
|
UI_Important( $errmsg );
|
|
}
|
|
}
|
|
} else {
|
|
UI_Important(gettext("Repository Error\n" .
|
|
"Registration or Signin was unsuccessful. User login\n" .
|
|
"information is required to upload profiles to the\n" .
|
|
"repository. These changes have not been sent.\n"));
|
|
}
|
|
}
|
|
}
|
|
|
|
#
|
|
# Mark the profiles passed in @profiles as local only
|
|
# and don't prompt to upload changes to the repository
|
|
#
|
|
sub set_profiles_local_only {
|
|
my @profiles = @_;
|
|
for my $profile (@profiles) {
|
|
$sd{$profile}{$profile}{repo}{neversubmit} = 1;
|
|
writeprofile_ui_feedback($profile);
|
|
}
|
|
}
|
|
|
|
##########################################################################
|
|
# Here are the console/yast interface functions
|
|
|
|
sub UI_Info ($) {
|
|
my $text = shift;
|
|
|
|
$DEBUGGING && debug "UI_Info: $UI_Mode: $text";
|
|
|
|
if ($UI_Mode eq "text") {
|
|
print "$text\n";
|
|
} else {
|
|
ycp::y2milestone($text);
|
|
}
|
|
}
|
|
|
|
sub UI_Important ($) {
|
|
my $text = shift;
|
|
|
|
$DEBUGGING && debug "UI_Important: $UI_Mode: $text";
|
|
|
|
if ($UI_Mode eq "text") {
|
|
print "\n$text\n";
|
|
} else {
|
|
SendDataToYast({ type => "dialog-error", message => $text });
|
|
my ($path, $yarg) = GetDataFromYast();
|
|
}
|
|
}
|
|
|
|
sub UI_YesNo ($$) {
|
|
my $text = shift;
|
|
my $default = shift;
|
|
|
|
$DEBUGGING && debug "UI_YesNo: $UI_Mode: $text $default";
|
|
|
|
my $ans;
|
|
if ($UI_Mode eq "text") {
|
|
|
|
my $yes = gettext("(Y)es");
|
|
my $no = gettext("(N)o");
|
|
|
|
# figure out our localized hotkeys
|
|
my $usrmsg = "PromptUser: " . gettext("Invalid hotkey for");
|
|
$yes =~ /\((\S)\)/ or fatal_error "$usrmsg '$yes'";
|
|
my $yeskey = lc($1);
|
|
$no =~ /\((\S)\)/ or fatal_error "$usrmsg '$no'";
|
|
my $nokey = lc($1);
|
|
|
|
print "\n$text\n";
|
|
if ($default eq "y") {
|
|
print "\n[$yes] / $no\n";
|
|
} else {
|
|
print "\n$yes / [$no]\n";
|
|
}
|
|
$ans = getkey() || (($default eq "y") ? $yeskey : $nokey);
|
|
|
|
# convert back from a localized answer to english y or n
|
|
$ans = (lc($ans) eq $yeskey) ? "y" : "n";
|
|
} else {
|
|
|
|
SendDataToYast({ type => "dialog-yesno", question => $text });
|
|
my ($ypath, $yarg) = GetDataFromYast();
|
|
$ans = $yarg->{answer} || $default;
|
|
|
|
}
|
|
|
|
return $ans;
|
|
}
|
|
|
|
sub UI_YesNoCancel ($$) {
|
|
my $text = shift;
|
|
my $default = shift;
|
|
|
|
$DEBUGGING && debug "UI_YesNoCancel: $UI_Mode: $text $default";
|
|
|
|
my $ans;
|
|
if ($UI_Mode eq "text") {
|
|
|
|
my $yes = gettext("(Y)es");
|
|
my $no = gettext("(N)o");
|
|
my $cancel = gettext("(C)ancel");
|
|
|
|
# figure out our localized hotkeys
|
|
my $usrmsg = "PromptUser: " . gettext("Invalid hotkey for");
|
|
$yes =~ /\((\S)\)/ or fatal_error "$usrmsg '$yes'";
|
|
my $yeskey = lc($1);
|
|
$no =~ /\((\S)\)/ or fatal_error "$usrmsg '$no'";
|
|
my $nokey = lc($1);
|
|
$cancel =~ /\((\S)\)/ or fatal_error "$usrmsg '$cancel'";
|
|
my $cancelkey = lc($1);
|
|
|
|
$ans = "XXXINVALIDXXX";
|
|
while ($ans !~ /^(y|n|c)$/) {
|
|
print "\n$text\n";
|
|
if ($default eq "y") {
|
|
print "\n[$yes] / $no / $cancel\n";
|
|
} elsif ($default eq "n") {
|
|
print "\n$yes / [$no] / $cancel\n";
|
|
} else {
|
|
print "\n$yes / $no / [$cancel]\n";
|
|
}
|
|
|
|
$ans = getkey();
|
|
|
|
if ($ans) {
|
|
# convert back from a localized answer to english y or n
|
|
$ans = lc($ans);
|
|
if ($ans eq $yeskey) {
|
|
$ans = "y";
|
|
} elsif ($ans eq $nokey) {
|
|
$ans = "n";
|
|
} elsif ($ans eq $cancelkey) {
|
|
$ans = "c";
|
|
}
|
|
} else {
|
|
$ans = $default;
|
|
}
|
|
}
|
|
} else {
|
|
|
|
SendDataToYast({ type => "dialog-yesnocancel", question => $text });
|
|
my ($ypath, $yarg) = GetDataFromYast();
|
|
$ans = $yarg->{answer} || $default;
|
|
|
|
}
|
|
|
|
return $ans;
|
|
}
|
|
|
|
sub UI_GetString ($$) {
|
|
my $text = shift;
|
|
my $default = shift;
|
|
|
|
$DEBUGGING && debug "UI_GetString: $UI_Mode: $text $default";
|
|
|
|
my $string;
|
|
if ($UI_Mode eq "text") {
|
|
|
|
if ($term) {
|
|
$string = $term->readline($text, $default);
|
|
} else {
|
|
local $| = 1;
|
|
print "$text";
|
|
$string = <STDIN>;
|
|
chomp($string);
|
|
}
|
|
|
|
} else {
|
|
|
|
SendDataToYast({
|
|
type => "dialog-getstring",
|
|
label => $text,
|
|
default => $default
|
|
});
|
|
my ($ypath, $yarg) = GetDataFromYast();
|
|
$string = $yarg->{string};
|
|
|
|
}
|
|
return $string;
|
|
}
|
|
|
|
sub UI_GetFile ($) {
|
|
my $f = shift;
|
|
|
|
$DEBUGGING && debug "UI_GetFile: $UI_Mode";
|
|
|
|
my $filename;
|
|
if ($UI_Mode eq "text") {
|
|
|
|
local $| = 1;
|
|
print "$f->{description}\n";
|
|
$filename = <STDIN>;
|
|
chomp($filename);
|
|
|
|
} else {
|
|
|
|
$f->{type} = "dialog-getfile";
|
|
|
|
SendDataToYast($f);
|
|
my ($ypath, $yarg) = GetDataFromYast();
|
|
if ($yarg->{answer} eq "okay") {
|
|
$filename = $yarg->{filename};
|
|
}
|
|
}
|
|
|
|
return $filename;
|
|
}
|
|
|
|
sub UI_BusyStart ($) {
|
|
my $message = shift;
|
|
$DEBUGGING && debug "UI_BusyStart: $UI_Mode";
|
|
|
|
if ($UI_Mode eq "text") {
|
|
UI_Info( $message );
|
|
} else {
|
|
SendDataToYast({
|
|
type => "dialog-busy-start",
|
|
message => $message,
|
|
});
|
|
my ($ypath, $yarg) = GetDataFromYast();
|
|
}
|
|
}
|
|
|
|
sub UI_BusyStop {
|
|
$DEBUGGING && debug "UI_BusyStop: $UI_Mode";
|
|
|
|
if ($UI_Mode ne "text") {
|
|
SendDataToYast({ type => "dialog-busy-stop" });
|
|
my ($ypath, $yarg) = GetDataFromYast();
|
|
}
|
|
}
|
|
|
|
|
|
my %CMDS = (
|
|
CMD_ALLOW => "(A)llow",
|
|
CMD_OTHER => "(M)ore",
|
|
CMD_AUDIT_NEW => "Audi(t)",
|
|
CMD_AUDIT_OFF => "Audi(t) off",
|
|
CMD_AUDIT_FULL => "Audit (A)ll",
|
|
CMD_OTHER => "(O)pts",
|
|
CMD_USER_ON => "(O)wner permissions on",
|
|
CMD_USER_OFF => "(O)wner permissions off",
|
|
CMD_DENY => "(D)eny",
|
|
CMD_ABORT => "Abo(r)t",
|
|
CMD_FINISHED => "(F)inish",
|
|
CMD_ix => "(I)nherit",
|
|
CMD_px => "(P)rofile",
|
|
CMD_px_safe => "(P)rofile Clean Exec",
|
|
CMD_cx => "(C)hild",
|
|
CMD_cx_safe => "(C)hild Clean Exec",
|
|
CMD_nx => "(N)ame",
|
|
CMD_nx_safe => "(N)amed Clean Exec",
|
|
CMD_ux => "(U)nconfined",
|
|
CMD_ux_safe => "(U)nconfined Clean Exec",
|
|
CMD_pix => "(P)rofile ix",
|
|
CMD_pix_safe => "(P)rofile ix Clean Exec",
|
|
CMD_cix => "(C)hild ix",
|
|
CMD_cix_safe => "(C)hild ix Cx Clean Exec",
|
|
CMD_nix => "(N)ame ix",
|
|
CMD_nix_safe => "(N)ame ix",
|
|
CMD_EXEC_IX_ON => "(X)ix",
|
|
CMD_EXEC_IX_OFF => "(X)ix",
|
|
CMD_SAVE => "(S)ave Changes",
|
|
CMD_CONTINUE => "(C)ontinue Profiling",
|
|
CMD_NEW => "(N)ew",
|
|
CMD_GLOB => "(G)lob",
|
|
CMD_GLOBEXT => "Glob w/(E)xt",
|
|
CMD_ADDHAT => "(A)dd Requested Hat",
|
|
CMD_USEDEFAULT => "(U)se Default Hat",
|
|
CMD_SCAN => "(S)can system log for SubDomain events",
|
|
CMD_HELP => "(H)elp",
|
|
CMD_VIEW_PROFILE => "(V)iew Profile",
|
|
CMD_USE_PROFILE => "(U)se Profile",
|
|
CMD_CREATE_PROFILE => "(C)reate New Profile",
|
|
CMD_UPDATE_PROFILE => "(U)pdate Profile",
|
|
CMD_IGNORE_UPDATE => "(I)gnore Update",
|
|
CMD_SAVE_CHANGES => "(S)ave Changes",
|
|
CMD_UPLOAD_CHANGES => "(U)pload Changes",
|
|
CMD_VIEW_CHANGES => "(V)iew Changes",
|
|
CMD_VIEW => "(V)iew",
|
|
CMD_ENABLE_REPO => "(E)nable Repository",
|
|
CMD_DISABLE_REPO => "(D)isable Repository",
|
|
CMD_ASK_NEVER => "(N)ever Ask Again",
|
|
CMD_ASK_LATER => "Ask Me (L)ater",
|
|
CMD_YES => "(Y)es",
|
|
CMD_NO => "(N)o",
|
|
CMD_ALL_NET => "Allow All (N)etwork",
|
|
CMD_NET_FAMILY => "Allow Network Fa(m)ily",
|
|
CMD_OVERWRITE => "(O)verwrite Profile",
|
|
CMD_KEEP => "(K)eep Profile",
|
|
CMD_CONTINUE => "(C)ontinue",
|
|
);
|
|
|
|
sub UI_PromptUser ($) {
|
|
my $q = shift;
|
|
|
|
my ($cmd, $arg);
|
|
if ($UI_Mode eq "text") {
|
|
|
|
($cmd, $arg) = Text_PromptUser($q);
|
|
|
|
} else {
|
|
|
|
$q->{type} = "wizard";
|
|
|
|
SendDataToYast($q);
|
|
my ($ypath, $yarg) = GetDataFromYast();
|
|
|
|
$cmd = $yarg->{selection} || "CMD_ABORT";
|
|
$arg = $yarg->{selected};
|
|
}
|
|
|
|
if ($cmd eq "CMD_ABORT") {
|
|
confirm_and_abort();
|
|
$cmd = "XXXINVALIDXXX";
|
|
} elsif ($cmd eq "CMD_FINISHED") {
|
|
confirm_and_finish();
|
|
$cmd = "XXXINVALIDXXX";
|
|
}
|
|
|
|
if (wantarray) {
|
|
return ($cmd, $arg);
|
|
} else {
|
|
return $cmd;
|
|
}
|
|
}
|
|
|
|
|
|
sub UI_ShortMessage {
|
|
my ($headline, $message) = @_;
|
|
|
|
SendDataToYast(
|
|
{
|
|
type => "short-dialog-message",
|
|
headline => $headline,
|
|
message => $message
|
|
}
|
|
);
|
|
my ($ypath, $yarg) = GetDataFromYast();
|
|
}
|
|
|
|
sub UI_LongMessage {
|
|
my ($headline, $message) = @_;
|
|
|
|
$headline = "MISSING" if not defined $headline;
|
|
$message = "MISSING" if not defined $message;
|
|
|
|
SendDataToYast(
|
|
{
|
|
type => "long-dialog-message",
|
|
headline => $headline,
|
|
message => $message
|
|
}
|
|
);
|
|
my ($ypath, $yarg) = GetDataFromYast();
|
|
}
|
|
|
|
##########################################################################
|
|
# here are the interface functions to send data back and forth between
|
|
# the yast frontend and the perl backend
|
|
|
|
# this is super ugly, but waits for the next ycp Read command and sends data
|
|
# back to the ycp front end.
|
|
|
|
sub SendDataToYast {
|
|
my $data = shift;
|
|
|
|
$DEBUGGING && debug "SendDataToYast: Waiting for YCP command";
|
|
|
|
while (<STDIN>) {
|
|
$DEBUGGING && debug "SendDataToYast: YCP: $_";
|
|
my ($ycommand, $ypath, $yargument) = ycp::ParseCommand($_);
|
|
|
|
if ($ycommand && $ycommand eq "Read") {
|
|
|
|
if ($DEBUGGING) {
|
|
my $debugmsg = Data::Dumper->Dump([$data], [qw(*data)]);
|
|
debug "SendDataToYast: Sending--\n$debugmsg";
|
|
}
|
|
|
|
ycp::Return($data);
|
|
return 1;
|
|
|
|
} else {
|
|
|
|
$DEBUGGING && debug "SendDataToYast: Expected 'Read' but got-- $_";
|
|
|
|
}
|
|
}
|
|
|
|
# if we ever break out here, something's horribly wrong.
|
|
fatal_error "SendDataToYast: didn't receive YCP command before connection died";
|
|
}
|
|
|
|
# this is super ugly, but waits for the next ycp Write command and grabs
|
|
# whatever the ycp front end gives us
|
|
|
|
sub GetDataFromYast {
|
|
|
|
$DEBUGGING && debug "GetDataFromYast: Waiting for YCP command";
|
|
|
|
while (<STDIN>) {
|
|
$DEBUGGING && debug "GetDataFromYast: YCP: $_";
|
|
my ($ycmd, $ypath, $yarg) = ycp::ParseCommand($_);
|
|
|
|
if ($DEBUGGING) {
|
|
my $debugmsg = Data::Dumper->Dump([$yarg], [qw(*data)]);
|
|
debug "GetDataFromYast: Received--\n$debugmsg";
|
|
}
|
|
|
|
if ($ycmd && $ycmd eq "Write") {
|
|
|
|
ycp::Return("true");
|
|
return ($ypath, $yarg);
|
|
|
|
} else {
|
|
$DEBUGGING && debug "GetDataFromYast: Expected 'Write' but got-- $_";
|
|
}
|
|
}
|
|
|
|
# if we ever break out here, something's horribly wrong.
|
|
fatal_error "GetDataFromYast: didn't receive YCP command before connection died";
|
|
}
|
|
|
|
sub confirm_and_abort {
|
|
my $ans = UI_YesNo(gettext("Are you sure you want to abandon this set of profile changes and exit?"), "n");
|
|
if ($ans eq "y") {
|
|
UI_Info(gettext("Abandoning all changes."));
|
|
shutdown_yast();
|
|
exit 0;
|
|
}
|
|
}
|
|
|
|
sub confirm_and_finish {
|
|
die "FINISHING\n";
|
|
}
|
|
|
|
sub build_x_functions($$$) {
|
|
my ($default, $options, $exec_toggle) = @_;
|
|
my @{list};
|
|
if ($exec_toggle) {
|
|
push @list, "CMD_ix" if $options =~ /i/;
|
|
push @list, "CMD_pix" if $options =~ /p/ and $options =~ /i/;
|
|
push @list, "CMD_cix" if $options =~ /c/ and $options =~ /i/;
|
|
push @list, "CMD_nix" if $options =~ /n/ and $options =~ /i/;
|
|
push @list, "CMD_ux" if $options =~ /u/;
|
|
} else {
|
|
push @list, "CMD_ix" if $options =~ /i/;
|
|
push @list, "CMD_px" if $options =~ /p/;
|
|
push @list, "CMD_cx" if $options =~ /c/;
|
|
push @list, "CMD_nx" if $options =~ /n/;
|
|
push @list, "CMD_ux" if $options =~ /u/;
|
|
}
|
|
if ($exec_toggle) {
|
|
push @list, "CMD_EXEC_IX_OFF" if $options =~/p|c|n/;
|
|
} else {
|
|
push @list, "CMD_EXEC_IX_ON" if $options =~/p|c|n/;
|
|
}
|
|
push @list, "CMD_DENY", "CMD_ABORT", "CMD_FINISHED";
|
|
return @list;
|
|
}
|
|
|
|
##########################################################################
|
|
# this is the hideously ugly function that descends down the flow/event
|
|
# trees that we've generated by parsing the logfile
|
|
|
|
sub handlechildren {
|
|
my $profile = shift;
|
|
my $hat = shift;
|
|
my $root = shift;
|
|
|
|
my @entries = @$root;
|
|
for my $entry (@entries) {
|
|
fatal_error "$entry is not a ref" if not ref($entry);
|
|
|
|
if (ref($entry->[0])) {
|
|
handlechildren($profile, $hat, $entry);
|
|
} else {
|
|
|
|
my @entry = @$entry;
|
|
my $type = shift @entry;
|
|
|
|
if ($type eq "fork") {
|
|
my ($pid, $p, $h) = @entry;
|
|
|
|
if ( ($p !~ /null(-complain)*-profile/)
|
|
&& ($h !~ /null(-complain)*-profile/))
|
|
{
|
|
$profile = $p;
|
|
$hat = $h;
|
|
}
|
|
|
|
if ($hat) {
|
|
$profilechanges{$pid} = $profile . "//" . $hat;
|
|
} else {
|
|
$profilechanges{$pid} = $profile;
|
|
}
|
|
} elsif ($type eq "unknown_hat") {
|
|
my ($pid, $p, $h, $sdmode, $uhat) = @entry;
|
|
|
|
if ($p !~ /null(-complain)*-profile/) {
|
|
$profile = $p;
|
|
}
|
|
|
|
if ($sd{$profile}{$uhat}) {
|
|
$hat = $uhat;
|
|
next;
|
|
}
|
|
|
|
my $new_p = update_repo_profile($sd{$profile}{$profile});
|
|
if ( $new_p and
|
|
UI_SelectUpdatedRepoProfile($profile, $new_p) and
|
|
$sd{$profile}{$uhat} ) {
|
|
$hat = $uhat;
|
|
next;
|
|
}
|
|
|
|
# figure out what our default hat for this application is.
|
|
my $defaulthat;
|
|
for my $hatglob (keys %{$cfg->{defaulthat}}) {
|
|
$defaulthat = $cfg->{defaulthat}{$hatglob}
|
|
if $profile =~ /$hatglob/;
|
|
}
|
|
# keep track of previous answers for this run...
|
|
my $context = $profile;
|
|
$context .= " -> ^$uhat";
|
|
my $ans = $transitions{$context} || "XXXINVALIDXXX";
|
|
|
|
while ($ans !~ /^CMD_(ADDHAT|USEDEFAULT|DENY)$/) {
|
|
my $q = {};
|
|
$q->{headers} = [];
|
|
push @{ $q->{headers} }, gettext("Profile"), $profile;
|
|
if ($defaulthat) {
|
|
push @{ $q->{headers} }, gettext("Default Hat"), $defaulthat;
|
|
}
|
|
push @{ $q->{headers} }, gettext("Requested Hat"), $uhat;
|
|
|
|
$q->{functions} = [];
|
|
push @{ $q->{functions} }, "CMD_ADDHAT";
|
|
push @{ $q->{functions} }, "CMD_USEDEFAULT" if $defaulthat;
|
|
push @{$q->{functions}}, "CMD_DENY", "CMD_ABORT",
|
|
"CMD_FINISHED";
|
|
|
|
$q->{default} = ($sdmode eq "PERMITTING") ? "CMD_ADDHAT" : "CMD_DENY";
|
|
|
|
$seenevents++;
|
|
|
|
$ans = UI_PromptUser($q);
|
|
|
|
}
|
|
$transitions{$context} = $ans;
|
|
|
|
if ($ans eq "CMD_ADDHAT") {
|
|
$hat = $uhat;
|
|
$sd{$profile}{$hat}{flags} = $sd{$profile}{$profile}{flags};
|
|
} elsif ($ans eq "CMD_USEDEFAULT") {
|
|
$hat = $defaulthat;
|
|
} elsif ($ans eq "CMD_DENY") {
|
|
return;
|
|
}
|
|
|
|
} elsif ($type eq "capability") {
|
|
my ($pid, $p, $h, $prog, $sdmode, $capability) = @entry;
|
|
|
|
if ( ($p !~ /null(-complain)*-profile/)
|
|
&& ($h !~ /null(-complain)*-profile/))
|
|
{
|
|
$profile = $p;
|
|
$hat = $h;
|
|
}
|
|
|
|
# print "$pid $profile $hat $prog $sdmode capability $capability\n";
|
|
|
|
next unless $profile && $hat;
|
|
|
|
$prelog{$sdmode}{$profile}{$hat}{capability}{$capability} = 1;
|
|
} elsif (($type eq "path") || ($type eq "exec")) {
|
|
my ($pid, $p, $h, $prog, $sdmode, $mode, $detail, $to_name) = @entry;
|
|
|
|
$mode = 0 unless ($mode);
|
|
|
|
if ( ($p !~ /null(-complain)*-profile/)
|
|
&& ($h !~ /null(-complain)*-profile/))
|
|
{
|
|
$profile = $p;
|
|
$hat = $h;
|
|
}
|
|
|
|
next unless $profile && $hat;
|
|
my $domainchange = ($type eq "exec") ? "change" : "nochange";
|
|
|
|
# escape special characters that show up in literal paths
|
|
$detail =~ s/(\[|\]|\+|\*|\{|\})/\\$1/g;
|
|
|
|
# we need to give the Execute dialog if they're requesting x
|
|
# access for something that's not a directory - we'll force
|
|
# a "ix" Path dialog for directories
|
|
my $do_execute = 0;
|
|
my $exec_target = $detail;
|
|
|
|
if ($mode & str_to_mode("x")) {
|
|
if (-d $exec_target) {
|
|
$mode &= (~$ALL_AA_EXEC_TYPE);
|
|
$mode |= str_to_mode("ix");
|
|
} else {
|
|
$do_execute = 1;
|
|
}
|
|
}
|
|
|
|
if ($mode & $AA_MAY_LINK) {
|
|
if ($detail =~ m/^from (.+) to (.+)$/) {
|
|
my ($path, $target) = ($1, $2);
|
|
|
|
my $frommode = str_to_mode("lr");
|
|
if (defined $prelog{$sdmode}{$profile}{$hat}{path}{$path}) {
|
|
$frommode |= $prelog{$sdmode}{$profile}{$hat}{path}{$path};
|
|
}
|
|
$prelog{$sdmode}{$profile}{$hat}{path}{$path} = $frommode;
|
|
|
|
my $tomode = str_to_mode("lr");
|
|
if (defined $prelog{$sdmode}{$profile}{$hat}{path}{$target}) {
|
|
$tomode |= $prelog{$sdmode}{$profile}{$hat}{path}{$target};
|
|
}
|
|
$prelog{$sdmode}{$profile}{$hat}{path}{$target} = $tomode;
|
|
|
|
# print "$pid $profile $hat $prog $sdmode $path:$frommode -> $target:$tomode\n";
|
|
} else {
|
|
next;
|
|
}
|
|
} elsif ($mode) {
|
|
my $path = $detail;
|
|
|
|
if (defined $prelog{$sdmode}{$profile}{$hat}{path}{$path}) {
|
|
$mode |= $prelog{$sdmode}{$profile}{$hat}{path}{$path};
|
|
}
|
|
$prelog{$sdmode}{$profile}{$hat}{path}{$path} = $mode;
|
|
|
|
# print "$pid $profile $hat $prog $sdmode $mode $path\n";
|
|
}
|
|
|
|
if ($do_execute) {
|
|
next if ( profile_known_exec($sd{$profile}{$hat},
|
|
"exec", $exec_target ) );
|
|
|
|
my $p = update_repo_profile($sd{$profile}{$profile});
|
|
|
|
if ($to_name) {
|
|
next if ( $to_name and
|
|
UI_SelectUpdatedRepoProfile($profile, $p) and
|
|
profile_known_exec($sd{$profile}{$hat},
|
|
"exec", $to_name ) );
|
|
} else {
|
|
next if ( UI_SelectUpdatedRepoProfile($profile, $p) and
|
|
profile_known_exec($sd{$profile}{$hat},
|
|
"exec", $exec_target ) );
|
|
}
|
|
|
|
my $context = $profile;
|
|
$context .= "^$hat" if $profile ne $hat;
|
|
$context .= " -> $exec_target";
|
|
my $ans = $transitions{$context} || "";
|
|
|
|
my ($combinedmode, $combinedaudit, $cm, $am, @m);
|
|
$combinedmode = 0;
|
|
$combinedaudit = 0;
|
|
|
|
# does path match any regexps in original profile?
|
|
($cm, $am, @m) = rematchfrag($sd{$profile}{$hat}, 'allow', $exec_target);
|
|
$combinedmode |= $cm if $cm;
|
|
$combinedaudit |= $am if $am;
|
|
|
|
# find the named transition if is present
|
|
if ($combinedmode & str_to_mode("x")) {
|
|
my $nt_name;
|
|
foreach my $entry (@m) {
|
|
if ($sd{$profile}{$hat}{allow}{path}{$entry}{to}) {
|
|
$nt_name = $sd{$profile}{$hat}{allow}{path}{$entry}{to};
|
|
last;
|
|
}
|
|
}
|
|
if ($to_name and $nt_name and ($to_name ne $nt_name)) {
|
|
#fatal_error "transition name from "
|
|
} elsif ($nt_name) {
|
|
$to_name = $nt_name;
|
|
}
|
|
}
|
|
|
|
# does path match anything pulled in by includes in
|
|
# original profile?
|
|
($cm, $am, @m) = match_prof_incs_to_path($sd{$profile}{$hat}, 'allow', $exec_target);
|
|
$combinedmode |= $cm if $cm;
|
|
$combinedaudit |= $am if $am;
|
|
if ($combinedmode & str_to_mode("x")) {
|
|
my $nt_name;
|
|
foreach my $entry (@m) {
|
|
if ($sd{$profile}{$hat}{allow}{path}{$entry}{to}) {
|
|
$nt_name = $sd{$profile}{$hat}{allow}{path}{$entry}{to};
|
|
last;
|
|
}
|
|
}
|
|
if ($to_name and $nt_name and ($to_name ne $nt_name)) {
|
|
#fatal_error "transition name from "
|
|
} elsif ($nt_name) {
|
|
$to_name = $nt_name;
|
|
}
|
|
}
|
|
|
|
|
|
#nx does not exist in profiles. It does in log
|
|
#files however. The log parsing routines will convert
|
|
#it to its profile form.
|
|
#nx is internally represented by cx/px/cix/pix + to_name
|
|
my $exec_mode = 0;
|
|
if (contains($combinedmode, "pix")) {
|
|
if ($to_name) {
|
|
$ans = "CMD_nix";
|
|
} else {
|
|
$ans = "CMD_pix";
|
|
}
|
|
$exec_mode = str_to_mode("pixr");
|
|
} elsif (contains($combinedmode, "cix")) {
|
|
if ($to_name) {
|
|
$ans = "CMD_nix";
|
|
} else {
|
|
$ans = "CMD_cix";
|
|
}
|
|
$exec_mode = str_to_mode("cixr");
|
|
} elsif (contains($combinedmode, "Pix")) {
|
|
if ($to_name) {
|
|
$ans = "CMD_nix_safe";
|
|
} else {
|
|
$ans = "CMD_pix_safe";
|
|
}
|
|
$exec_mode = str_to_mode("Pixr");
|
|
} elsif (contains($combinedmode, "Cix")) {
|
|
if ($to_name) {
|
|
$ans = "CMD_nix_safe";
|
|
} else {
|
|
$ans = "CMD_cix_safe";
|
|
}
|
|
$exec_mode = str_to_mode("Cixr");
|
|
} elsif (contains($combinedmode, "ix")) {
|
|
$ans = "CMD_ix";
|
|
$exec_mode = str_to_mode("ixr");
|
|
} elsif (contains($combinedmode, "px")) {
|
|
if ($to_name) {
|
|
$ans = "CMD_nx";
|
|
} else {
|
|
$ans = "CMD_px";
|
|
}
|
|
$exec_mode = str_to_mode("px");
|
|
} elsif (contains($combinedmode, "cx")) {
|
|
if ($to_name) {
|
|
$ans = "CMD_nx";
|
|
} else {
|
|
$ans = "CMD_cx";
|
|
}
|
|
$exec_mode = str_to_mode("cx");
|
|
} elsif (contains($combinedmode, "ux")) {
|
|
$ans = "CMD_ux";
|
|
$exec_mode = str_to_mode("ux");
|
|
} elsif (contains($combinedmode, "Px")) {
|
|
if ($to_name) {
|
|
$ans = "CMD_nx_safe";
|
|
} else {
|
|
$ans = "CMD_px_safe";
|
|
}
|
|
$exec_mode = str_to_mode("Px");
|
|
} elsif (contains($combinedmode, "Cx")) {
|
|
if ($to_name) {
|
|
$ans = "CMD_nx_safe";
|
|
} else {
|
|
$ans = "CMD_cx_safe";
|
|
}
|
|
$exec_mode = str_to_mode("Cx");
|
|
} elsif (contains($combinedmode, "Ux")) {
|
|
$ans = "CMD_ux_safe";
|
|
$exec_mode = str_to_mode("Ux");
|
|
} else {
|
|
my $options = $cfg->{qualifiers}{$exec_target} || "ipcnu";
|
|
fatal_error "$entry has transition name but not transition mode" if $to_name;
|
|
|
|
# force "ix" as the only option when the profiled
|
|
# program executes itself
|
|
$options = "i" if $exec_target eq $profile;
|
|
|
|
# for now don't allow hats to cx
|
|
$options =~ s/c// if $hat and $hat ne $profile;
|
|
|
|
# we always need deny...
|
|
$options .= "d";
|
|
|
|
# figure out what our default option should be...
|
|
my $default;
|
|
if ($options =~ /p/
|
|
&& -e getprofilefilename($exec_target))
|
|
{
|
|
$default = "CMD_px";
|
|
} elsif ($options =~ /i/) {
|
|
$default = "CMD_ix";
|
|
} elsif ($options =~ /c/) {
|
|
$default = "CMD_cx";
|
|
} elsif ($options =~ /n/) {
|
|
$default = "CMD_nx";
|
|
} else {
|
|
$default = "CMD_DENY";
|
|
}
|
|
|
|
# ugh, this doesn't work if someone does an ix before
|
|
# calling this particular child process. at least
|
|
# it's only a hint instead of mandatory to get this
|
|
# right.
|
|
my $parent_uses_ld_xxx = check_for_LD_XXX($profile);
|
|
|
|
my $severity = $sevdb->rank($exec_target, "x");
|
|
|
|
# build up the prompt...
|
|
my $q = {};
|
|
$q->{headers} = [];
|
|
push @{ $q->{headers} }, gettext("Profile"), combine_name($profile, $hat);
|
|
if ($prog && $prog ne "HINT") {
|
|
push @{ $q->{headers} }, gettext("Program"), $prog;
|
|
}
|
|
# $to_name should NOT exist here other wise we know what
|
|
# mode we are supposed to be transitioning to
|
|
# which is handled above.
|
|
push @{ $q->{headers} }, gettext("Execute"), $exec_target;
|
|
push @{ $q->{headers} }, gettext("Severity"), $severity;
|
|
|
|
$q->{functions} = [];
|
|
|
|
my $prompt = "\n$context\n";
|
|
my $exec_toggle = 0;
|
|
|
|
push @{ $q->{functions} }, build_x_functions($default, $options, $exec_toggle);
|
|
|
|
$options = join("|", split(//, $options));
|
|
|
|
$seenevents++;
|
|
|
|
while ($ans !~ m/^CMD_(ix|px|cx|nx|pix|cix|nix|px_safe|cx_safe|nx_safe|pix_safe|cix_safe|nix_safe|ux|ux_safe|EXEC_TOGGLE|DENY)$/) {
|
|
$ans = UI_PromptUser($q);
|
|
|
|
if ($ans =~ /CMD_EXEC_IX_/) {
|
|
$exec_toggle = !$exec_toggle;
|
|
|
|
$q->{functions} = [ ];
|
|
push @{ $q->{functions} }, build_x_functions($default, $options, $exec_toggle);
|
|
$ans = "";
|
|
next;
|
|
}
|
|
if ($ans =~ /CMD_(nx|nix)/) {
|
|
my $arg = $exec_target;
|
|
|
|
my $ynans = "n";
|
|
if ($profile eq $hat) {
|
|
$ynans = UI_YesNo("Are you specifying a transition to a local profile?", "n");
|
|
}
|
|
|
|
if ($ynans eq "y") {
|
|
if ($ans eq "CMD_nx") {
|
|
$ans = "CMD_cx";
|
|
} else {
|
|
$ans = "CMD_cix";
|
|
}
|
|
} else {
|
|
if ($ans eq "CMD_nx") {
|
|
$ans = "CMD_px";
|
|
} else {
|
|
$ans = "CMD_pix";
|
|
}
|
|
}
|
|
$to_name = UI_GetString(gettext("Enter profile name to transition to: "), $arg);
|
|
}
|
|
if ($ans =~ /CMD_ix/) {
|
|
$exec_mode = str_to_mode("ix");
|
|
} elsif ($ans =~ /CMD_(px|cx|nx|pix|cix|nix)/) {
|
|
my $match = $1;
|
|
$exec_mode = str_to_mode($match);
|
|
my $px_default = "n";
|
|
my $px_mesg = gettext("Should AppArmor sanitize the environment when\nswitching profiles?\n\nSanitizing the environment is more secure,\nbut some applications depend on the presence\nof LD_PRELOAD or LD_LIBRARY_PATH.");
|
|
if ($parent_uses_ld_xxx) {
|
|
$px_mesg = gettext("Should AppArmor sanitize the environment when\nswitching profiles?\n\nSanitizing the environment is more secure,\nbut this application appears to use LD_PRELOAD\nor LD_LIBRARY_PATH and clearing these could\ncause functionality problems.");
|
|
}
|
|
my $ynans = UI_YesNo($px_mesg, $px_default);
|
|
$ans = "CMD_$match";
|
|
if ($ynans eq "y") {
|
|
$exec_mode &= ~$AA_EXEC_UNSAFE;
|
|
}
|
|
} elsif ($ans eq "CMD_ux") {
|
|
$exec_mode = str_to_mode("ux");
|
|
my $ynans = UI_YesNo(sprintf(gettext("Launching processes in an unconfined state is a very\ndangerous operation and can cause serious security holes.\n\nAre you absolutely certain you wish to remove all\nAppArmor protection when executing \%s?"), $exec_target), "n");
|
|
if ($ynans eq "y") {
|
|
my $ynans = UI_YesNo(gettext("Should AppArmor sanitize the environment when\nrunning this program unconfined?\n\nNot sanitizing the environment when unconfining\na program opens up significant security holes\nand should be avoided if at all possible."), "y");
|
|
if ($ynans eq "y") {
|
|
$exec_mode &= ~($AA_EXEC_UNSAFE | ($AA_EXEC_UNSAFE << $AA_OTHER_SHIFT));
|
|
}
|
|
} else {
|
|
$ans = "INVALID";
|
|
}
|
|
}
|
|
}
|
|
$transitions{$context} = $ans;
|
|
|
|
if ($ans =~ /CMD_(ix|px|cx|nx|pix|cix|nix)/) {
|
|
# if we're inheriting, things'll bitch unless we have r
|
|
if ($exec_mode & str_to_mode("i")) {
|
|
$exec_mode |= str_to_mode("r");
|
|
}
|
|
|
|
} else {
|
|
if ($ans eq "CMD_DENY") {
|
|
$sd{$profile}{$hat}{deny}{path}{$exec_target}{mode} |= str_to_mode("x");
|
|
|
|
$sd{$profile}{$hat}{deny}{path}{$exec_target}{audit} |= 0;
|
|
$changed{$profile} = 1;
|
|
# skip all remaining events if they say to deny
|
|
# the exec
|
|
return if $domainchange eq "change";
|
|
}
|
|
|
|
}
|
|
|
|
unless ($ans eq "CMD_DENY") {
|
|
# ???? if its defined in the prelog we shouldn't have asked
|
|
if (defined $prelog{PERMITTING}{$profile}{$hat}{path}{$exec_target}) {
|
|
# $exec_mode = $prelog{PERMITTING}{$profile}{$hat}{path}{$exec_target};
|
|
}
|
|
|
|
$prelog{PERMITTING}{$profile}{$hat}{path}{$exec_target} |= $exec_mode;
|
|
$log{PERMITTING}{$profile} = {};
|
|
$sd{$profile}{$hat}{allow}{path}{$exec_target}{mode} |= $exec_mode;
|
|
$sd{$profile}{$hat}{allow}{path}{$exec_target}{audit} |= 0;
|
|
$sd{$profile}{$hat}{allow}{path}{$exec_target}{to} = $to_name if ($to_name);
|
|
|
|
# mark this profile as changed
|
|
$changed{$profile} = 1;
|
|
|
|
if ($exec_mode & str_to_mode("i")) {
|
|
if ($exec_target =~ /perl/) {
|
|
$sd{$profile}{$hat}{include}{"abstractions/perl"} = 1;
|
|
} elsif ($detail =~ m/\/bin\/(bash|sh)/) {
|
|
$sd{$profile}{$hat}{include}{"abstractions/bash"} = 1;
|
|
}
|
|
my $hashbang = head($exec_target);
|
|
if ($hashbang =~ /^#!\s*(\S+)/) {
|
|
my $interpreter = get_full_path($1);
|
|
$sd{$profile}{$hat}{path}->{$interpreter}{mode} |= str_to_mode("ix");
|
|
$sd{$profile}{$hat}{path}->{$interpreter}{audit} |= 0;
|
|
if ($interpreter =~ /perl/) {
|
|
$sd{$profile}{$hat}{include}{"abstractions/perl"} = 1;
|
|
} elsif ($interpreter =~ m/\/bin\/(bash|sh)/) {
|
|
$sd{$profile}{$hat}{include}{"abstractions/bash"} = 1;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# print "$pid $profile $hat EXEC $exec_target $ans $exec_mode\n";
|
|
|
|
# update our tracking info based on what kind of change
|
|
# this is...
|
|
if ($ans eq "CMD_ix") {
|
|
if ($hat) {
|
|
$profilechanges{$pid} = $profile . "//" . $hat;
|
|
} else {
|
|
$profilechanges{$pid} = $profile;
|
|
}
|
|
} elsif ($ans =~ /^CMD_(px|nx|pix|nix)/) {
|
|
$exec_target = $to_name if ($to_name);
|
|
if ($sdmode eq "PERMITTING") {
|
|
if ($domainchange eq "change") {
|
|
$profile = $exec_target;
|
|
$hat = $exec_target;
|
|
$profilechanges{$pid} = $profile;
|
|
}
|
|
}
|
|
# if they want to use px, make sure a profile
|
|
# exists for the target.
|
|
unless (-e getprofilefilename($exec_target)) {
|
|
my $ynans = "y";
|
|
if ($exec_mode & str_to_mode("i")) {
|
|
$ynans = UI_YesNo(sprintf(gettext("A profile for %s does not exist create one?"), $exec_target), "n");
|
|
}
|
|
if ($ynans eq "y") {
|
|
$helpers{$exec_target} = "enforce";
|
|
if ($to_name) {
|
|
autodep_base("", $exec_target);
|
|
} else {
|
|
autodep_base($exec_target, "");
|
|
}
|
|
reload_base($exec_target);
|
|
}
|
|
}
|
|
} elsif ($ans =~ /^CMD_(cx|cix)/) {
|
|
$exec_target = $to_name if ($to_name);
|
|
if ($sdmode eq "PERMITTING") {
|
|
if ($domainchange eq "change") {
|
|
$profilechanges{$pid} = "${profile}//${exec_target}";
|
|
# $profile = $exec_target;
|
|
# $hat = $exec_target;
|
|
}
|
|
}
|
|
|
|
# if they want to use cx, make sure a profile
|
|
# exists for the target.
|
|
unless ($sd{$profile}{$exec_target}) {
|
|
my $ynans = "y";
|
|
if ($exec_mode & str_to_mode("i")) {
|
|
$ynans = UI_YesNo(sprintf(gettext("A local profile for %s does not exist create one?"), $exec_target), "n");
|
|
}
|
|
if ($ynans eq "y") {
|
|
$hat = $exec_target;
|
|
# keep track of profile flags
|
|
#$profile_data->{$profile}{$hat}{flags} = ;
|
|
|
|
# we have seen more than a declaration so clear it
|
|
$sd{$profile}{$hat}{'declared'} = 0;
|
|
$sd{$profile}{$hat}{profile} = 1;
|
|
$sd{$profile}{$hat}{allow}{path} = { };
|
|
$sd{$profile}{$hat}{allow}{netdomain} = { };
|
|
my $file = $sd{$profile}{$profile}{filename};
|
|
$filelist{$file}{profiles}{$profile}{$hat} = 1;
|
|
|
|
}
|
|
}
|
|
} elsif ($ans =~ /^CMD_ux/) {
|
|
$profilechanges{$pid} = "unconfined";
|
|
return if $domainchange eq "change";
|
|
}
|
|
}
|
|
} elsif ( $type eq "netdomain" ) {
|
|
my ($pid, $p, $h, $prog, $sdmode, $family, $sock_type, $protocol) =
|
|
@entry;
|
|
|
|
if ( ($p !~ /null(-complain)*-profile/)
|
|
&& ($h !~ /null(-complain)*-profile/))
|
|
{
|
|
$profile = $p;
|
|
$hat = $h;
|
|
}
|
|
|
|
next unless $profile && $hat;
|
|
$prelog{$sdmode}
|
|
{$profile}
|
|
{$hat}
|
|
{netdomain}
|
|
{$family}
|
|
{$sock_type} = 1 unless ( !$family || !$sock_type );
|
|
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
sub add_to_tree ($@) {
|
|
my ($pid, $parent, $type, @event) = @_;
|
|
if ( $DEBUGGING ) {
|
|
my $eventmsg = Data::Dumper->Dump([@event], [qw(*event)]);
|
|
$eventmsg =~ s/\n/ /g;
|
|
debug " add_to_tree: pid [$pid] type [$type] event [ $eventmsg ]";
|
|
}
|
|
|
|
unless (exists $pid{$pid}) {
|
|
my $profile = $event[0];
|
|
my $hat = $event[1];
|
|
if ($parent && exists $pid{$parent}) {
|
|
# fork entry is missing fake one so that fork tracking will work
|
|
$hat ||= "null-complain-profile";
|
|
my $arrayref = [];
|
|
push @{ $pid{$parent} }, $arrayref;
|
|
$pid{$pid} = $arrayref;
|
|
push @{$arrayref}, [ "fork", $pid, $profile, $hat ];
|
|
} else {
|
|
my $arrayref = [];
|
|
push @log, $arrayref;
|
|
$pid{$pid} = $arrayref;
|
|
}
|
|
}
|
|
|
|
push @{ $pid{$pid} }, [ $type, $pid, @event ];
|
|
}
|
|
|
|
#
|
|
# variables used in the logparsing routines
|
|
#
|
|
our $LOG;
|
|
our $next_log_entry;
|
|
our $logmark;
|
|
our $seenmark;
|
|
my $RE_LOG_v2_0_syslog = qr/SubDomain/;
|
|
my $RE_LOG_v2_1_syslog = qr/kernel:\s+(\[[\d\.\s]+\]\s+)?(audit\([\d\.\:]+\):\s+)?type=150[1-6]/;
|
|
my $RE_LOG_v2_0_audit =
|
|
qr/type=(APPARMOR|UNKNOWN\[1500\]) msg=audit\([\d\.\:]+\):/;
|
|
my $RE_LOG_v2_1_audit =
|
|
qr/type=(UNKNOWN\[150[1-6]\]|APPARMOR_(AUDIT|ALLOWED|DENIED|HINT|STATUS|ERROR))/;
|
|
|
|
sub prefetch_next_log_entry {
|
|
# if we already have an existing cache entry, something's broken
|
|
if ($next_log_entry) {
|
|
print STDERR "Already had next log entry: $next_log_entry";
|
|
}
|
|
|
|
# read log entries until we either hit the end or run into an
|
|
# AA event message format we recognize
|
|
do {
|
|
$next_log_entry = <$LOG>;
|
|
$DEBUGGING && debug "prefetch_next_log_entry: next_log_entry = " . ($next_log_entry ? $next_log_entry : "empty");
|
|
} until (!$next_log_entry || $next_log_entry =~ m{
|
|
$RE_LOG_v2_0_syslog |
|
|
$RE_LOG_v2_0_audit |
|
|
$RE_LOG_v2_1_audit |
|
|
$RE_LOG_v2_1_syslog |
|
|
$logmark
|
|
}x);
|
|
}
|
|
|
|
sub get_next_log_entry {
|
|
# make sure we've got a next log entry if there is one
|
|
prefetch_next_log_entry() unless $next_log_entry;
|
|
|
|
# save a copy of the next log entry...
|
|
my $log_entry = $next_log_entry;
|
|
|
|
# zero out our cache of the next log entry
|
|
$next_log_entry = undef;
|
|
|
|
return $log_entry;
|
|
}
|
|
|
|
sub peek_at_next_log_entry {
|
|
# make sure we've got a next log entry if there is one
|
|
prefetch_next_log_entry() unless $next_log_entry;
|
|
|
|
# return a copy of the next log entry without pulling it out of the cache
|
|
return $next_log_entry;
|
|
}
|
|
|
|
sub throw_away_next_log_entry {
|
|
$next_log_entry = undef;
|
|
}
|
|
|
|
sub parse_log_record_v_2_0 ($@) {
|
|
my ($record, $last) = @_;
|
|
$DEBUGGING && debug "parse_log_record_v_2_0: $record";
|
|
|
|
# What's this early out for? As far as I can tell, parse_log_record_v_2_0
|
|
# won't ever be called without something in $record
|
|
return $last if ( ! $record );
|
|
|
|
$_ = $record;
|
|
|
|
if (s/(PERMITTING|REJECTING)-SYSLOGFIX/$1/) {
|
|
s/%%/%/g;
|
|
}
|
|
|
|
if (m/LOGPROF-HINT unknown_hat (\S+) pid=(\d+) profile=(.+) active=(.+)/) {
|
|
my ($uhat, $pid, $profile, $hat) = ($1, $2, $3, $4);
|
|
|
|
$last = $&;
|
|
|
|
# we want to ignore entries for profiles that don't exist
|
|
# they're most likely broken entries or old entries for
|
|
# deleted profiles
|
|
return $&
|
|
if ( ($profile ne 'null-complain-profile')
|
|
&& (!profile_exists($profile)));
|
|
|
|
add_to_tree($pid, 0, "unknown_hat", $profile, $hat,
|
|
"PERMITTING", $uhat);
|
|
} elsif (m/LOGPROF-HINT (unknown_profile|missing_mandatory_profile) image=(.+) pid=(\d+) profile=(.+) active=(.+)/) {
|
|
my ($image, $pid, $profile, $hat) = ($2, $3, $4, $5);
|
|
|
|
return $& if $last =~ /PERMITTING x access to $image/;
|
|
$last = $&;
|
|
|
|
# we want to ignore entries for profiles that don't exist
|
|
# they're most likely broken entries or old entries for
|
|
# deleted profiles
|
|
return $&
|
|
if ( ($profile ne 'null-complain-profile')
|
|
&& (!profile_exists($profile)));
|
|
|
|
add_to_tree($pid, 0, "exec", $profile, $hat, "HINT", "PERMITTING", "x", $image);
|
|
|
|
} elsif (m/(PERMITTING|REJECTING) (\S+) access (.+) \((.+)\((\d+)\) profile (.+) active (.+)\)/) {
|
|
my ($sdmode, $mode, $detail, $prog, $pid, $profile, $hat) =
|
|
($1, $2, $3, $4, $5, $6, $7);
|
|
|
|
if ($mode eq "link") {
|
|
$mode = "l";
|
|
}
|
|
if (!validate_log_mode($mode)) {
|
|
fatal_error(sprintf(gettext('Log contains unknown mode %s.'), $mode));
|
|
}
|
|
|
|
my $domainchange = "nochange";
|
|
if ($mode =~ /x/) {
|
|
|
|
# we need to try to check if we're doing a domain transition
|
|
if ($sdmode eq "PERMITTING") {
|
|
my $following = peek_at_next_log_entry();
|
|
|
|
if ($following && ($following =~ m/changing_profile/)) {
|
|
$domainchange = "change";
|
|
throw_away_next_log_entry();
|
|
}
|
|
}
|
|
} else {
|
|
|
|
# we want to ignore duplicates for things other than executes...
|
|
return $& if $seen{$&};
|
|
$seen{$&} = 1;
|
|
}
|
|
|
|
$last = $&;
|
|
|
|
# we want to ignore entries for profiles that don't exist
|
|
# they're most likely broken entries or old entries for
|
|
# deleted profiles
|
|
if (($profile ne 'null-complain-profile')
|
|
&& (!profile_exists($profile)))
|
|
{
|
|
return $&;
|
|
}
|
|
|
|
# currently no way to stick pipe mediation in a profile, ignore
|
|
# any messages like this
|
|
return $& if $detail =~ /to pipe:/;
|
|
|
|
# strip out extra extended attribute info since we don't
|
|
# currently have a way to specify it in the profile and
|
|
# instead just need to provide the access to the base filename
|
|
$detail =~ s/\s+extended attribute \S+//;
|
|
|
|
# kerberos code checks to see if the krb5.conf file is world
|
|
# writable in a stupid way so we'll ignore any w accesses to
|
|
# krb5.conf
|
|
return $& if (($detail eq "to /etc/krb5.conf") && contains($mode, "w"));
|
|
|
|
# strip off the (deleted) tag that gets added if it's a
|
|
# deleted file
|
|
$detail =~ s/\s+\(deleted\)$//;
|
|
|
|
# next if (($detail =~ /to \/lib\/ld-/) && ($mode =~ /x/));
|
|
|
|
$detail =~ s/^to\s+//;
|
|
|
|
if ($domainchange eq "change") {
|
|
add_to_tree($pid, 0, "exec", $profile, $hat, $prog,
|
|
$sdmode, str_to_mode($mode), $detail);
|
|
} else {
|
|
add_to_tree($pid, 0, "path", $profile, $hat, $prog,
|
|
$sdmode, str_to_mode($mode), $detail);
|
|
}
|
|
|
|
} elsif (m/(PERMITTING|REJECTING) (?:mk|rm)dir on (.+) \((.+)\((\d+)\) profile (.+) active (.+)\)/) {
|
|
my ($sdmode, $path, $prog, $pid, $profile, $hat) =
|
|
($1, $2, $3, $4, $5, $6);
|
|
|
|
# we want to ignore duplicates for things other than executes...
|
|
return $& if $seen{$&}++;
|
|
|
|
$last = $&;
|
|
|
|
# we want to ignore entries for profiles that don't exist
|
|
# they're most likely broken entries or old entries for
|
|
# deleted profiles
|
|
return $&
|
|
if ( ($profile ne 'null-complain-profile')
|
|
&& (!profile_exists($profile)));
|
|
|
|
add_to_tree($pid, 0, "path", $profile, $hat, $prog, $sdmode,
|
|
"w", $path);
|
|
|
|
} elsif (m/(PERMITTING|REJECTING) xattr (\S+) on (.+) \((.+)\((\d+)\) profile (.+) active (.+)\)/) {
|
|
my ($sdmode, $xattr_op, $path, $prog, $pid, $profile, $hat) =
|
|
($1, $2, $3, $4, $5, $6, $7);
|
|
|
|
# we want to ignore duplicates for things other than executes...
|
|
return $& if $seen{$&}++;
|
|
|
|
$last = $&;
|
|
|
|
# we want to ignore entries for profiles that don't exist
|
|
# they're most likely broken entries or old entries for
|
|
# deleted profiles
|
|
return $&
|
|
if ( ($profile ne 'null-complain-profile')
|
|
&& (!profile_exists($profile)));
|
|
|
|
my $xattrmode;
|
|
if ($xattr_op eq "get" || $xattr_op eq "list") {
|
|
$xattrmode = "r";
|
|
} elsif ($xattr_op eq "set" || $xattr_op eq "remove") {
|
|
$xattrmode = "w";
|
|
}
|
|
|
|
if ($xattrmode) {
|
|
add_to_tree($pid, 0, "path", $profile, $hat, $prog, $sdmode,
|
|
str_to_mode($xattrmode), $path);
|
|
}
|
|
|
|
} elsif (m/(PERMITTING|REJECTING) attribute \((.*?)\) change to (.+) \((.+)\((\d+)\) profile (.+) active (.+)\)/) {
|
|
my ($sdmode, $change, $path, $prog, $pid, $profile, $hat) =
|
|
($1, $2, $3, $4, $5, $6, $7);
|
|
|
|
# we want to ignore duplicates for things other than executes...
|
|
return $& if $seen{$&};
|
|
$seen{$&} = 1;
|
|
|
|
$last = $&;
|
|
|
|
# we want to ignore entries for profiles that don't exist
|
|
# they're most likely broken entries or old entries for
|
|
# deleted profiles
|
|
return $&
|
|
if ( ($profile ne 'null-complain-profile')
|
|
&& (!profile_exists($profile)));
|
|
|
|
# kerberos code checks to see if the krb5.conf file is world
|
|
# writable in a stupid way so we'll ignore any w accesses to
|
|
# krb5.conf
|
|
return $& if $path eq "/etc/krb5.conf";
|
|
|
|
add_to_tree($pid, 0, "path", $profile, $hat, $prog, $sdmode,
|
|
str_to_mode("w"), $path);
|
|
|
|
} elsif (m/(PERMITTING|REJECTING) access to capability '(\S+)' \((.+)\((\d+)\) profile (.+) active (.+)\)/) {
|
|
my ($sdmode, $capability, $prog, $pid, $profile, $hat) =
|
|
($1, $2, $3, $4, $5, $6);
|
|
|
|
return $& if $seen{$&};
|
|
|
|
$seen{$&} = 1;
|
|
$last = $&;
|
|
|
|
# we want to ignore entries for profiles that don't exist - they're
|
|
# most likely broken entries or old entries for deleted profiles
|
|
return $&
|
|
if ( ($profile ne 'null-complain-profile')
|
|
&& (!profile_exists($profile)));
|
|
|
|
add_to_tree($pid, 0, "capability", $profile, $hat, $prog,
|
|
$sdmode, $capability);
|
|
|
|
} elsif (m/Fork parent (\d+) child (\d+) profile (.+) active (.+)/
|
|
|| m/LOGPROF-HINT fork pid=(\d+) child=(\d+) profile=(.+) active=(.+)/
|
|
|| m/LOGPROF-HINT fork pid=(\d+) child=(\d+)/)
|
|
{
|
|
my ($parent, $child, $profile, $hat) = ($1, $2, $3, $4);
|
|
|
|
$profile ||= "null-complain-profile";
|
|
$hat ||= "null-complain-profile";
|
|
|
|
$last = $&;
|
|
|
|
# we want to ignore entries for profiles that don't exist
|
|
# they're most likely broken entries or old entries for
|
|
# deleted profiles
|
|
return $&
|
|
if ( ($profile ne 'null-complain-profile')
|
|
&& (!profile_exists($profile)));
|
|
|
|
my $arrayref = [];
|
|
if (exists $pid{$parent}) {
|
|
push @{ $pid{$parent} }, $arrayref;
|
|
} else {
|
|
push @log, $arrayref;
|
|
}
|
|
$pid{$child} = $arrayref;
|
|
push @{$arrayref}, [ "fork", $child, $profile, $hat ];
|
|
} else {
|
|
$DEBUGGING && debug "UNHANDLED: $_";
|
|
}
|
|
return $last;
|
|
}
|
|
|
|
sub parse_log_record ($) {
|
|
my $record = shift;
|
|
$DEBUGGING && debug "parse_log_record: $record";
|
|
my $e = parse_event($record);
|
|
|
|
return $e;
|
|
}
|
|
|
|
|
|
sub add_event_to_tree ($) {
|
|
my $e = shift;
|
|
|
|
my $sdmode = $e->{sdmode}?$e->{sdmode}:"UNKNOWN";
|
|
if ( $e->{type} ) {
|
|
if ( $e->{type} =~ /(UNKNOWN\[1501\]|APPARMOR_AUDIT|1501)/ ) {
|
|
$sdmode = "AUDIT";
|
|
} elsif ( $e->{type} =~ /(UNKNOWN\[1502\]|APPARMOR_ALLOWED|1502)/ ) {
|
|
$sdmode = "PERMITTING";
|
|
} elsif ( $e->{type} =~ /(UNKNOWN\[1503\]|APPARMOR_DENIED|1503)/ ) {
|
|
$sdmode = "REJECTING";
|
|
} elsif ( $e->{type} =~ /(UNKNOWN\[1504\]|APPARMOR_HINT|1504)/ ) {
|
|
$sdmode = "HINT";
|
|
} elsif ( $e->{type} =~ /(UNKNOWN\[1505\]|APPARMOR_STATUS|1505)/ ) {
|
|
$sdmode = "STATUS";
|
|
} elsif ( $e->{type} =~ /(UNKNOWN\[1506\]|APPARMOR_ERROR|1506)/ ) {
|
|
$sdmode = "ERROR";
|
|
} else {
|
|
$sdmode = "UNKNOWN";
|
|
}
|
|
}
|
|
return if ( $sdmode =~ /UNKNOWN|AUDIT|STATUS|ERROR/ );
|
|
return if ($e->{operation} =~ /profile_set/);
|
|
|
|
my ($profile, $hat);
|
|
# just convert new null profile style names to old before we begin processing
|
|
# profile and name can contain multiple layers of null- but all we care about
|
|
# currently is single level.
|
|
if ($e->{profile} =~ m/\/\/null-/) {
|
|
$e->{profile} = "null-complain-profile";
|
|
}
|
|
($profile, $hat) = split /\/\//, $e->{profile};
|
|
if ( $e->{operation} eq "change_hat" ) {
|
|
#screen out change_hat events that aren't part of learning, as before
|
|
#AppArmor 2.4 these events only happend as hints during learning
|
|
return if ($sdmode ne "HINT" && $sdmode ne "PERMITTING");
|
|
($profile, $hat) = split /\/\//, $e->{name};
|
|
}
|
|
$hat = $profile if ( !$hat );
|
|
# TODO - refactor add_to_tree as prog is no longer supplied
|
|
# HINT is from previous format where prog was not
|
|
# consistently passed
|
|
my $prog = "HINT";
|
|
|
|
return if ($profile ne 'null-complain-profile' && !profile_exists($profile));
|
|
|
|
if ($e->{operation} eq "exec") {
|
|
if ( defined $e->{info} && $e->{info} eq "mandatory profile missing" ) {
|
|
add_to_tree( $e->{pid},
|
|
$e->{parent},
|
|
"exec",
|
|
$profile,
|
|
$hat,
|
|
$sdmode,
|
|
"PERMITTING",
|
|
$e->{denied_mask},
|
|
$e->{name},
|
|
$e->{name2}
|
|
);
|
|
} elsif ( defined $e->{name2} && $e->{name2} =~ m/\/\/null-/) {
|
|
add_to_tree( $e->{pid},
|
|
$e->{parent},
|
|
"exec",
|
|
$profile,
|
|
$hat,
|
|
$prog,
|
|
$sdmode,
|
|
$e->{denied_mask},
|
|
$e->{name},
|
|
""
|
|
);
|
|
}
|
|
} elsif ($e->{operation} =~ m/file_/) {
|
|
add_to_tree( $e->{pid},
|
|
$e->{parent},
|
|
"path",
|
|
$profile,
|
|
$hat,
|
|
$prog,
|
|
$sdmode,
|
|
$e->{denied_mask},
|
|
$e->{name},
|
|
"",
|
|
);
|
|
} elsif ($e->{operation} eq "open") {
|
|
add_to_tree( $e->{pid},
|
|
$e->{parent},
|
|
"path",
|
|
$profile,
|
|
$hat,
|
|
$prog,
|
|
$sdmode,
|
|
$e->{denied_mask},
|
|
$e->{name},
|
|
"",
|
|
);
|
|
} elsif ($e->{operation} eq "capable") {
|
|
add_to_tree( $e->{pid},
|
|
$e->{parent},
|
|
"capability",
|
|
$profile,
|
|
$hat,
|
|
$prog,
|
|
$sdmode,
|
|
$e->{name}
|
|
);
|
|
} elsif ($e->{operation} =~ m/xattr/ ||
|
|
$e->{operation} eq "setattr") {
|
|
add_to_tree( $e->{pid},
|
|
$e->{parent},
|
|
"path",
|
|
$profile,
|
|
$hat,
|
|
$prog,
|
|
$sdmode,
|
|
$e->{denied_mask},
|
|
$e->{name},
|
|
""
|
|
);
|
|
} elsif ($e->{operation} =~ m/inode_/) {
|
|
my $is_domain_change = 0;
|
|
|
|
if ($e->{operation} eq "inode_permission" &&
|
|
$e->{denied_mask} & $AA_MAY_EXEC &&
|
|
$sdmode eq "PERMITTING") {
|
|
|
|
my $following = peek_at_next_log_entry();
|
|
if ($following) {
|
|
my $entry = parse_log_record($following);
|
|
if ($entry &&
|
|
$entry->{info} &&
|
|
$entry->{info} eq "set profile" ) {
|
|
|
|
$is_domain_change = 1;
|
|
throw_away_next_log_entry();
|
|
}
|
|
}
|
|
}
|
|
|
|
if ($is_domain_change) {
|
|
add_to_tree( $e->{pid},
|
|
$e->{parent},
|
|
"exec",
|
|
$profile,
|
|
$hat,
|
|
$prog,
|
|
$sdmode,
|
|
$e->{denied_mask},
|
|
$e->{name},
|
|
$e->{name2}
|
|
);
|
|
} else {
|
|
add_to_tree( $e->{pid},
|
|
$e->{parent},
|
|
"path",
|
|
$profile,
|
|
$hat,
|
|
$prog,
|
|
$sdmode,
|
|
$e->{denied_mask},
|
|
$e->{name},
|
|
""
|
|
);
|
|
}
|
|
} elsif ($e->{operation} eq "sysctl") {
|
|
add_to_tree( $e->{pid},
|
|
$e->{parent},
|
|
"path",
|
|
$profile,
|
|
$hat,
|
|
$prog,
|
|
$sdmode,
|
|
$e->{denied_mask},
|
|
$e->{name},
|
|
""
|
|
);
|
|
} elsif ($e->{operation} eq "clone") {
|
|
my ($parent, $child) = ($e->{pid}, $e->{task});
|
|
$profile ||= "null-complain-profile";
|
|
$hat ||= "null-complain-profile";
|
|
my $arrayref = [];
|
|
if (exists $pid{$parent}) {
|
|
push @{ $pid{$parent} }, $arrayref;
|
|
} else {
|
|
push @log, $arrayref;
|
|
}
|
|
$pid{$child} = $arrayref;
|
|
push @{$arrayref}, [ "fork", $child, $profile, $hat ];
|
|
} elsif ($e->{operation} =~ m/socket_/) {
|
|
add_to_tree( $e->{pid},
|
|
$e->{parent},
|
|
"netdomain",
|
|
$profile,
|
|
$hat,
|
|
$prog,
|
|
$sdmode,
|
|
$e->{family},
|
|
$e->{sock_type},
|
|
$e->{protocol},
|
|
);
|
|
} elsif ($e->{operation} eq "change_hat") {
|
|
add_to_tree($e->{pid}, $e->{parent}, "unknown_hat", $profile, $hat, $sdmode, $hat);
|
|
} else {
|
|
if ( $DEBUGGING ) {
|
|
my $msg = Data::Dumper->Dump([$e], [qw(*event)]);
|
|
debug "UNHANDLED: $msg";
|
|
}
|
|
}
|
|
}
|
|
|
|
sub read_log {
|
|
$logmark = shift;
|
|
$seenmark = $logmark ? 0 : 1;
|
|
my $last;
|
|
my $event_type;
|
|
|
|
# okay, done loading the previous profiles, get on to the good stuff...
|
|
open($LOG, $filename)
|
|
or fatal_error "Can't read AppArmor logfile $filename: $!";
|
|
while ($_ = get_next_log_entry()) {
|
|
chomp;
|
|
|
|
$DEBUGGING && debug "read_log: $_";
|
|
|
|
$seenmark = 1 if /$logmark/;
|
|
|
|
$DEBUGGING && debug "read_log: seenmark = $seenmark";
|
|
next unless $seenmark;
|
|
|
|
my $last_match = ""; # v_2_0 syslog record parsing requires
|
|
# the previous aa record in the mandatory profile
|
|
# case
|
|
# all we care about is apparmor messages
|
|
if (/$RE_LOG_v2_0_syslog/ || /$RE_LOG_v2_0_audit/) {
|
|
$last_match = parse_log_record_v_2_0( $_, $last_match );
|
|
} else {
|
|
my $event = parse_log_record($_);
|
|
add_event_to_tree($event) if ( $event );
|
|
}
|
|
}
|
|
close($LOG);
|
|
$logmark = "";
|
|
}
|
|
|
|
|
|
sub UI_SelectUpdatedRepoProfile ($$) {
|
|
|
|
my ($profile, $p) = @_;
|
|
my $distro = $cfg->{repository}{distro};
|
|
my $url = $sd{$profile}{$profile}{repo}{url};
|
|
my $user = $sd{$profile}{$profile}{repo}{user};
|
|
my $id = $sd{$profile}{$profile}{repo}{id};
|
|
my $updated = 0;
|
|
|
|
if ($p) {
|
|
my $q = { };
|
|
$q->{headers} = [
|
|
"Profile", $profile,
|
|
"User", $user,
|
|
"Old Revision", $id,
|
|
"New Revision", $p->{id},
|
|
];
|
|
$q->{explanation} =
|
|
gettext( "An updated version of this profile has been found in the profile repository. Would you like to use it?");
|
|
$q->{functions} = [
|
|
"CMD_VIEW_CHANGES", "CMD_UPDATE_PROFILE", "CMD_IGNORE_UPDATE",
|
|
"CMD_ABORT", "CMD_FINISHED"
|
|
];
|
|
|
|
my $ans;
|
|
do {
|
|
$ans = UI_PromptUser($q);
|
|
|
|
if ($ans eq "CMD_VIEW_CHANGES") {
|
|
my $oldprofile = serialize_profile($sd{$profile}, $profile);
|
|
my $newprofile = $p->{profile};
|
|
display_changes($oldprofile, $newprofile);
|
|
}
|
|
} until $ans =~ /^CMD_(UPDATE_PROFILE|IGNORE_UPDATE)/;
|
|
|
|
if ($ans eq "CMD_UPDATE_PROFILE") {
|
|
eval {
|
|
my $profile_data =
|
|
parse_profile_data($p->{profile}, getprofilefilename($profile), 0);
|
|
if ($profile_data) {
|
|
attach_profile_data(\%sd, $profile_data);
|
|
$changed{$profile} = 1;
|
|
}
|
|
|
|
set_repo_info($sd{$profile}{$profile}, $url, $user, $p->{id});
|
|
|
|
UI_Info(
|
|
sprintf(
|
|
gettext("Updated profile %s to revision %s."),
|
|
$profile, $p->{id}
|
|
)
|
|
);
|
|
};
|
|
|
|
if ($@) {
|
|
UI_Info(gettext("Error parsing repository profile."));
|
|
} else {
|
|
$updated = 1;
|
|
}
|
|
}
|
|
}
|
|
return $updated;
|
|
}
|
|
|
|
sub UI_repo_signup {
|
|
|
|
my ($url, $res, $save_config, $newuser, $user, $pass, $email, $signup_okay);
|
|
$url = $cfg->{repository}{url};
|
|
do {
|
|
if ($UI_Mode eq "yast") {
|
|
SendDataToYast(
|
|
{
|
|
type => "dialog-repo-sign-in",
|
|
repo_url => $url
|
|
}
|
|
);
|
|
my ($ypath, $yarg) = GetDataFromYast();
|
|
$email = $yarg->{email};
|
|
$user = $yarg->{user};
|
|
$pass = $yarg->{pass};
|
|
$newuser = $yarg->{newuser};
|
|
$save_config = $yarg->{save_config};
|
|
if ($yarg->{cancelled} && $yarg->{cancelled} eq "y") {
|
|
return;
|
|
}
|
|
$DEBUGGING && debug("AppArmor Repository: \n\t " .
|
|
($newuser eq "1") ?
|
|
"New User\n\temail: [" . $email . "]" :
|
|
"Signin" . "\n\t user[" . $user . "]" .
|
|
"password [" . $pass . "]\n");
|
|
} else {
|
|
$newuser = UI_YesNo(gettext("Create New User?"), "n");
|
|
$user = UI_GetString(gettext("Username: "), $user);
|
|
$pass = UI_GetString(gettext("Password: "), $pass);
|
|
$email = UI_GetString(gettext("Email Addr: "), $email)
|
|
if ($newuser eq "y");
|
|
$save_config = UI_YesNo(gettext("Save Configuration? "), "y");
|
|
}
|
|
|
|
if ($newuser eq "y") {
|
|
my ($status_ok,$res) = user_register($url, $user, $pass, $email);
|
|
if ($status_ok) {
|
|
$signup_okay = 1;
|
|
} else {
|
|
my $errmsg =
|
|
gettext("The Profile Repository server returned the following error:") .
|
|
"\n" . $res?$res:gettext("UNKOWN ERROR") . "\n" .
|
|
gettext("Please re-enter registration information or contact the administrator.");
|
|
UI_Important(gettext("Login Error\n") . $errmsg);
|
|
}
|
|
} else {
|
|
my ($status_ok,$res) = user_login($url, $user, $pass);
|
|
if ($status_ok) {
|
|
$signup_okay = 1;
|
|
} else {
|
|
my $errmsg = gettext("Login failure\n Please check username and password and try again.") . "\n" . $res;
|
|
UI_Important($errmsg);
|
|
}
|
|
}
|
|
} until $signup_okay;
|
|
|
|
$repo_cfg->{repository}{user} = $user;
|
|
$repo_cfg->{repository}{pass} = $pass;
|
|
$repo_cfg->{repository}{email} = $email;
|
|
|
|
write_config("repository.conf", $repo_cfg) if ( $save_config eq "y" );
|
|
|
|
return ($user, $pass);
|
|
}
|
|
|
|
sub UI_ask_to_enable_repo {
|
|
|
|
my $q = { };
|
|
return if ( not defined $cfg->{repository}{url} );
|
|
$q->{headers} = [
|
|
gettext("Repository"), $cfg->{repository}{url},
|
|
];
|
|
$q->{explanation} = gettext( "Would you like to enable access to the
|
|
profile repository?" ); $q->{functions} = [ "CMD_ENABLE_REPO",
|
|
"CMD_DISABLE_REPO", "CMD_ASK_LATER", ];
|
|
|
|
my $cmd;
|
|
do {
|
|
$cmd = UI_PromptUser($q);
|
|
} until $cmd =~ /^CMD_(ENABLE_REPO|DISABLE_REPO|ASK_LATER)/;
|
|
|
|
if ($cmd eq "CMD_ENABLE_REPO") {
|
|
$repo_cfg->{repository}{enabled} = "yes";
|
|
} elsif ($cmd eq "CMD_DISABLE_REPO") {
|
|
$repo_cfg->{repository}{enabled} = "no";
|
|
} elsif ($cmd eq "CMD_ASK_LATER") {
|
|
$repo_cfg->{repository}{enabled} = "later";
|
|
}
|
|
|
|
eval { write_config("repository.conf", $repo_cfg) };
|
|
if ($@) {
|
|
fatal_error($@);
|
|
}
|
|
}
|
|
|
|
|
|
sub UI_ask_to_upload_profiles {
|
|
|
|
my $q = { };
|
|
$q->{headers} = [
|
|
gettext("Repository"), $cfg->{repository}{url},
|
|
];
|
|
$q->{explanation} =
|
|
gettext( "Would you like to upload newly created and changed profiles to
|
|
the profile repository?" );
|
|
$q->{functions} = [
|
|
"CMD_YES", "CMD_NO", "CMD_ASK_LATER",
|
|
];
|
|
|
|
my $cmd;
|
|
do {
|
|
$cmd = UI_PromptUser($q);
|
|
} until $cmd =~ /^CMD_(YES|NO|ASK_LATER)/;
|
|
|
|
if ($cmd eq "CMD_NO") {
|
|
$repo_cfg->{repository}{upload} = "no";
|
|
} elsif ($cmd eq "CMD_YES") {
|
|
$repo_cfg->{repository}{upload} = "yes";
|
|
} elsif ($cmd eq "CMD_ASK_LATER") {
|
|
$repo_cfg->{repository}{upload} = "later";
|
|
}
|
|
|
|
eval { write_config("repository.conf", $repo_cfg) };
|
|
if ($@) {
|
|
fatal_error($@);
|
|
}
|
|
}
|
|
|
|
|
|
sub parse_repo_profile {
|
|
my ($fqdbin, $repo_url, $profile) = @_;
|
|
|
|
my $profile_data = eval {
|
|
parse_profile_data($profile->{profile}, getprofilefilename($fqdbin), 0);
|
|
};
|
|
if ($@) {
|
|
print STDERR "PARSING ERROR: $@\n";
|
|
$profile_data = undef;
|
|
}
|
|
|
|
if ($profile_data) {
|
|
set_repo_info($profile_data->{$fqdbin}{$fqdbin}, $repo_url,
|
|
$profile->{username}, $profile->{id});
|
|
}
|
|
|
|
return $profile_data;
|
|
}
|
|
|
|
|
|
sub set_repo_info {
|
|
my ($profile_data, $repo_url, $username, $id) = @_;
|
|
|
|
# save repository metadata
|
|
$profile_data->{repo}{url} = $repo_url;
|
|
$profile_data->{repo}{user} = $username;
|
|
$profile_data->{repo}{id} = $id;
|
|
}
|
|
|
|
|
|
sub is_repo_profile {
|
|
my $profile_data = shift;
|
|
|
|
return $profile_data->{repo}{url} &&
|
|
$profile_data->{repo}{user} &&
|
|
$profile_data->{repo}{id};
|
|
}
|
|
|
|
|
|
sub get_repo_user_pass {
|
|
my ($user, $pass);
|
|
|
|
if ($repo_cfg) {
|
|
$user = $repo_cfg->{repository}{user};
|
|
$pass = $repo_cfg->{repository}{pass};
|
|
}
|
|
|
|
unless ($user && $pass) {
|
|
($user, $pass) = UI_repo_signup();
|
|
}
|
|
|
|
return ($user, $pass);
|
|
}
|
|
|
|
|
|
sub get_preferred_user ($) {
|
|
my $repo_url = shift;
|
|
return $cfg->{repository}{preferred_user} || "NOVELL";
|
|
}
|
|
|
|
|
|
sub repo_is_enabled () {
|
|
my $enabled;
|
|
if ($cfg->{repository}{url} &&
|
|
$repo_cfg &&
|
|
$repo_cfg->{repository}{enabled} &&
|
|
$repo_cfg->{repository}{enabled} eq "yes") {
|
|
$enabled = 1;
|
|
}
|
|
return $enabled;
|
|
}
|
|
|
|
|
|
sub update_repo_profile {
|
|
my $profile = shift;
|
|
|
|
return undef if ( not is_repo_profile($profile) );
|
|
my $distro = $cfg->{repository}{distro};
|
|
my $url = $profile->{repo}{url};
|
|
my $user = $profile->{repo}{user};
|
|
my $id = $profile->{repo}{id};
|
|
|
|
UI_BusyStart( gettext("Connecting to repository.....") );
|
|
my ($status_ok,$res) = fetch_newer_profile( $url,
|
|
$distro,
|
|
$user,
|
|
$id,
|
|
$profile->{name}
|
|
);
|
|
UI_BusyStop();
|
|
if ( ! $status_ok ) {
|
|
my $errmsg =
|
|
sprintf(
|
|
gettext("WARNING: Profile update check failed\nError Detail:\n%s"),
|
|
defined $res?$res:gettext("UNKNOWN ERROR"));
|
|
UI_Important($errmsg);
|
|
$res = undef;
|
|
}
|
|
return( $res );
|
|
}
|
|
|
|
sub UI_ask_mode_toggles ($$$) {
|
|
my ($audit_toggle, $owner_toggle, $oldmode) = @_;
|
|
my $q = { };
|
|
$q->{headers} = [ ];
|
|
# "Repository", $cfg->{repository}{url},
|
|
# ];
|
|
$q->{explanation} = gettext( "Change mode modifiers");
|
|
|
|
if ($audit_toggle) {
|
|
$q->{functions} = [ "CMD_AUDIT_OFF" ];
|
|
} else {
|
|
$q->{functions} = [ "CMD_AUDIT_NEW" ];
|
|
push @{$q->{functions}}, "CMD_AUDIT_FULL" if ($oldmode);
|
|
}
|
|
|
|
if ($owner_toggle) {
|
|
push @{$q->{functions}}, "CMD_USER_OFF";
|
|
} else {
|
|
push @{$q->{functions}}, "CMD_USER_ON";
|
|
}
|
|
push @{$q->{functions}}, "CMD_CONTINUE";
|
|
|
|
my $cmd;
|
|
do {
|
|
$cmd = UI_PromptUser($q);
|
|
} until $cmd =~ /^CMD_(AUDIT_OFF|AUDIT_NEW|AUDIT_FULL|USER_ON|USER_OFF|CONTINUE)/;
|
|
|
|
if ($cmd eq "CMD_AUDIT_OFF") {
|
|
$audit_toggle = 0;
|
|
} elsif ($cmd eq "CMD_AUDIT_NEW") {
|
|
$audit_toggle = 1;
|
|
} elsif ($cmd eq "CMD_AUDIT_FULL") {
|
|
$audit_toggle = 2;
|
|
} elsif ($cmd eq "CMD_USER_ON") {
|
|
$owner_toggle = 1;
|
|
} elsif ($cmd eq "CMD_USER_OFF") {
|
|
$owner_toggle = 0;
|
|
# $owner_toggle++;
|
|
# $owner_toggle++ if (!$oldmode && $owner_toggle == 2);
|
|
# $owner_toggle = 0 if ($owner_toggle > 3);
|
|
}
|
|
return ($audit_toggle, $owner_toggle);
|
|
}
|
|
|
|
sub ask_the_questions {
|
|
my $found; # do the magic foo-foo
|
|
for my $sdmode (sort keys %log) {
|
|
|
|
# let them know what sort of changes we're about to list...
|
|
if ($sdmode eq "PERMITTING") {
|
|
UI_Info(gettext("Complain-mode changes:"));
|
|
} elsif ($sdmode eq "REJECTING") {
|
|
UI_Info(gettext("Enforce-mode changes:"));
|
|
} else {
|
|
|
|
# if we're not permitting and not rejecting, something's broken.
|
|
# most likely the code we're using to build the hash tree of log
|
|
# entries - this should never ever happen
|
|
fatal_error(sprintf(gettext('Invalid mode found: %s'), $sdmode));
|
|
}
|
|
|
|
for my $profile (sort keys %{ $log{$sdmode} }) {
|
|
my $p = update_repo_profile($sd{$profile}{$profile});
|
|
UI_SelectUpdatedRepoProfile($profile, $p) if ( $p );
|
|
|
|
$found++;
|
|
|
|
# this sorts the list of hats, but makes sure that the containing
|
|
# profile shows up in the list first to keep the question order
|
|
# rational
|
|
my @hats =
|
|
grep { $_ ne $profile } keys %{ $log{$sdmode}{$profile} };
|
|
unshift @hats, $profile
|
|
if defined $log{$sdmode}{$profile}{$profile};
|
|
|
|
for my $hat (@hats) {
|
|
|
|
# step through all the capabilities first...
|
|
for my $capability (sort keys %{ $log{$sdmode}{$profile}{$hat}{capability} }) {
|
|
|
|
# we don't care about it if we've already added it to the
|
|
# profile
|
|
next if profile_known_capability($sd{$profile}{$hat},
|
|
$capability);
|
|
|
|
my $severity = $sevdb->rank(uc("cap_$capability"));
|
|
|
|
my $defaultoption = 1;
|
|
my @options = ();
|
|
my @newincludes;
|
|
@newincludes = matchcapincludes($sd{$profile}{$hat},
|
|
$capability);
|
|
|
|
|
|
my $q = {};
|
|
|
|
if (@newincludes) {
|
|
push @options,
|
|
map { "#include <$_>" } sort(uniq(@newincludes));
|
|
}
|
|
|
|
if ( @options ) {
|
|
push @options, "capability $capability";
|
|
$q->{options} = [@options];
|
|
$q->{selected} = $defaultoption - 1;
|
|
}
|
|
|
|
$q->{headers} = [];
|
|
push @{ $q->{headers} }, gettext("Profile"), combine_name($profile, $hat);
|
|
push @{ $q->{headers} }, gettext("Capability"), $capability;
|
|
push @{ $q->{headers} }, gettext("Severity"), $severity;
|
|
|
|
my $audit_toggle = 0;
|
|
$q->{functions} = [
|
|
"CMD_ALLOW", "CMD_DENY", "CMD_AUDIT_NEW", "CMD_ABORT", "CMD_FINISHED"
|
|
];
|
|
|
|
# complain-mode events default to allow - enforce defaults
|
|
# to deny
|
|
$q->{default} = ($sdmode eq "PERMITTING") ? "CMD_ALLOW" : "CMD_DENY";
|
|
|
|
$seenevents++;
|
|
my $done = 0;
|
|
while ( not $done ) {
|
|
# what did the grand exalted master tell us to do?
|
|
my ($ans, $selected) = UI_PromptUser($q);
|
|
|
|
if ($ans =~ /^CMD_AUDIT/) {
|
|
$audit_toggle = !$audit_toggle;
|
|
my $audit = "";
|
|
if ($audit_toggle) {
|
|
$q->{functions} = [
|
|
"CMD_ALLOW", "CMD_DENY", "CMD_AUDIT_OFF", "CMD_ABORT", "CMD_FINISHED"
|
|
];
|
|
$audit = "audit ";
|
|
} else {
|
|
$q->{functions} = [
|
|
"CMD_ALLOW", "CMD_DENY", "CMD_AUDIT_NEW", "CMD_ABORT", "CMD_FINISHED"
|
|
];
|
|
}
|
|
$q->{headers} = [];
|
|
push @{ $q->{headers} }, gettext("Profile"), combine_name($profile, $hat);
|
|
push @{ $q->{headers} }, gettext("Capability"), $audit . $capability;
|
|
push @{ $q->{headers} }, gettext("Severity"), $severity;
|
|
|
|
} if ($ans eq "CMD_ALLOW") {
|
|
|
|
# they picked (a)llow, so...
|
|
|
|
my $selection = $options[$selected];
|
|
$done = 1;
|
|
if ($selection &&
|
|
$selection =~ m/^#include <(.+)>$/) {
|
|
my $deleted = 0;
|
|
my $inc = $1;
|
|
$deleted = delete_duplicates($sd{$profile}{$hat},
|
|
$inc
|
|
);
|
|
$sd{$profile}{$hat}{include}{$inc} = 1;
|
|
|
|
$changed{$profile} = 1;
|
|
UI_Info(sprintf(
|
|
gettext('Adding #include <%s> to profile.'),
|
|
$inc));
|
|
UI_Info(sprintf(
|
|
gettext('Deleted %s previous matching profile entries.'),
|
|
$deleted)) if $deleted;
|
|
}
|
|
# stick the capability into the profile
|
|
$sd{$profile}{$hat}{allow}{capability}{$capability}{set} = 1;
|
|
$sd{$profile}{$hat}{allow}{capability}{$capability}{audit} = $audit_toggle;
|
|
|
|
# mark this profile as changed
|
|
$changed{$profile} = 1;
|
|
$done = 1;
|
|
# give a little feedback to the user
|
|
UI_Info(sprintf(gettext('Adding capability %s to profile.'), $capability));
|
|
} elsif ($ans eq "CMD_DENY") {
|
|
$sd{$profile}{$hat}{deny}{capability}{$capability}{set} = 1;
|
|
# mark this profile as changed
|
|
$changed{$profile} = 1;
|
|
UI_Info(sprintf(gettext('Denying capability %s to profile.'), $capability));
|
|
$done = 1;
|
|
} else {
|
|
redo;
|
|
}
|
|
}
|
|
}
|
|
|
|
# and then step through all of the path entries...
|
|
for my $path (sort keys %{ $log{$sdmode}{$profile}{$hat}{path} }) {
|
|
|
|
my $mode = $log{$sdmode}{$profile}{$hat}{path}{$path};
|
|
|
|
# do original profile lookup once.
|
|
|
|
my $allow_mode = 0;
|
|
my $allow_audit = 0;
|
|
my $deny_mode = 0;
|
|
my $deny_audit = 0;
|
|
|
|
my ($fmode, $famode, $imode, $iamode, @fm, @im, $cm, $am, $cam, @m);
|
|
($fmode, $famode, @fm) = rematchfrag($sd{$profile}{$hat}, 'allow', $path);
|
|
$allow_mode |= $fmode if $fmode;
|
|
$allow_audit |= $famode if $famode;
|
|
($imode, $iamode, @im) = match_prof_incs_to_path($sd{$profile}{$hat}, 'allow', $path);
|
|
$allow_mode |= $imode if $imode;
|
|
$allow_audit |= $iamode if $iamode;
|
|
|
|
($cm, $cam, @m) = rematchfrag($sd{$profile}{$hat}, 'deny', $path);
|
|
$deny_mode |= $cm if $cm;
|
|
$deny_audit |= $cam if $cam;
|
|
($cm, $cam, @m) = match_prof_incs_to_path($sd{$profile}{$hat}, 'deny', $path);
|
|
$deny_mode |= $cm if $cm;
|
|
$deny_audit |= $cam if $cam;
|
|
|
|
if ($deny_mode & $AA_MAY_EXEC) {
|
|
$deny_mode |= $ALL_AA_EXEC_TYPE;
|
|
}
|
|
|
|
# mask off the modes that have been denied
|
|
$mode &= ~$deny_mode;
|
|
$allow_mode &= ~$deny_mode;
|
|
|
|
# if we had an access(X_OK) request or some other kind of
|
|
# event that generates a "PERMITTING x" syslog entry,
|
|
# first check if it was already dealt with by a i/p/x
|
|
# question due to a exec(). if not, ask about adding ix
|
|
# permission.
|
|
if ($mode & $AA_MAY_EXEC) {
|
|
|
|
# get rid of the access() markers.
|
|
$mode &= (~$ALL_AA_EXEC_TYPE);
|
|
|
|
unless ($allow_mode & $allow_mode & $AA_MAY_EXEC) {
|
|
$mode |= str_to_mode("ix");
|
|
}
|
|
}
|
|
|
|
# if we had an mmap(PROT_EXEC) request, first check if we
|
|
# already have added an ix rule to the profile
|
|
if ($mode & $AA_EXEC_MMAP) {
|
|
# ix implies m. don't ask if they want to add an "m"
|
|
# rule when we already have a matching ix rule.
|
|
if ($allow_mode && contains($allow_mode, "ix")) {
|
|
$mode &= (~$AA_EXEC_MMAP);
|
|
}
|
|
}
|
|
|
|
next unless $mode;
|
|
|
|
|
|
my @matches;
|
|
|
|
if ($fmode) {
|
|
push @matches, @fm;
|
|
}
|
|
if ($imode) {
|
|
push @matches, @im;
|
|
}
|
|
|
|
unless ($allow_mode && mode_contains($allow_mode, $mode)) {
|
|
|
|
my $defaultoption = 1;
|
|
my @options = ();
|
|
|
|
# check the path against the available set of include
|
|
# files
|
|
my @newincludes;
|
|
my $includevalid;
|
|
for my $incname (keys %include) {
|
|
$includevalid = 0;
|
|
|
|
# don't suggest it if we're already including it,
|
|
# that's dumb
|
|
next if $sd{$profile}{$hat}{$incname};
|
|
|
|
# only match includes that can be suggested to
|
|
# the user
|
|
if ($cfg->{settings}{custom_includes}) {
|
|
for my $incm (split(/\s+/,
|
|
$cfg->{settings}{custom_includes})
|
|
) {
|
|
$includevalid = 1 if $incname =~ /$incm/;
|
|
}
|
|
}
|
|
$includevalid = 1 if $incname =~ /abstractions/;
|
|
next if ($includevalid == 0);
|
|
|
|
($cm, $am, @m) = match_include_to_path($incname, 'allow', $path);
|
|
if ($cm && mode_contains($cm, $mode)) {
|
|
#make sure it doesn't deny $mode
|
|
my $dm = match_include_to_path($incname, 'deny', $path);
|
|
unless (($mode & $dm) || (grep { $_ eq "/**" } @m)) {
|
|
push @newincludes, $incname;
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
# did any match? add them to the option list...
|
|
if (@newincludes) {
|
|
push @options,
|
|
map { "#include <$_>" }
|
|
sort(uniq(@newincludes));
|
|
}
|
|
|
|
# include the literal path in the option list...
|
|
push @options, $path;
|
|
|
|
# match the current path against the globbing list in
|
|
# logprof.conf
|
|
my @globs = globcommon($path);
|
|
if (@globs) {
|
|
push @matches, @globs;
|
|
}
|
|
|
|
# suggest any matching globs the user manually entered
|
|
for my $userglob (@userglobs) {
|
|
push @matches, $userglob
|
|
if matchliteral($userglob, $path);
|
|
}
|
|
|
|
# we'll take the cheesy way and order the suggested
|
|
# globbing list by length, which is usually right,
|
|
# but not always always
|
|
push @options,
|
|
sort { length($b) <=> length($a) }
|
|
grep { $_ ne $path }
|
|
uniq(@matches);
|
|
$defaultoption = $#options + 1;
|
|
|
|
my $severity = $sevdb->rank($path, mode_to_str($mode));
|
|
|
|
my $audit_toggle = 0;
|
|
my $owner_toggle = $cfg->{settings}{default_owner_prompt};
|
|
my $done = 0;
|
|
while (not $done) {
|
|
|
|
my $q = {};
|
|
$q->{headers} = [];
|
|
push @{ $q->{headers} }, gettext("Profile"), combine_name($profile, $hat);
|
|
push @{ $q->{headers} }, gettext("Path"), $path;
|
|
|
|
# merge in any previous modes from this run
|
|
if ($allow_mode) {
|
|
my $str;
|
|
#print "mode: " . print_mode($mode) . " allow: " . print_mode($allow_mode) . "\n";
|
|
$mode |= $allow_mode;
|
|
my $tail;
|
|
my $prompt_mode;
|
|
if ($owner_toggle == 0) {
|
|
$prompt_mode = flatten_mode($mode);
|
|
$tail = " " . gettext("(owner permissions off)");
|
|
} elsif ($owner_toggle == 1) {
|
|
$prompt_mode = $mode;
|
|
$tail = "";
|
|
} elsif ($owner_toggle == 2) {
|
|
$prompt_mode = $allow_mode | owner_flatten_mode($mode & ~$allow_mode);
|
|
$tail = " " . gettext("(force new perms to owner)");
|
|
} else {
|
|
$prompt_mode = owner_flatten_mode($mode);
|
|
$tail = " " . gettext("(force all rule perms to owner)");
|
|
}
|
|
|
|
if ($audit_toggle == 1) {
|
|
$str = mode_to_str_user($allow_mode);
|
|
$str .= ", " if ($allow_mode);
|
|
$str .= "audit " . mode_to_str_user($prompt_mode & ~$allow_mode) . $tail;
|
|
} elsif ($audit_toggle == 2) {
|
|
$str = "audit " . mode_to_str_user($prompt_mode) . $tail;
|
|
} else {
|
|
$str = mode_to_str_user($prompt_mode) . $tail;
|
|
}
|
|
push @{ $q->{headers} }, gettext("Old Mode"), mode_to_str_user($allow_mode);
|
|
push @{ $q->{headers} }, gettext("New Mode"), $str;
|
|
} else {
|
|
my $str = "";
|
|
if ($audit_toggle) {
|
|
$str = "audit ";
|
|
}
|
|
my $tail;
|
|
my $prompt_mode;
|
|
if ($owner_toggle == 0) {
|
|
$prompt_mode = flatten_mode($mode);
|
|
$tail = " " . gettext("(owner permissions off)");
|
|
} elsif ($owner_toggle == 1) {
|
|
$prompt_mode = $mode;
|
|
$tail = "";
|
|
} else {
|
|
$prompt_mode = owner_flatten_mode($mode);
|
|
$tail = " " . gettext("(force perms to owner)");
|
|
}
|
|
$str .= mode_to_str_user($prompt_mode) . $tail;
|
|
push @{ $q->{headers} }, gettext("Mode"), $str;
|
|
}
|
|
push @{ $q->{headers} }, gettext("Severity"), $severity;
|
|
|
|
$q->{options} = [@options];
|
|
$q->{selected} = $defaultoption - 1;
|
|
|
|
$q->{functions} = [
|
|
"CMD_ALLOW", "CMD_DENY", "CMD_GLOB", "CMD_GLOBEXT", "CMD_NEW",
|
|
"CMD_ABORT", "CMD_FINISHED", "CMD_OTHER"
|
|
];
|
|
|
|
$q->{default} =
|
|
($sdmode eq "PERMITTING")
|
|
? "CMD_ALLOW"
|
|
: "CMD_DENY";
|
|
|
|
$seenevents++;
|
|
# if they just hit return, use the default answer
|
|
my ($ans, $selected) = UI_PromptUser($q);
|
|
|
|
if ($ans eq "CMD_OTHER") {
|
|
|
|
($audit_toggle, $owner_toggle) = UI_ask_mode_toggles($audit_toggle, $owner_toggle, $allow_mode);
|
|
} elsif ($ans eq "CMD_USER_TOGGLE") {
|
|
$owner_toggle++;
|
|
$owner_toggle++ if (!$allow_mode && $owner_toggle == 2);
|
|
$owner_toggle = 0 if ($owner_toggle > 3);
|
|
} elsif ($ans eq "CMD_ALLOW") {
|
|
$path = $options[$selected];
|
|
$done = 1;
|
|
if ($path =~ m/^#include <(.+)>$/) {
|
|
my $inc = $1;
|
|
my $deleted = 0;
|
|
|
|
$deleted = delete_duplicates($sd{$profile}{$hat},
|
|
$inc );
|
|
|
|
# record the new entry
|
|
$sd{$profile}{$hat}{include}{$inc} = 1;
|
|
|
|
$changed{$profile} = 1;
|
|
UI_Info(sprintf(gettext('Adding #include <%s> to profile.'), $inc));
|
|
UI_Info(sprintf(gettext('Deleted %s previous matching profile entries.'), $deleted)) if $deleted;
|
|
} else {
|
|
if ($sd{$profile}{$hat}{allow}{path}{$path}{mode}) {
|
|
$mode |= $sd{$profile}{$hat}{allow}{path}{$path}{mode};
|
|
}
|
|
|
|
my $deleted = 0;
|
|
for my $entry (keys %{ $sd{$profile}{$hat}{allow}{path} }) {
|
|
|
|
next if $path eq $entry;
|
|
|
|
if (matchregexp($path, $entry)) {
|
|
|
|
# regexp matches, add it's mode to
|
|
# the list to check against
|
|
if (mode_contains($mode,
|
|
$sd{$profile}{$hat}{allow}{path}{$entry}{mode})) {
|
|
delete $sd{$profile}{$hat}{allow}{path}{$entry};
|
|
$deleted++;
|
|
}
|
|
}
|
|
}
|
|
|
|
# record the new entry
|
|
if ($owner_toggle == 0) {
|
|
$mode = flatten_mode($mode);
|
|
} elsif ($owner_toggle == 1) {
|
|
$mode = $mode;
|
|
} elsif ($owner_toggle == 2) {
|
|
$mode = $allow_mode | owner_flatten_mode($mode & ~$allow_mode);
|
|
} elsif ($owner_toggle == 3) {
|
|
$mode = owner_flatten_mode($mode);
|
|
}
|
|
$sd{$profile}{$hat}{allow}{path}{$path}{mode} |= $mode;
|
|
my $tmpmode = ($audit_toggle == 1) ? $mode & ~$allow_mode : 0;
|
|
$tmpmode = ($audit_toggle == 2) ? $mode : $tmpmode;
|
|
$sd{$profile}{$hat}{allow}{path}{$path}{audit} |= $tmpmode;
|
|
|
|
$changed{$profile} = 1;
|
|
UI_Info(sprintf(gettext('Adding %s %s to profile.'), $path, mode_to_str_user($mode)));
|
|
UI_Info(sprintf(gettext('Deleted %s previous matching profile entries.'), $deleted)) if $deleted;
|
|
}
|
|
} elsif ($ans eq "CMD_DENY") {
|
|
# record the new entry
|
|
$sd{$profile}{$hat}{deny}{path}{$path}{mode} |= $mode & ~$allow_mode;
|
|
$sd{$profile}{$hat}{deny}{path}{$path}{audit} |= 0;
|
|
|
|
$changed{$profile} = 1;
|
|
|
|
# go on to the next entry without saving this
|
|
# one
|
|
$done = 1;
|
|
} elsif ($ans eq "CMD_NEW") {
|
|
my $arg = $options[$selected];
|
|
if ($arg !~ /^#include/) {
|
|
$ans = UI_GetString(gettext("Enter new path: "), $arg);
|
|
if ($ans) {
|
|
unless (matchliteral($ans, $path)) {
|
|
my $ynprompt = gettext("The specified path does not match this log entry:") . "\n\n";
|
|
$ynprompt .= " " . gettext("Log Entry") . ": $path\n";
|
|
$ynprompt .= " " . gettext("Entered Path") . ": $ans\n\n";
|
|
$ynprompt .= gettext("Do you really want to use this path?") . "\n";
|
|
|
|
# we default to no if they just hit return...
|
|
my $key = UI_YesNo($ynprompt, "n");
|
|
|
|
next if $key eq "n";
|
|
}
|
|
|
|
# save this one for later
|
|
push @userglobs, $ans;
|
|
|
|
push @options, $ans;
|
|
$defaultoption = $#options + 1;
|
|
}
|
|
}
|
|
} elsif ($ans eq "CMD_GLOB") {
|
|
|
|
# do globbing if they don't have an include
|
|
# selected
|
|
my $newpath = $options[$selected];
|
|
chomp $newpath ;
|
|
unless ($newpath =~ /^#include/) {
|
|
# is this entry directory specific
|
|
if ( $newpath =~ m/\/$/ ) {
|
|
# do we collapse to /* or /**?
|
|
if ($newpath =~ m/\/\*{1,2}\/$/) {
|
|
$newpath =~
|
|
s/\/[^\/]+\/\*{1,2}\/$/\/\*\*\//;
|
|
} else {
|
|
$newpath =~ s/\/[^\/]+\/$/\/\*\//;
|
|
}
|
|
} else {
|
|
# do we collapse to /* or /**?
|
|
if ($newpath =~ m/\/\*{1,2}$/) {
|
|
$newpath =~ s/\/[^\/]+\/\*{1,2}$/\/\*\*/;
|
|
} else {
|
|
$newpath =~ s/\/[^\/]+$/\/\*/;
|
|
}
|
|
}
|
|
if ($newpath ne $selected) {
|
|
push @options, $newpath;
|
|
$defaultoption = $#options + 1;
|
|
}
|
|
}
|
|
} elsif ($ans eq "CMD_GLOBEXT") {
|
|
|
|
# do globbing if they don't have an include
|
|
# selected
|
|
my $newpath = $options[$selected];
|
|
unless ($newpath =~ /^#include/) {
|
|
# do we collapse to /*.ext or /**.ext?
|
|
if ($newpath =~ m/\/\*{1,2}\.[^\/]+$/) {
|
|
$newpath =~ s/\/[^\/]+\/\*{1,2}(\.[^\/]+)$/\/\*\*$1/;
|
|
} else {
|
|
$newpath =~ s/\/[^\/]+(\.[^\/]+)$/\/\*$1/;
|
|
}
|
|
if ($newpath ne $selected) {
|
|
push @options, $newpath;
|
|
$defaultoption = $#options + 1;
|
|
}
|
|
}
|
|
} elsif ($ans =~ /\d/) {
|
|
$defaultoption = $ans;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# and then step through all of the netdomain entries...
|
|
for my $family (sort keys %{$log{$sdmode}
|
|
{$profile}
|
|
{$hat}
|
|
{netdomain}}) {
|
|
|
|
# TODO - severity handling for net toggles
|
|
#my $severity = $sevdb->rank();
|
|
for my $sock_type (sort keys %{$log{$sdmode}
|
|
{$profile}
|
|
{$hat}
|
|
{netdomain}
|
|
{$family}}) {
|
|
|
|
# we don't care about it if we've already added it to the
|
|
# profile
|
|
next if ( profile_known_network($sd{$profile}{$hat},
|
|
$family,
|
|
$sock_type));
|
|
my $defaultoption = 1;
|
|
my @options = ();
|
|
my @newincludes;
|
|
@newincludes = matchnetincludes($sd{$profile}{$hat},
|
|
$family,
|
|
$sock_type);
|
|
|
|
my $q = {};
|
|
|
|
if (@newincludes) {
|
|
push @options,
|
|
map { "#include <$_>" } sort(uniq(@newincludes));
|
|
}
|
|
|
|
if ( @options ) {
|
|
push @options, "network $family $sock_type";
|
|
$q->{options} = [@options];
|
|
$q->{selected} = $defaultoption - 1;
|
|
}
|
|
|
|
$q->{headers} = [];
|
|
push @{ $q->{headers} },
|
|
gettext("Profile"),
|
|
combine_name($profile, $hat);
|
|
push @{ $q->{headers} },
|
|
gettext("Network Family"),
|
|
$family;
|
|
push @{ $q->{headers} },
|
|
gettext("Socket Type"),
|
|
$sock_type;
|
|
|
|
my $audit_toggle = 0;
|
|
|
|
$q->{functions} = [
|
|
"CMD_ALLOW",
|
|
"CMD_DENY",
|
|
"CMD_AUDIT_NEW",
|
|
"CMD_ABORT",
|
|
"CMD_FINISHED"
|
|
];
|
|
|
|
# complain-mode events default to allow - enforce defaults
|
|
# to deny
|
|
$q->{default} = ($sdmode eq "PERMITTING") ? "CMD_ALLOW" :
|
|
"CMD_DENY";
|
|
|
|
$seenevents++;
|
|
|
|
# what did the grand exalted master tell us to do?
|
|
my $done = 0;
|
|
while ( not $done ) {
|
|
my ($ans, $selected) = UI_PromptUser($q);
|
|
if ($ans =~ /^CMD_AUDIT/) {
|
|
$audit_toggle = !$audit_toggle;
|
|
my $audit = $audit_toggle ? "audit " : "";
|
|
if ($audit_toggle) {
|
|
$q->{functions} = [
|
|
"CMD_ALLOW",
|
|
"CMD_DENY",
|
|
"CMD_AUDIT_OFF",
|
|
"CMD_ABORT",
|
|
"CMD_FINISHED"
|
|
];
|
|
} else {
|
|
$q->{functions} = [
|
|
"CMD_ALLOW",
|
|
"CMD_DENY",
|
|
"CMD_AUDIT_NEW",
|
|
"CMD_ABORT",
|
|
"CMD_FINISHED"
|
|
];
|
|
}
|
|
$q->{headers} = [];
|
|
push @{ $q->{headers} },
|
|
gettext("Profile"),
|
|
combine_name($profile, $hat);
|
|
push @{ $q->{headers} },
|
|
gettext("Network Family"),
|
|
$audit . $family;
|
|
push @{ $q->{headers} },
|
|
gettext("Socket Type"),
|
|
$sock_type;
|
|
} elsif ($ans eq "CMD_ALLOW") {
|
|
my $selection = $options[$selected];
|
|
$done = 1;
|
|
if ($selection &&
|
|
$selection =~ m/^#include <(.+)>$/) {
|
|
my $inc = $1;
|
|
my $deleted = 0;
|
|
$deleted = delete_duplicates($sd{$profile}{$hat},
|
|
$inc
|
|
);
|
|
# record the new entry
|
|
$sd{$profile}{$hat}{include}{$inc} = 1;
|
|
|
|
$changed{$profile} = 1;
|
|
UI_Info(
|
|
sprintf(
|
|
gettext('Adding #include <%s> to profile.'),
|
|
$inc));
|
|
UI_Info(
|
|
sprintf(
|
|
gettext('Deleted %s previous matching profile entries.'),
|
|
$deleted)) if $deleted;
|
|
} else {
|
|
|
|
# stick the whole rule into the profile
|
|
$sd{$profile}
|
|
{$hat}
|
|
{allow}
|
|
{netdomain}
|
|
{audit}
|
|
{$family}
|
|
{$sock_type} = $audit_toggle;
|
|
|
|
$sd{$profile}
|
|
{$hat}
|
|
{allow}
|
|
{netdomain}
|
|
{rule}
|
|
{$family}
|
|
{$sock_type} = 1;
|
|
|
|
# mark this profile as changed
|
|
$changed{$profile} = 1;
|
|
|
|
# give a little feedback to the user
|
|
UI_Info(sprintf(
|
|
gettext('Adding network access %s %s to profile.'),
|
|
$family,
|
|
$sock_type
|
|
)
|
|
);
|
|
}
|
|
} elsif ($ans eq "CMD_DENY") {
|
|
$done = 1;
|
|
# record the new entry
|
|
$sd{$profile}
|
|
{$hat}
|
|
{deny}
|
|
{netdomain}
|
|
{rule}
|
|
{$family}
|
|
{$sock_type} = 1;
|
|
|
|
$changed{$profile} = 1;
|
|
UI_Info(sprintf(
|
|
gettext('Denying network access %s %s to profile.'),
|
|
$family,
|
|
$sock_type
|
|
)
|
|
);
|
|
} else {
|
|
redo;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
sub delete_net_duplicates {
|
|
my ($netrules, $incnetrules) = @_;
|
|
my $deleted = 0;
|
|
if ( $incnetrules && $netrules ) {
|
|
my $incnetglob = defined $incnetrules->{all};
|
|
|
|
# See which if any profile rules are matched by the include and can be
|
|
# deleted
|
|
for my $fam ( keys %$netrules ) {
|
|
if ( $incnetglob || (ref($incnetrules->{rule}{$fam}) ne "HASH" &&
|
|
$incnetrules->{rule}{$fam} == 1)) { # include allows
|
|
# all net or
|
|
# all fam
|
|
if ( ref($netrules->{rule}{$fam}) eq "HASH" ) {
|
|
$deleted += ( keys %{$netrules->{rule}{$fam}} );
|
|
} else {
|
|
$deleted++;
|
|
}
|
|
delete $netrules->{rule}{$fam};
|
|
} elsif ( ref($netrules->{rule}{$fam}) ne "HASH" &&
|
|
$netrules->{rule}{$fam} == 1 ){
|
|
next; # profile has all family
|
|
} else {
|
|
for my $socket_type ( keys %{$netrules->{rule}{$fam}} ) {
|
|
if ( defined $incnetrules->{$fam}{$socket_type} ) {
|
|
delete $netrules->{$fam}{$socket_type};
|
|
$deleted++;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
return $deleted;
|
|
}
|
|
|
|
sub delete_cap_duplicates ($$) {
|
|
my ($profilecaps, $inccaps) = @_;
|
|
my $deleted = 0;
|
|
if ( $profilecaps && $inccaps ) {
|
|
for my $capname ( keys %$profilecaps ) {
|
|
if ( defined $inccaps->{$capname}{set} && $inccaps->{$capname}{set} == 1 ) {
|
|
delete $profilecaps->{$capname};
|
|
$deleted++;
|
|
}
|
|
}
|
|
}
|
|
return $deleted;
|
|
}
|
|
|
|
sub delete_path_duplicates ($$$) {
|
|
my ($profile, $incname, $allow) = @_;
|
|
my $deleted = 0;
|
|
|
|
for my $entry (keys %{ $profile->{$allow}{path} }) {
|
|
next if $entry eq "#include <$incname>";
|
|
my ($cm, $am, @m) = match_include_to_path($incname, $allow, $entry);
|
|
if ($cm
|
|
&& mode_contains($cm, $profile->{$allow}{path}{$entry}{mode})
|
|
&& mode_contains($am, $profile->{$allow}{path}{$entry}{audit}))
|
|
{
|
|
delete $profile->{$allow}{path}{$entry};
|
|
$deleted++;
|
|
}
|
|
}
|
|
return $deleted;
|
|
}
|
|
|
|
sub delete_duplicates (\%$) {
|
|
my ( $profile, $incname ) = @_;
|
|
my $deleted = 0;
|
|
|
|
# don't cross delete allow rules covered by denied rules as the coverage
|
|
# may not be complete. ie. want to deny a subset of allow, allow a subset
|
|
# of deny with different perms.
|
|
|
|
## network rules
|
|
$deleted += delete_net_duplicates($profile->{allow}{netdomain}, $include{$incname}{$incname}{allow}{netdomain});
|
|
$deleted += delete_net_duplicates($profile->{deny}{netdomain}, $include{$incname}{$incname}{deny}{netdomain});
|
|
|
|
## capabilities
|
|
$deleted += delete_cap_duplicates($profile->{allow}{capability},
|
|
$include{$incname}{$incname}{allow}{capability});
|
|
$deleted += delete_cap_duplicates($profile->{deny}{capability},
|
|
$include{$incname}{$incname}{deny}{capability});
|
|
|
|
## paths
|
|
$deleted += delete_path_duplicates($profile, $incname, 'allow');
|
|
$deleted += delete_path_duplicates($profile, $incname, 'deny');
|
|
|
|
return $deleted;
|
|
}
|
|
|
|
sub matchnetinclude ($$$) {
|
|
my ($incname, $family, $type) = @_;
|
|
|
|
my @matches;
|
|
|
|
# scan the include fragments for this profile looking for matches
|
|
my @includelist = ($incname);
|
|
my @checked;
|
|
while (my $name = shift @includelist) {
|
|
push @checked, $name;
|
|
return 1
|
|
if netrules_access_check($include{$name}{$name}{allow}{netdomain}, $family, $type);
|
|
# if this fragment includes others, check them too
|
|
if (keys %{ $include{$name}{$name}{include} } &&
|
|
(grep($name, @checked) == 0) ) {
|
|
push @includelist, keys %{ $include{$name}{$name}{include} };
|
|
}
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub matchcapincludes (\%$) {
|
|
my ($profile, $cap) = @_;
|
|
|
|
# check the path against the available set of include
|
|
# files
|
|
my @newincludes;
|
|
my $includevalid;
|
|
for my $incname (keys %include) {
|
|
$includevalid = 0;
|
|
|
|
# don't suggest it if we're already including it,
|
|
# that's dumb
|
|
next if $profile->{include}{$incname};
|
|
|
|
# only match includes that can be suggested to
|
|
# the user
|
|
if ($cfg->{settings}{custom_includes}) {
|
|
for my $incm (split(/\s+/,
|
|
$cfg->{settings}{custom_includes})) {
|
|
$includevalid = 1 if $incname =~ /$incm/;
|
|
}
|
|
}
|
|
$includevalid = 1 if $incname =~ /abstractions/;
|
|
next if ($includevalid == 0);
|
|
|
|
push @newincludes, $incname
|
|
if ( defined $include{$incname}{$incname}{allow}{capability}{$cap}{set} &&
|
|
$include{$incname}{$incname}{allow}{capability}{$cap}{set} == 1 );
|
|
}
|
|
return @newincludes;
|
|
}
|
|
|
|
sub matchnetincludes (\%$$) {
|
|
my ($profile, $family, $type) = @_;
|
|
|
|
# check the path against the available set of include
|
|
# files
|
|
my @newincludes;
|
|
my $includevalid;
|
|
for my $incname (keys %include) {
|
|
$includevalid = 0;
|
|
|
|
# don't suggest it if we're already including it,
|
|
# that's dumb
|
|
next if $profile->{include}{$incname};
|
|
|
|
# only match includes that can be suggested to
|
|
# the user
|
|
if ($cfg->{settings}{custom_includes}) {
|
|
for my $incm (split(/\s+/, $cfg->{settings}{custom_includes})) {
|
|
$includevalid = 1 if $incname =~ /$incm/;
|
|
}
|
|
}
|
|
$includevalid = 1 if $incname =~ /abstractions/;
|
|
next if ($includevalid == 0);
|
|
|
|
push @newincludes, $incname
|
|
if matchnetinclude($incname, $family, $type);
|
|
}
|
|
return @newincludes;
|
|
}
|
|
|
|
|
|
sub do_logprof_pass {
|
|
my $logmark = shift || "";
|
|
|
|
# zero out the state variables for this pass...
|
|
%t = ( );
|
|
%transitions = ( );
|
|
%seen = ( );
|
|
%sd = ( );
|
|
%profilechanges = ( );
|
|
%prelog = ( );
|
|
@log = ( );
|
|
%log = ( );
|
|
%changed = ( );
|
|
%skip = ( );
|
|
%filelist = ( );
|
|
|
|
UI_Info(sprintf(gettext('Reading log entries from %s.'), $filename));
|
|
UI_Info(sprintf(gettext('Updating AppArmor profiles in %s.'), $profiledir));
|
|
|
|
readprofiles();
|
|
unless ($sevdb) {
|
|
$sevdb = new Immunix::Severity("$confdir/severity.db", gettext("unknown
|
|
"));
|
|
}
|
|
|
|
# we need to be able to break all the way out of deep into subroutine calls
|
|
# if they select "Finish" so we can take them back out to the genprof prompt
|
|
eval {
|
|
unless ($repo_cfg || not defined $cfg->{repository}{url}) {
|
|
$repo_cfg = read_config("repository.conf");
|
|
unless ($repo_cfg->{repository}{enabled} &&
|
|
($repo_cfg->{repository}{enabled} eq "yes" ||
|
|
$repo_cfg->{repository}{enabled} eq "no")) {
|
|
UI_ask_to_enable_repo();
|
|
}
|
|
}
|
|
|
|
read_log($logmark);
|
|
|
|
for my $root (@log) {
|
|
handlechildren(undef, undef, $root);
|
|
}
|
|
|
|
for my $pid (sort { $a <=> $b } keys %profilechanges) {
|
|
setprocess($pid, $profilechanges{$pid});
|
|
}
|
|
|
|
collapselog();
|
|
|
|
ask_the_questions();
|
|
|
|
if ($UI_Mode eq "yast") {
|
|
if (not $running_under_genprof) {
|
|
if ($seenevents) {
|
|
my $w = { type => "wizard" };
|
|
$w->{explanation} = gettext("The profile analyzer has completed processing the log files.\n\nAll updated profiles will be reloaded");
|
|
$w->{functions} = [ "CMD_ABORT", "CMD_FINISHED" ];
|
|
SendDataToYast($w);
|
|
my $foo = GetDataFromYast();
|
|
} else {
|
|
my $w = { type => "wizard" };
|
|
$w->{explanation} = gettext("No unhandled AppArmor events were found in the system log.");
|
|
$w->{functions} = [ "CMD_ABORT", "CMD_FINISHED" ];
|
|
SendDataToYast($w);
|
|
my $foo = GetDataFromYast();
|
|
}
|
|
}
|
|
}
|
|
};
|
|
|
|
my $finishing = 0;
|
|
if ($@) {
|
|
if ($@ =~ /FINISHING/) {
|
|
$finishing = 1;
|
|
} else {
|
|
die $@;
|
|
}
|
|
}
|
|
|
|
save_profiles();
|
|
|
|
if (repo_is_enabled()) {
|
|
if ( (not defined $repo_cfg->{repository}{upload}) ||
|
|
($repo_cfg->{repository}{upload} eq "later") ) {
|
|
UI_ask_to_upload_profiles();
|
|
}
|
|
if ($repo_cfg->{repository}{upload} eq "yes") {
|
|
sync_profiles();
|
|
}
|
|
@created = ();
|
|
}
|
|
|
|
# if they hit "Finish" we need to tell the caller that so we can exit
|
|
# all the way instead of just going back to the genprof prompt
|
|
return $finishing ? "FINISHED" : "NORMAL";
|
|
}
|
|
|
|
sub save_profiles {
|
|
# make sure the profile changes we've made are saved to disk...
|
|
my @changed = sort keys %changed;
|
|
#
|
|
# first make sure that profiles in %changed are active (or actual profiles
|
|
# in %sd) - this is to handle the sloppiness of setting profiles as changed
|
|
# when they are parsed in the case of legacy hat code that we want to write
|
|
# out in an updated format
|
|
foreach my $profile_name ( keys %changed ) {
|
|
if ( ! is_active_profile( $profile_name ) ) {
|
|
delete $changed{ $profile_name };
|
|
}
|
|
}
|
|
@changed = sort keys %changed;
|
|
|
|
if (@changed) {
|
|
if ($UI_Mode eq "yast") {
|
|
my (@selected_profiles, $title, $explanation, %profile_changes);
|
|
foreach my $prof (@changed) {
|
|
my $oldprofile = serialize_profile($original_sd{$prof}, $prof);
|
|
my $newprofile = serialize_profile($sd{$prof}, $prof);
|
|
|
|
$profile_changes{$prof} = get_profile_diff($oldprofile,
|
|
$newprofile);
|
|
}
|
|
$explanation = gettext("Select which profile changes you would like to save to the\nlocal profile set");
|
|
$title = gettext("Local profile changes");
|
|
SendDataToYast(
|
|
{
|
|
type => "dialog-select-profiles",
|
|
title => $title,
|
|
explanation => $explanation,
|
|
default_select => "true",
|
|
get_changelog => "false",
|
|
profiles => \%profile_changes
|
|
}
|
|
);
|
|
my ($ypath, $yarg) = GetDataFromYast();
|
|
if ($yarg->{STATUS} eq "cancel") {
|
|
return;
|
|
} else {
|
|
my $selected_profiles_ref = $yarg->{PROFILES};
|
|
for my $profile (@$selected_profiles_ref) {
|
|
writeprofile_ui_feedback($profile);
|
|
reload_base($profile);
|
|
}
|
|
}
|
|
} else {
|
|
my $q = {};
|
|
$q->{title} = "Changed Local Profiles";
|
|
$q->{headers} = [];
|
|
|
|
$q->{explanation} =
|
|
gettext( "The following local profiles were changed. Would you like to save them?");
|
|
|
|
$q->{functions} = [ "CMD_SAVE_CHANGES",
|
|
"CMD_VIEW_CHANGES",
|
|
"CMD_ABORT", ];
|
|
|
|
$q->{default} = "CMD_VIEW_CHANGES";
|
|
|
|
$q->{options} = [@changed];
|
|
$q->{selected} = 0;
|
|
|
|
my ($p, $ans, $arg);
|
|
do {
|
|
($ans, $arg) = UI_PromptUser($q);
|
|
|
|
if ($ans eq "CMD_VIEW_CHANGES") {
|
|
my $which = $changed[$arg];
|
|
my $oldprofile =
|
|
serialize_profile($original_sd{$which}, $which);
|
|
my $newprofile = serialize_profile($sd{$which}, $which);
|
|
display_changes($oldprofile, $newprofile);
|
|
}
|
|
|
|
} until $ans =~ /^CMD_SAVE_CHANGES/;
|
|
|
|
for my $profile (sort keys %changed) {
|
|
writeprofile_ui_feedback($profile);
|
|
reload_base($profile);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
sub get_pager {
|
|
|
|
if ( $ENV{PAGER} and (-x "/usr/bin/$ENV{PAGER}" ||
|
|
-x "/usr/sbin/$ENV{PAGER}" )
|
|
) {
|
|
return $ENV{PAGER};
|
|
} else {
|
|
return "less"
|
|
}
|
|
}
|
|
|
|
|
|
sub display_text {
|
|
my ($header, $body) = @_;
|
|
my $pager = get_pager();
|
|
if (open(PAGER, "| $pager")) {
|
|
print PAGER "$header\n\n$body";
|
|
close(PAGER);
|
|
}
|
|
}
|
|
|
|
sub get_profile_diff {
|
|
my ($oldprofile, $newprofile) = @_;
|
|
my $oldtmp = new File::Temp(UNLINK => 0);
|
|
print $oldtmp $oldprofile;
|
|
close($oldtmp);
|
|
|
|
my $newtmp = new File::Temp(UNLINK => 0);
|
|
print $newtmp $newprofile;
|
|
close($newtmp);
|
|
|
|
my $difftmp = new File::Temp(UNLINK => 0);
|
|
my @diff;
|
|
system("diff -u $oldtmp $newtmp > $difftmp");
|
|
while (<$difftmp>) {
|
|
push(@diff, $_) unless (($_ =~ /^(---|\+\+\+)/) ||
|
|
($_ =~ /^\@\@.*\@\@$/));
|
|
}
|
|
unlink($difftmp);
|
|
unlink($oldtmp);
|
|
unlink($newtmp);
|
|
return join("", @diff);
|
|
}
|
|
|
|
sub display_changes {
|
|
my ($oldprofile, $newprofile) = @_;
|
|
|
|
my $oldtmp = new File::Temp( UNLINK => 0 );
|
|
print $oldtmp $oldprofile;
|
|
close($oldtmp);
|
|
|
|
my $newtmp = new File::Temp( UNLINK => 0 );
|
|
print $newtmp $newprofile;
|
|
close($newtmp);
|
|
|
|
my $difftmp = new File::Temp(UNLINK => 0);
|
|
my @diff;
|
|
system("diff -u $oldtmp $newtmp > $difftmp");
|
|
if ($UI_Mode eq "yast") {
|
|
while (<$difftmp>) {
|
|
push(@diff, $_) unless (($_ =~ /^(---|\+\+\+)/) ||
|
|
($_ =~ /^\@\@.*\@\@$/));
|
|
}
|
|
UI_LongMessage(gettext("Profile Changes"), join("", @diff));
|
|
} else {
|
|
system("less $difftmp");
|
|
}
|
|
|
|
unlink($difftmp);
|
|
unlink($oldtmp);
|
|
unlink($newtmp);
|
|
}
|
|
|
|
sub setprocess ($$) {
|
|
my ($pid, $profile) = @_;
|
|
|
|
# don't do anything if the process exited already...
|
|
return unless -e "/proc/$pid/attr/current";
|
|
|
|
return unless open(CURR, "/proc/$pid/attr/current");
|
|
my $current = <CURR>;
|
|
return unless $current;
|
|
chomp $current;
|
|
close(CURR);
|
|
|
|
# only change null profiles
|
|
return unless $current =~ /null(-complain)*-profile/;
|
|
|
|
return unless open(STAT, "/proc/$pid/stat");
|
|
my $stat = <STAT>;
|
|
chomp $stat;
|
|
close(STAT);
|
|
|
|
return unless $stat =~ /^\d+ \((\S+)\) /;
|
|
my $currprog = $1;
|
|
|
|
open(CURR, ">/proc/$pid/attr/current") or return;
|
|
print CURR "setprofile $profile";
|
|
close(CURR);
|
|
}
|
|
|
|
sub collapselog () {
|
|
for my $sdmode (keys %prelog) {
|
|
for my $profile (keys %{ $prelog{$sdmode} }) {
|
|
for my $hat (keys %{ $prelog{$sdmode}{$profile} }) {
|
|
for my $path (keys %{ $prelog{$sdmode}{$profile}{$hat}{path} }) {
|
|
|
|
my $mode = $prelog{$sdmode}{$profile}{$hat}{path}{$path};
|
|
|
|
# we want to ignore anything from the log that's already
|
|
# in the profile
|
|
my $combinedmode = 0;
|
|
|
|
# is it in the original profile?
|
|
if ($sd{$profile}{$hat}{allow}{path}{$path}) {
|
|
$combinedmode |= $sd{$profile}{$hat}{allow}{path}{$path}{mode};
|
|
}
|
|
|
|
# does path match any regexps in original profile?
|
|
$combinedmode |= rematchfrag($sd{$profile}{$hat}, 'allow', $path);
|
|
|
|
# does path match anything pulled in by includes in
|
|
# original profile?
|
|
$combinedmode |= match_prof_incs_to_path($sd{$profile}{$hat}, 'allow', $path);
|
|
|
|
# if we found any matching entries, do the modes match?
|
|
unless ($combinedmode && mode_contains($combinedmode, $mode)) {
|
|
|
|
# merge in any previous modes from this run
|
|
if ($log{$sdmode}{$profile}{$hat}{$path}) {
|
|
$mode |= $log{$sdmode}{$profile}{$hat}{path}{$path};
|
|
}
|
|
|
|
# record the new entry
|
|
$log{$sdmode}{$profile}{$hat}{path}{$path} = $mode;
|
|
}
|
|
}
|
|
|
|
for my $capability (keys %{ $prelog{$sdmode}{$profile}{$hat}{capability} }) {
|
|
|
|
# if we don't already have this capability in the profile,
|
|
# add it
|
|
unless ($sd{$profile}{$hat}{allow}{capability}{$capability}{set}) {
|
|
$log{$sdmode}{$profile}{$hat}{capability}{$capability} = 1;
|
|
}
|
|
}
|
|
|
|
# Network toggle handling
|
|
my $ndref = $prelog{$sdmode}{$profile}{$hat}{netdomain};
|
|
for my $family ( keys %{$ndref} ) {
|
|
for my $sock_type ( keys %{$ndref->{$family}} ) {
|
|
unless ( profile_known_network($sd{$profile}{$hat},
|
|
$family, $sock_type)) {
|
|
$log{$sdmode}
|
|
{$profile}
|
|
{$hat}
|
|
{netdomain}
|
|
{$family}
|
|
{$sock_type}=1;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
sub profilemode ($) {
|
|
my $mode = shift;
|
|
|
|
my $modifier = ($mode =~ m/[iupUP]/)[0];
|
|
if ($modifier) {
|
|
$mode =~ s/[iupUPx]//g;
|
|
$mode .= $modifier . "x";
|
|
}
|
|
|
|
return $mode;
|
|
}
|
|
|
|
# kinky.
|
|
sub commonprefix (@) { (join("\0", @_) =~ m/^([^\0]*)[^\0]*(\0\1[^\0]*)*$/)[0] }
|
|
sub commonsuffix (@) { reverse(((reverse join("\0", @_)) =~ m/^([^\0]*)[^\0]*(\0\1[^\0]*)*$/)[0]); }
|
|
|
|
sub uniq (@) {
|
|
my %seen;
|
|
my @result = sort grep { !$seen{$_}++ } @_;
|
|
return @result;
|
|
}
|
|
|
|
our $MODE_MAP_RE = "r|w|l|m|k|a|x|i|u|p|c|n|I|U|P|C|N";
|
|
our $LOG_MODE_RE = "r|w|l|m|k|a|x|ix|ux|px|cx|nx|pix|cix|Ix|Ux|Px|PUx|Cx|Nx|Pix|Cix";
|
|
our $PROFILE_MODE_RE = "r|w|l|m|k|a|ix|ux|px|cx|pix|cix|Ux|Px|PUx|Cx|Pix|Cix";
|
|
our $PROFILE_MODE_NT_RE = "r|w|l|m|k|a|x|ix|ux|px|cx|pix|cix|Ux|Px|PUx|Cx|Pix|Cix";
|
|
our $PROFILE_MODE_DENY_RE = "r|w|l|m|k|a|x";
|
|
|
|
sub split_log_mode($) {
|
|
my $mode = shift;
|
|
my $user = "";
|
|
my $other = "";
|
|
|
|
if ($mode =~ /(.*?)::(.*)/) {
|
|
$user = $1 if ($1);
|
|
$other = $2 if ($2);
|
|
} else {
|
|
$user = $mode;
|
|
$other = $mode;
|
|
}
|
|
return ($user, $other);
|
|
}
|
|
|
|
sub map_log_mode ($) {
|
|
my $mode = shift;
|
|
return $mode;
|
|
# $mode =~ s/(.*l.*)::.*/$1/ge;
|
|
# $mode =~ s/.*::(.*l.*)/$1/ge;
|
|
# $mode =~ s/:://;
|
|
# return $mode;
|
|
# return $1;
|
|
}
|
|
|
|
sub hide_log_mode($) {
|
|
my $mode = shift;
|
|
|
|
$mode =~ s/:://;
|
|
return $mode;
|
|
}
|
|
|
|
sub validate_log_mode ($) {
|
|
my $mode = shift;
|
|
|
|
return ($mode =~ /^($LOG_MODE_RE)+$/) ? 1 : 0;
|
|
}
|
|
|
|
sub validate_profile_mode ($$$) {
|
|
my ($mode, $allow, $nt_name) = @_;
|
|
|
|
if ($allow eq 'deny') {
|
|
return ($mode =~ /^($PROFILE_MODE_DENY_RE)+$/) ? 1 : 0;
|
|
} elsif ($nt_name) {
|
|
return ($mode =~ /^($PROFILE_MODE_NT_RE)+$/) ? 1 : 0;
|
|
}
|
|
|
|
return ($mode =~ /^($PROFILE_MODE_RE)+$/) ? 1 : 0;
|
|
}
|
|
|
|
# modes internally are stored as a bit Mask
|
|
sub sub_str_to_mode($) {
|
|
my $str = shift;
|
|
my $mode = 0;
|
|
|
|
return 0 if (not $str);
|
|
|
|
while ($str =~ s/(${MODE_MAP_RE})//) {
|
|
my $tmp = $1;
|
|
#print "found mode $1\n";
|
|
|
|
if ($tmp && $MODE_HASH{$tmp}) {
|
|
$mode |= $MODE_HASH{$tmp};
|
|
} else {
|
|
#print "found mode $tmp\n";
|
|
}
|
|
}
|
|
|
|
#my $tmp = mode_to_str($mode);
|
|
#print "parsed_mode $mode\n";
|
|
return $mode;
|
|
}
|
|
|
|
sub print_mode ($) {
|
|
my $mode = shift;
|
|
|
|
my ($user, $other) = split_mode($mode);
|
|
my $str = sub_mode_to_str($user) . "::" . sub_mode_to_str($other);
|
|
|
|
return $str;
|
|
}
|
|
|
|
sub str_to_mode ($) {
|
|
my $str = shift;
|
|
|
|
return 0 if (not $str);
|
|
|
|
my ($user, $other) = split_log_mode($str);
|
|
|
|
#print "str: $str user: $user, other $other\n";
|
|
# we only allow user or all
|
|
$user = $other if (!$user);
|
|
|
|
my $mode = sub_str_to_mode($user);
|
|
$mode |= (sub_str_to_mode($other) << $AA_OTHER_SHIFT);
|
|
|
|
#print "user: $user " .sub_str_to_mode($user) . " other: $other " . (sub_str_to_mode($other) << $AA_OTHER_SHIFT) . " mode = $mode\n";
|
|
|
|
return $mode;
|
|
}
|
|
|
|
sub log_str_to_mode($$$) {
|
|
my ($profile, $str, $nt_name) = @_;
|
|
|
|
my $mode = str_to_mode($str);
|
|
|
|
# this will cover both nx and nix
|
|
if (contains($mode, "Nx")) {
|
|
# need to transform to px, cx
|
|
|
|
if ($nt_name =~ /(.+?)\/\/(.+?)/) {
|
|
my ($lprofile, $lhat) = @_;
|
|
my $tmode = 0;
|
|
if ($profile eq $profile) {
|
|
if ($mode & ($AA_MAY_EXEC)) {
|
|
$tmode = str_to_mode("Cx::");
|
|
}
|
|
if ($mode & ($AA_MAY_EXEC << $AA_OTHER_SHIFT)) {
|
|
$tmode |= str_to_mode("Cx");
|
|
}
|
|
$nt_name = $lhat;
|
|
} else {
|
|
if ($mode & ($AA_MAY_EXEC)) {
|
|
$tmode = str_to_mode("Px::");
|
|
}
|
|
if ($mode & ($AA_MAY_EXEC << $AA_OTHER_SHIFT)) {
|
|
$tmode |= str_to_mode("Px");
|
|
}
|
|
$nt_name = $lhat;
|
|
}
|
|
$mode = ($mode & ~(str_to_mode("Nx")));
|
|
$mode |= $tmode;
|
|
}
|
|
}
|
|
return ($mode, $nt_name);
|
|
}
|
|
|
|
sub split_mode ($) {
|
|
my $mode = shift;
|
|
|
|
my $user = $mode & $AA_USER_MASK;
|
|
my $other = ($mode >> $AA_OTHER_SHIFT) & $AA_USER_MASK;
|
|
|
|
return ($user, $other);
|
|
}
|
|
|
|
sub is_user_mode ($) {
|
|
my $mode = shift;
|
|
|
|
my ($user, $other) = split_mode($mode);
|
|
|
|
if ($user && !$other) {
|
|
return 1;
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub sub_mode_to_str($) {
|
|
my $mode = shift;
|
|
my $str = "";
|
|
|
|
# "w" implies "a"
|
|
$mode &= (~$AA_MAY_APPEND) if ($mode & $AA_MAY_WRITE);
|
|
$str .= "m" if ($mode & $AA_EXEC_MMAP);
|
|
$str .= "r" if ($mode & $AA_MAY_READ);
|
|
$str .= "w" if ($mode & $AA_MAY_WRITE);
|
|
$str .= "a" if ($mode & $AA_MAY_APPEND);
|
|
$str .= "l" if ($mode & $AA_MAY_LINK);
|
|
$str .= "k" if ($mode & $AA_MAY_LOCK);
|
|
if ($mode & $AA_EXEC_UNCONFINED) {
|
|
if ($mode & $AA_EXEC_UNSAFE) {
|
|
$str .= "u";
|
|
} else {
|
|
$str .= "U";
|
|
}
|
|
}
|
|
if ($mode & ($AA_EXEC_PROFILE | $AA_EXEC_NT)) {
|
|
if ($mode & $AA_EXEC_UNSAFE) {
|
|
$str .= "p";
|
|
} else {
|
|
$str .= "P";
|
|
}
|
|
}
|
|
if ($mode & $AA_EXEC_CHILD) {
|
|
if ($mode & $AA_EXEC_UNSAFE) {
|
|
$str .= "c";
|
|
} else {
|
|
$str .= "C";
|
|
}
|
|
}
|
|
$str .= "i" if ($mode & $AA_EXEC_INHERIT);
|
|
$str .= "x" if ($mode & $AA_MAY_EXEC);
|
|
|
|
return $str;
|
|
}
|
|
|
|
sub flatten_mode ($) {
|
|
my $mode = shift;
|
|
|
|
return 0 if (!$mode);
|
|
|
|
$mode = ($mode & $AA_USER_MASK) | (($mode >> $AA_OTHER_SHIFT) & $AA_USER_MASK);
|
|
$mode |= ($mode << $AA_OTHER_SHIFT);
|
|
}
|
|
|
|
sub mode_to_str ($) {
|
|
my $mode = shift;
|
|
$mode = flatten_mode($mode);
|
|
return sub_mode_to_str($mode);
|
|
}
|
|
|
|
sub owner_flatten_mode($) {
|
|
my $mode = shift;
|
|
$mode = flatten_mode($mode) & $AA_USER_MASK;
|
|
return $mode;
|
|
}
|
|
|
|
sub mode_to_str_user ($) {
|
|
my $mode = shift;
|
|
|
|
my ($user, $other) = split_mode($mode);
|
|
|
|
my $str = "";
|
|
$user = 0 if (!$user);
|
|
$other = 0 if (!$other);
|
|
|
|
if ($user & ~$other) {
|
|
# more user perms than other
|
|
$str = sub_mode_to_str($other). " + " if ($other);
|
|
$str .= "owner " . sub_mode_to_str($user & ~$other);
|
|
} elsif (is_user_mode($mode)) {
|
|
$str = "owner " . sub_mode_to_str($user);
|
|
} else {
|
|
$str = sub_mode_to_str(flatten_mode($mode));
|
|
}
|
|
return $str;
|
|
}
|
|
|
|
sub mode_contains ($$) {
|
|
my ($mode, $subset) = @_;
|
|
|
|
# "w" implies "a"
|
|
if ($mode & $AA_MAY_WRITE) {
|
|
$mode |= $AA_MAY_APPEND;
|
|
}
|
|
if ($mode & ($AA_MAY_WRITE << $AA_OTHER_SHIFT)) {
|
|
$mode |= ($AA_MAY_APPEND << $AA_OTHER_SHIFT);
|
|
}
|
|
|
|
# "?ix" implies "m"
|
|
if ($mode & $AA_EXEC_INHERIT) {
|
|
$mode |= $AA_EXEC_MMAP;
|
|
}
|
|
if ($mode & ($AA_EXEC_INHERIT << $AA_OTHER_SHIFT)) {
|
|
$mode |= ($AA_EXEC_MMAP << $AA_OTHER_SHIFT);
|
|
}
|
|
|
|
return (($mode & $subset) == $subset);
|
|
}
|
|
|
|
sub contains ($$) {
|
|
my ($mode, $str) = @_;
|
|
|
|
return mode_contains($mode, str_to_mode($str));
|
|
}
|
|
|
|
# isSkippableFile - return true if filename matches something that
|
|
# should be skipped (rpm backup files, dotfiles, emacs backup files
|
|
# Annoyingly, this needs to be kept in sync with the skipped files
|
|
# in the apparmor initscript.
|
|
sub isSkippableFile($) {
|
|
my $path = shift;
|
|
|
|
return ($path =~ /(^|\/)\.[^\/]*$/
|
|
|| $path =~ /\.rpm(save|new)$/
|
|
|| $path =~ /\.dpkg-(old|new)$/
|
|
|| $path =~ /\.swp$/
|
|
|| $path =~ /\~$/);
|
|
}
|
|
|
|
# isSkippableDir - return true if directory matches something that
|
|
# should be skipped (cache directory, symlink directories, etc.)
|
|
sub isSkippableDir($) {
|
|
my $path = shift;
|
|
|
|
return ($path eq "disable"
|
|
|| $path eq "cache"
|
|
|| $path eq "force-complain");
|
|
}
|
|
|
|
sub checkIncludeSyntax($) {
|
|
my $errors = shift;
|
|
|
|
if (opendir(SDDIR, $profiledir)) {
|
|
my @incdirs = grep { (!/^\./) && (-d "$profiledir/$_") } readdir(SDDIR);
|
|
close(SDDIR);
|
|
while (my $id = shift @incdirs) {
|
|
next if isSkippableDir($id);
|
|
if (opendir(SDDIR, "$profiledir/$id")) {
|
|
for my $path (grep { !/^\./ } readdir(SDDIR)) {
|
|
chomp($path);
|
|
next if isSkippableFile($path);
|
|
if (-f "$profiledir/$id/$path") {
|
|
my $file = "$id/$path";
|
|
$file =~ s/$profiledir\///;
|
|
eval { loadinclude($file); };
|
|
if ( defined $@ && $@ ne "" ) {
|
|
push @$errors, $@;
|
|
}
|
|
} elsif (-d "$id/$path") {
|
|
push @incdirs, "$id/$path";
|
|
}
|
|
}
|
|
closedir(SDDIR);
|
|
}
|
|
}
|
|
}
|
|
return $errors;
|
|
}
|
|
|
|
sub checkProfileSyntax ($) {
|
|
my $errors = shift;
|
|
|
|
# Check the syntax of profiles
|
|
|
|
opendir(SDDIR, $profiledir)
|
|
or fatal_error "Can't read AppArmor profiles in $profiledir.";
|
|
for my $file (grep { -f "$profiledir/$_" } readdir(SDDIR)) {
|
|
next if isSkippableFile($file);
|
|
my $err = readprofile("$profiledir/$file", \&printMessageErrorHandler, 1);
|
|
if (defined $err and $err ne "") {
|
|
push @$errors, $err;
|
|
}
|
|
}
|
|
closedir(SDDIR);
|
|
return $errors;
|
|
}
|
|
|
|
sub printMessageErrorHandler ($) {
|
|
my $message = shift;
|
|
return $message;
|
|
}
|
|
|
|
sub readprofiles () {
|
|
opendir(SDDIR, $profiledir)
|
|
or fatal_error "Can't read AppArmor profiles in $profiledir.";
|
|
for my $file (grep { -f "$profiledir/$_" } readdir(SDDIR)) {
|
|
next if isSkippableFile($file);
|
|
readprofile("$profiledir/$file", \&fatal_error, 1);
|
|
}
|
|
closedir(SDDIR);
|
|
}
|
|
|
|
sub readinactiveprofiles () {
|
|
return if ( ! -e $extraprofiledir );
|
|
opendir(ESDDIR, $extraprofiledir) or
|
|
fatal_error "Can't read AppArmor profiles in $extraprofiledir.";
|
|
for my $file (grep { -f "$extraprofiledir/$_" } readdir(ESDDIR)) {
|
|
next if $file =~ /\.rpm(save|new)|README$/;
|
|
readprofile("$extraprofiledir/$file", \&fatal_error, 0);
|
|
}
|
|
closedir(ESDDIR);
|
|
}
|
|
|
|
sub readprofile ($$$) {
|
|
my $file = shift;
|
|
my $error_handler = shift;
|
|
my $active_profile = shift;
|
|
if (open(SDPROF, "$file")) {
|
|
local $/;
|
|
my $data = <SDPROF>;
|
|
close(SDPROF);
|
|
|
|
eval {
|
|
my $profile_data = parse_profile_data($data, $file, 0);
|
|
if ($profile_data && $active_profile) {
|
|
attach_profile_data(\%sd, $profile_data);
|
|
attach_profile_data(\%original_sd, $profile_data);
|
|
} elsif ( $profile_data ) {
|
|
attach_profile_data(\%extras, $profile_data);
|
|
}
|
|
};
|
|
|
|
# if there were errors loading the profile, call the error handler
|
|
if ($@) {
|
|
$@ =~ s/\n$//;
|
|
return &$error_handler($@);
|
|
}
|
|
} else {
|
|
$DEBUGGING && debug "readprofile: can't read $file - skipping";
|
|
}
|
|
}
|
|
|
|
sub attach_profile_data {
|
|
my ($profiles, $profile_data) = @_;
|
|
|
|
# make deep copies of the profile data so that if we change one set of
|
|
# profile data, we're not changing others because of sharing references
|
|
for my $p ( keys %$profile_data) {
|
|
$profiles->{$p} = dclone($profile_data->{$p});
|
|
}
|
|
}
|
|
|
|
sub parse_profile_data {
|
|
my ($data, $file, $do_include) = @_;
|
|
|
|
|
|
my ($profile_data, $profile, $hat, $in_contained_hat, $repo_data,
|
|
@parsed_profiles);
|
|
my $initial_comment = "";
|
|
|
|
if ($do_include) {
|
|
$profile = $file;
|
|
$hat = $file;
|
|
}
|
|
|
|
for (split(/\n/, $data)) {
|
|
chomp;
|
|
|
|
# we don't care about blank lines
|
|
next if /^\s*$/;
|
|
|
|
# start of a profile...
|
|
if (m/^\s*(("??\/.+?"??)|(profile\s+("??.+?"??)))\s+((flags=)?\((.+)\)\s+)*\{\s*(#.*)?$/) {
|
|
# if we run into the start of a profile while we're already in a
|
|
# profile, something's wrong...
|
|
if ($profile) {
|
|
unless (($profile eq $hat) and $4) {
|
|
die "$profile profile in $file contains syntax errors.\n";
|
|
}
|
|
}
|
|
|
|
# we hit the start of a profile, keep track of it...
|
|
if ($profile && ($profile eq $hat) && $4) {
|
|
# local profile
|
|
$hat = $4;
|
|
$in_contained_hat = 1;
|
|
$profile_data->{$profile}{$hat}{profile} = 1;
|
|
} else {
|
|
$profile = $2 || $4;
|
|
# hat is same as profile name if we're not in a hat
|
|
($profile, $hat) = split /\/\//, $profile;
|
|
$in_contained_hat = 0;
|
|
if ($hat) {
|
|
$profile_data->{$profile}{$hat}{external} = 1;
|
|
}
|
|
|
|
$hat ||= $profile;
|
|
}
|
|
|
|
my $flags = $7;
|
|
|
|
# deal with whitespace in profile and hat names.
|
|
$profile = strip_quotes($profile);
|
|
$hat = strip_quotes($hat) if $hat;
|
|
|
|
# save off the name and filename
|
|
$profile_data->{$profile}{$hat}{name} = $profile;
|
|
$profile_data->{$profile}{$hat}{filename} = $file;
|
|
$filelist{$file}{profiles}{$profile}{$hat} = 1;
|
|
|
|
# keep track of profile flags
|
|
$profile_data->{$profile}{$hat}{flags} = $flags;
|
|
|
|
$profile_data->{$profile}{$hat}{allow}{netdomain} = { };
|
|
$profile_data->{$profile}{$hat}{allow}{path} = { };
|
|
|
|
# store off initial comment if they have one
|
|
$profile_data->{$profile}{$hat}{initial_comment} = $initial_comment
|
|
if $initial_comment;
|
|
$initial_comment = "";
|
|
|
|
if ($repo_data) {
|
|
$profile_data->{$profile}{$profile}{repo}{url} = $repo_data->{url};
|
|
$profile_data->{$profile}{$profile}{repo}{user} = $repo_data->{user};
|
|
$profile_data->{$profile}{$profile}{repo}{id} = $repo_data->{id};
|
|
$repo_data = undef;
|
|
}
|
|
|
|
} elsif (m/^\s*\}\s*(#.*)?$/) { # end of a profile...
|
|
|
|
# if we hit the end of a profile when we're not in one, something's
|
|
# wrong...
|
|
if (not $profile) {
|
|
die sprintf(gettext('%s contains syntax errors.'), $file) . "\n";
|
|
}
|
|
|
|
if ($in_contained_hat) {
|
|
$hat = $profile;
|
|
$in_contained_hat = 0;
|
|
} else {
|
|
push @parsed_profiles, $profile;
|
|
# mark that we're outside of a profile now...
|
|
$profile = undef;
|
|
}
|
|
|
|
$initial_comment = "";
|
|
|
|
} elsif (m/^\s*(audit\s+)?(deny\s+)?capability\s+(\S+)\s*,\s*(#.*)?$/) { # capability entry
|
|
if (not $profile) {
|
|
die sprintf(gettext('%s contains syntax errors.'), $file) . "\n";
|
|
}
|
|
|
|
my $audit = $1 ? 1 : 0;
|
|
my $allow = $2 ? 'deny' : 'allow';
|
|
$allow = 'deny' if ($2);
|
|
my $capability = $3;
|
|
$profile_data->{$profile}{$hat}{$allow}{capability}{$capability}{set} = 1;
|
|
$profile_data->{$profile}{$hat}{$allow}{capability}{$capability}{audit} = $audit;
|
|
} elsif (m/^\s*set capability\s+(\S+)\s*,\s*(#.*)?$/) { # capability entry
|
|
if (not $profile) {
|
|
die sprintf(gettext('%s contains syntax errors.'), $file) . "\n";
|
|
}
|
|
|
|
my $capability = $1;
|
|
$profile_data->{$profile}{$hat}{set_capability}{$capability} = 1;
|
|
|
|
} elsif (m/^\s*(audit\s+)?(deny\s+)?link\s+(((subset)|(<=))\s+)?([\"\@\/].*?"??)\s+->\s*([\"\@\/].*?"??)\s*,\s*(#.*)?$/) { # for now just keep link
|
|
if (not $profile) {
|
|
die sprintf(gettext('%s contains syntax errors.'), $file) . "\n";
|
|
}
|
|
my $audit = $1 ? 1 : 0;
|
|
my $allow = $2 ? 'deny' : 'allow';
|
|
|
|
my $subset = $4;
|
|
my $link = strip_quotes($7);
|
|
my $value = strip_quotes($8);
|
|
$profile_data->{$profile}{$hat}{$allow}{link}{$link}{to} = $value;
|
|
$profile_data->{$profile}{$hat}{$allow}{link}{$link}{mode} |= $AA_MAY_LINK;
|
|
if ($subset) {
|
|
$profile_data->{$profile}{$hat}{$allow}{link}{$link}{mode} |= $AA_LINK_SUBSET;
|
|
}
|
|
if ($audit) {
|
|
$profile_data->{$profile}{$hat}{$allow}{link}{$link}{audit} |= $AA_LINK_SUBSET;
|
|
} else {
|
|
$profile_data->{$profile}{$hat}{$allow}{link}{$link}{audit} |= 0;
|
|
}
|
|
|
|
} elsif (m/^\s*change_profile\s+->\s*("??.+?"??),(#.*)?$/) { # for now just keep change_profile
|
|
if (not $profile) {
|
|
die sprintf(gettext('%s contains syntax errors.'), $file) . "\n";
|
|
}
|
|
my $cp = strip_quotes($1);
|
|
|
|
$profile_data->{$profile}{$hat}{change_profile}{$cp} = 1;
|
|
} elsif (m/^\s*alias\s+("??.+?"??)\s+->\s*("??.+?"??)\s*,(#.*)?$/) { # never do anything with aliases just keep them
|
|
my $from = strip_quotes($1);
|
|
my $to = strip_quotes($2);
|
|
|
|
if ($profile) {
|
|
$profile_data->{$profile}{$hat}{alias}{$from} = $to;
|
|
} else {
|
|
unless (exists $filelist{$file}) {
|
|
$filelist{$file} = { };
|
|
}
|
|
$filelist{$file}{alias}{$from} = $to;
|
|
}
|
|
|
|
} elsif (m/^\s*set\s+rlimit\s+(.+)\s+<=\s*(.+)\s*,(#.*)?$/) { # never do anything with rlimits just keep them
|
|
if (not $profile) {
|
|
die sprintf(gettext('%s contains syntax errors.'), $file) . "\n";
|
|
}
|
|
my $from = $1;
|
|
my $to = $2;
|
|
|
|
$profile_data->{$profile}{$hat}{rlimit}{$from} = $to;
|
|
|
|
} elsif (/^\s*(\$\{?[[:alpha:]][[:alnum:]_]*\}?)\s*=\s*(true|false)\s*,?\s*(#.*)?$/i) { # boolean definition
|
|
if (not $profile) {
|
|
die sprintf(gettext('%s contains syntax errors.'), $file) . "\n";
|
|
}
|
|
my $bool_var = $1;
|
|
my $value = $2;
|
|
|
|
$profile_data->{$profile}{$hat}{lvar}{$bool_var} = $value;
|
|
} elsif (/^\s*(@\{?[[:alpha:]][[:alnum:]_]+\}?)\s*\+?=\s*(.+?)\s*,?\s*(#.*)?$/) { # variable additions both += and = doesn't mater
|
|
my $list_var = strip_quotes($1);
|
|
my $value = strip_quotes($2);
|
|
|
|
if ($profile) {
|
|
unless (exists $profile_data->{$profile}{$hat}{lvar}) {
|
|
# create lval hash by sticking an empty list into list_var
|
|
my @empty = ();
|
|
$profile_data->{$profile}{$hat}{lvar}{$list_var} = \@empty;
|
|
}
|
|
|
|
store_list_var($profile_data->{$profile}{$hat}{lvar}, $list_var, $value);
|
|
} else {
|
|
unless (exists $filelist{$file}{lvar}) {
|
|
# create lval hash by sticking an empty list into list_var
|
|
my @empty = ();
|
|
$filelist{$file}{lvar}{$list_var} = \@empty;
|
|
}
|
|
|
|
store_list_var($filelist{$file}{lvar}, $list_var, $value);
|
|
}
|
|
} elsif (m/^\s*if\s+(not\s+)?(\$\{?[[:alpha:]][[:alnum:]_]*\}?)\s*\{\s*(#.*)?$/) { # conditional -- boolean
|
|
} elsif (m/^\s*if\s+(not\s+)?defined\s+(@\{?[[:alpha:]][[:alnum:]_]+\}?)\s*\{\s*(#.*)?$/) { # conditional -- variable defined
|
|
} elsif (m/^\s*if\s+(not\s+)?defined\s+(\$\{?[[:alpha:]][[:alnum:]_]+\}?)\s*\{\s*(#.*)?$/) { # conditional -- boolean defined
|
|
} elsif (m/^\s*(audit\s+)?(deny\s+)?(owner\s+)?([\"\@\/].*?)\s+(\S+)(\s+->\s*(.*?))?\s*,\s*(#.*)?$/) { # path entry
|
|
if (not $profile) {
|
|
die sprintf(gettext('%s contains syntax errors.'), $file) . "\n";
|
|
}
|
|
|
|
my $audit = $1 ? 1 : 0;
|
|
my $allow = $2 ? 'deny' : 'allow';
|
|
my $user = $3 ? 1 : 0;
|
|
my ($path, $mode, $nt_name) = ($4, $5, $7);
|
|
|
|
# strip off any trailing spaces.
|
|
$path =~ s/\s+$//;
|
|
$nt_name =~ s/\s+$// if $nt_name;
|
|
|
|
$path = strip_quotes($path);
|
|
$nt_name = strip_quotes($nt_name) if $nt_name;
|
|
|
|
# make sure they don't have broken regexps in the profile
|
|
my $p_re = convert_regexp($path);
|
|
eval { "foo" =~ m/^$p_re$/; };
|
|
if ($@) {
|
|
die sprintf(gettext('Profile %s contains invalid regexp %s.'),
|
|
$file, $path) . "\n";
|
|
}
|
|
|
|
if (!validate_profile_mode($mode, $allow, $nt_name)) {
|
|
fatal_error(sprintf(gettext('Profile %s contains invalid mode %s.'), $file, $mode));
|
|
}
|
|
|
|
my $tmpmode;
|
|
if ($user) {
|
|
$tmpmode = str_to_mode("${mode}::");
|
|
} else {
|
|
$tmpmode = str_to_mode($mode);
|
|
}
|
|
|
|
$profile_data->{$profile}{$hat}{$allow}{path}{$path}{mode} |= $tmpmode;
|
|
$profile_data->{$profile}{$hat}{$allow}{path}{$path}{to} = $nt_name if $nt_name;
|
|
if ($audit) {
|
|
$profile_data->{$profile}{$hat}{$allow}{path}{$path}{audit} |= $tmpmode;
|
|
} else {
|
|
$profile_data->{$profile}{$hat}{$allow}{path}{$path}{audit} |= 0;
|
|
}
|
|
} elsif (m/^\s*#include <(.+)>\s*$/) { # include stuff
|
|
my $include = $1;
|
|
|
|
if ($profile) {
|
|
$profile_data->{$profile}{$hat}{include}{$include} = 1;
|
|
} else {
|
|
unless (exists $filelist{$file}) {
|
|
$filelist{$file} = { };
|
|
}
|
|
$filelist{$file}{include}{$include} = 1;
|
|
}
|
|
|
|
# include is a dir
|
|
if (-d "$profiledir/$include") {
|
|
if (opendir(SDINCDIR, "$profiledir/$include")) {
|
|
for my $path (readdir(SDINCDIR)) {
|
|
chomp($path);
|
|
next if isSkippableFile($path);
|
|
if (-f "$profiledir/$include/$path") {
|
|
my $file = "$include/$path";
|
|
$file =~ s/$profiledir\///;
|
|
my $ret = eval { loadinclude($file); };
|
|
if ($@) { die $@; }
|
|
return $ret if ( $ret != 0 );
|
|
}
|
|
}
|
|
}
|
|
closedir(SDINCDIR);
|
|
} else {
|
|
# try to load the include...
|
|
my $ret = eval { loadinclude($include); };
|
|
# propagate errors up the chain
|
|
if ($@) { die $@; }
|
|
return $ret if ( $ret != 0 );
|
|
}
|
|
} elsif (/^\s*(audit\s+)?(deny\s+)?network(.*)/) {
|
|
if (not $profile) {
|
|
die sprintf(gettext('%s contains syntax errors.'), $file) . "\n";
|
|
}
|
|
my $audit = $1 ? 1 : 0;
|
|
my $allow = $2 ? 'deny' : 'allow';
|
|
my $network = $3;
|
|
|
|
unless ($profile_data->{$profile}{$hat}{$allow}{netdomain}{rule}) {
|
|
$profile_data->{$profile}{$hat}{$allow}{netdomain}{rule} = { };
|
|
}
|
|
|
|
if ($network =~ /\s+(\S+)\s+(\S+)\s*,\s*(#.*)?$/ ) {
|
|
my $fam = $1;
|
|
my $type = $2;
|
|
$profile_data->{$profile}{$hat}{$allow}{netdomain}{rule}{$fam}{$type} = 1;
|
|
$profile_data->{$profile}{$hat}{$allow}{netdomain}{audit}{$fam}{$type} = $audit;
|
|
} elsif ( $network =~ /\s+(\S+)\s*,\s*(#.*)?$/ ) {
|
|
my $fam = $1;
|
|
$profile_data->{$profile}{$hat}{$allow}{netdomain}{rule}{$fam} = 1;
|
|
$profile_data->{$profile}{$hat}{$allow}{netdomain}{audit}{$fam} = $audit;
|
|
} else {
|
|
$profile_data->{$profile}{$hat}{$allow}{netdomain}{rule}{all} = 1;
|
|
$profile_data->{$profile}{$hat}{$allow}{netdomain}{audit}{all} = 1;
|
|
}
|
|
} elsif (/^\s*(tcp_connect|tcp_accept|udp_send|udp_receive)/) {
|
|
# just ignore and drop old style network
|
|
# die sprintf(gettext('%s contains old style network rules.'), $file) . "\n";
|
|
|
|
} elsif (m/^\s*\^(\"??.+?\"??)\s*,\s*(#.*)?$/) {
|
|
if (not $profile) {
|
|
die "$file contains syntax errors.";
|
|
}
|
|
# change_hat declaration - needed to change_hat to an external
|
|
# hat
|
|
$hat = $1;
|
|
$hat = $1 if $hat =~ /^"(.+)"$/;
|
|
|
|
#store we have a declaration if the hat hasn't been seen
|
|
$profile_data->{$profile}{$hat}{'declared'} = 1
|
|
unless exists($profile_data->{$profile}{$hat}{declared});
|
|
|
|
} elsif (m/^\s*\^(\"??.+?\"??)\s+((flags=)?\((.+)\)\s+)*\{\s*(#.*)?$/) {
|
|
# start of embedded hat syntax hat definition
|
|
# read in and mark as changed so that will be written out in the new
|
|
# format
|
|
|
|
# if we hit the start of a contained hat when we're not in a profile
|
|
# something is wrong...
|
|
if (not $profile) {
|
|
die sprintf(gettext('%s contains syntax errors.'), $file) . "\n";
|
|
}
|
|
|
|
$in_contained_hat = 1;
|
|
|
|
# we hit the start of a hat inside the current profile
|
|
$hat = $1;
|
|
my $flags = $4;
|
|
|
|
# strip quotes.
|
|
$hat = $1 if $hat =~ /^"(.+)"$/;
|
|
|
|
# keep track of profile flags
|
|
$profile_data->{$profile}{$hat}{flags} = $flags;
|
|
# we have seen more than a declaration so clear it
|
|
$profile_data->{$profile}{$hat}{'declared'} = 0;
|
|
$profile_data->{$profile}{$hat}{allow}{path} = { };
|
|
$profile_data->{$profile}{$hat}{allow}{netdomain} = { };
|
|
|
|
# store off initial comment if they have one
|
|
$profile_data->{$profile}{$hat}{initial_comment} = $initial_comment
|
|
if $initial_comment;
|
|
$initial_comment = "";
|
|
#don't mark profile as changed just because it has an embedded
|
|
#hat.
|
|
#$changed{$profile} = 1;
|
|
|
|
$filelist{$file}{profiles}{$profile}{$hat} = 1;
|
|
|
|
} elsif (/^\s*\#/) {
|
|
# we only currently handle initial comments
|
|
if (not $profile) {
|
|
# ignore vim syntax highlighting lines
|
|
next if /^\s*\# vim:syntax/;
|
|
# ignore Last Modified: lines
|
|
next if /^\s*\# Last Modified:/;
|
|
if (/^\s*\# REPOSITORY: (\S+) (\S+) (\S+)$/) {
|
|
$repo_data = { url => $1, user => $2, id => $3 };
|
|
} elsif (/^\s*\# REPOSITORY: NEVERSUBMIT$/) {
|
|
$repo_data = { neversubmit => 1 };
|
|
} else {
|
|
$initial_comment .= "$_\n";
|
|
}
|
|
}
|
|
} else {
|
|
# we hit something we don't understand in a profile...
|
|
die sprintf(gettext('%s contains syntax errors. Line [%s]'), $file, $_) . "\n";
|
|
}
|
|
}
|
|
|
|
#
|
|
# Cleanup : add required hats if not present in the
|
|
# parsed profiles
|
|
#
|
|
if (not $do_include) {
|
|
for my $hatglob (keys %{$cfg->{required_hats}}) {
|
|
for my $parsed_profile ( sort @parsed_profiles ) {
|
|
if ($parsed_profile =~ /$hatglob/) {
|
|
for my $hat (split(/\s+/, $cfg->{required_hats}{$hatglob})) {
|
|
unless ($profile_data->{$parsed_profile}{$hat}) {
|
|
$profile_data->{$parsed_profile}{$hat} = { };
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
} # if we're still in a profile when we hit the end of the file, it's bad
|
|
if ($profile and not $do_include) {
|
|
die "Reached the end of $file while we were still inside the $profile profile.\n";
|
|
}
|
|
|
|
return $profile_data;
|
|
}
|
|
|
|
sub eliminate_duplicates(@) {
|
|
my @data =@_;
|
|
|
|
my %set = map { $_ => 1 } @_;
|
|
@data = keys %set;
|
|
|
|
return @data;
|
|
}
|
|
|
|
sub separate_vars($) {
|
|
my $vs = shift;
|
|
my @data;
|
|
|
|
# while ($vs =~ /\s*(((\"([^\"]|\\\"))+?\")|\S*)\s*(.*)$/) {
|
|
while ($vs =~ /\s*((\".+?\")|([^\"]\S+))\s*(.*)$/) {
|
|
my $tmp = $1;
|
|
push @data, strip_quotes($tmp);
|
|
$vs = $4;
|
|
}
|
|
|
|
return @data;
|
|
}
|
|
|
|
sub is_active_profile ($) {
|
|
my $pname = shift;
|
|
if ( $sd{$pname} ) {
|
|
return 1;
|
|
} else {
|
|
return 0;
|
|
}
|
|
}
|
|
|
|
sub store_list_var (\%$$) {
|
|
my ($vars, $list_var, $value) = @_;
|
|
|
|
my @vlist = (separate_vars($value));
|
|
|
|
# if (exists $profile_data->{$profile}{$hat}{lvar}{$list_var}) {
|
|
# @vlist = (@vlist, @{$profile_data->{$profile}{$hat}{lvar}{$list_var}});
|
|
# }
|
|
#
|
|
# @vlist = eliminate_duplicates(@vlist);
|
|
# $profile_data->{$profile}{$hat}{lvar}{$list_var} = \@vlist;
|
|
|
|
if (exists $vars->{$list_var}) {
|
|
@vlist = (@vlist, @{$vars->{$list_var}});
|
|
}
|
|
|
|
@vlist = eliminate_duplicates(@vlist);
|
|
$vars->{$list_var} = \@vlist;
|
|
|
|
|
|
}
|
|
|
|
sub strip_quotes ($) {
|
|
my $data = shift;
|
|
$data = $1 if $data =~ /^\"(.*)\"$/;
|
|
return $data;
|
|
}
|
|
|
|
sub quote_if_needed ($) {
|
|
my $data = shift;
|
|
$data = "\"$data\"" if $data =~ /\s/;
|
|
|
|
return $data;
|
|
}
|
|
|
|
sub escape ($) {
|
|
my $dangerous = shift;
|
|
|
|
$dangerous = strip_quotes($dangerous);
|
|
|
|
$dangerous =~ s/((?<!\\))"/$1\\"/g;
|
|
if ($dangerous =~ m/(\s|^$|")/) {
|
|
$dangerous = "\"$dangerous\"";
|
|
}
|
|
|
|
return $dangerous;
|
|
}
|
|
|
|
sub writeheader ($$$$$) {
|
|
my ($profile_data, $depth, $name, $embedded_hat, $write_flags) = @_;
|
|
|
|
my $pre = ' ' x $depth;
|
|
my @data;
|
|
# deal with whitespace in profile names...
|
|
$name = quote_if_needed($name);
|
|
|
|
$name = "profile $name" if ((!$embedded_hat && $name =~ /^[^\/]|^"[^\/]/)
|
|
|| ($embedded_hat && $name =~/^[^^]/));
|
|
|
|
#push @data, "#include <tunables/global>" unless ( $is_hat );
|
|
if ($write_flags and $profile_data->{flags}) {
|
|
push @data, "${pre}$name flags=($profile_data->{flags}) {";
|
|
} else {
|
|
push @data, "${pre}$name {";
|
|
}
|
|
|
|
return @data;
|
|
}
|
|
|
|
sub qin_trans ($) {
|
|
my $value = shift;
|
|
return quote_if_needed($value);
|
|
}
|
|
|
|
sub write_single ($$$$$$) {
|
|
my ($profile_data, $depth, $allow, $name, $prefix, $tail) = @_;
|
|
my $ref;
|
|
my @data;
|
|
|
|
if ($allow) {
|
|
$ref = $profile_data->{$allow};
|
|
if ($allow eq 'deny') {
|
|
$allow .= " ";
|
|
} else {
|
|
$allow = "";
|
|
}
|
|
} else {
|
|
$ref = $profile_data;
|
|
$allow = "";
|
|
}
|
|
|
|
my $pre = " " x $depth;
|
|
|
|
|
|
# dump out the data
|
|
if (exists $ref->{$name}) {
|
|
for my $key (sort keys %{$ref->{$name}}) {
|
|
my $qkey = quote_if_needed($key);
|
|
push @data, "${pre}${allow}${prefix}${qkey}${tail}";
|
|
}
|
|
push @data, "" if keys %{$ref->{$name}};
|
|
}
|
|
|
|
return @data;
|
|
}
|
|
|
|
sub write_pair ($$$$$$$$) {
|
|
my ($profile_data, $depth, $allow, $name, $prefix, $sep, $tail, $fn) = @_;
|
|
my $ref;
|
|
my @data;
|
|
|
|
if ($allow) {
|
|
$ref = $profile_data->{$allow};
|
|
if ($allow eq 'deny') {
|
|
$allow .= " ";
|
|
} else {
|
|
$allow = "";
|
|
}
|
|
} else {
|
|
$ref = $profile_data;
|
|
$allow = "";
|
|
}
|
|
|
|
my $pre = " " x $depth;
|
|
|
|
# dump out the data
|
|
if (exists $ref->{$name}) {
|
|
for my $key (sort keys %{$ref->{$name}}) {
|
|
my $value = &{$fn}($ref->{$name}{$key});
|
|
push @data, "${pre}${allow}${prefix}${key}${sep}${value}${tail}";
|
|
}
|
|
push @data, "" if keys %{$ref->{$name}};
|
|
}
|
|
|
|
return @data;
|
|
}
|
|
|
|
sub writeincludes ($$) {
|
|
my ($prof_data, $depth) = @_;
|
|
|
|
return write_single($prof_data, $depth,'', 'include', "#include <", ">");
|
|
}
|
|
|
|
sub writechange_profile ($$) {
|
|
my ($prof_data, $depth) = @_;
|
|
|
|
return write_single($prof_data, $depth, '', 'change_profile', "change_profile -> ", ",");
|
|
}
|
|
|
|
sub writealiases ($$) {
|
|
my ($prof_data, $depth) = @_;
|
|
|
|
return write_pair($prof_data, $depth, '', 'alias', "alias ", " -> ", ",", \&qin_trans);
|
|
}
|
|
|
|
sub writerlimits ($$) {
|
|
my ($prof_data, $depth) = @_;
|
|
|
|
return write_pair($prof_data, $depth, '', 'rlimit', "set rlimit ", " <= ", ",", \&qin_trans);
|
|
}
|
|
|
|
# take a list references and process it
|
|
sub var_transform($) {
|
|
my $ref = shift;
|
|
my @in = @{$ref};
|
|
my @data;
|
|
|
|
foreach my $value (@in) {
|
|
push @data, quote_if_needed($value);
|
|
}
|
|
|
|
return join " ", @data;
|
|
}
|
|
|
|
sub writelistvars ($$) {
|
|
my ($prof_data, $depth) = @_;
|
|
|
|
return write_pair($prof_data, $depth, '', 'lvar', "", " = ", ",", \&var_transform);
|
|
}
|
|
|
|
sub writecap_rules ($$$) {
|
|
my ($profile_data, $depth, $allow) = @_;
|
|
|
|
my $allowstr = $allow eq 'deny' ? 'deny ' : '';
|
|
my $pre = " " x $depth;
|
|
|
|
my @data;
|
|
if (exists $profile_data->{$allow}{capability}) {
|
|
for my $cap (sort keys %{$profile_data->{$allow}{capability}}) {
|
|
my $audit = ($profile_data->{$allow}{capability}{$cap}{audit}) ? 'audit ' : '';
|
|
if ($profile_data->{$allow}{capability}{$cap}{set}) {
|
|
push @data, "${pre}${audit}${allowstr}capability ${cap},";
|
|
}
|
|
}
|
|
push @data, "";
|
|
}
|
|
|
|
return @data;
|
|
}
|
|
|
|
sub writecapabilities ($$) {
|
|
my ($prof_data, $depth) = @_;
|
|
my @data;
|
|
push @data, write_single($prof_data, $depth, '', 'set_capability', "set capability ", ",");
|
|
push @data, writecap_rules($prof_data, $depth, 'deny');
|
|
push @data, writecap_rules($prof_data, $depth, 'allow');
|
|
return @data;
|
|
}
|
|
|
|
sub writenet_rules ($$$) {
|
|
my ($profile_data, $depth, $allow) = @_;
|
|
|
|
my $allowstr = $allow eq 'deny' ? 'deny ' : '';
|
|
|
|
my $pre = " " x $depth;
|
|
my $audit = "";
|
|
|
|
my @data;
|
|
# dump out the netdomain entries...
|
|
if (exists $profile_data->{$allow}{netdomain}) {
|
|
if ( $profile_data->{$allow}{netdomain}{rule} &&
|
|
$profile_data->{$allow}{netdomain}{rule} eq 'all') {
|
|
$audit = "audit " if $profile_data->{$allow}{netdomain}{audit}{all};
|
|
push @data, "${pre}${audit}network,";
|
|
} else {
|
|
for my $fam (sort keys %{$profile_data->{$allow}{netdomain}{rule}}) {
|
|
if ( $profile_data->{$allow}{netdomain}{rule}{$fam} == 1 ) {
|
|
$audit = "audit " if $profile_data->{$allow}{netdomain}{audit}{$fam};
|
|
push @data, "${pre}${audit}${allowstr}network $fam,";
|
|
} else {
|
|
for my $type
|
|
(sort keys %{$profile_data->{$allow}{netdomain}{rule}{$fam}}) {
|
|
$audit = "audit " if $profile_data->{$allow}{netdomain}{audit}{$fam}{$type};
|
|
push @data, "${pre}${audit}${allowstr}network $fam $type,";
|
|
}
|
|
}
|
|
}
|
|
}
|
|
push @data, "" if %{$profile_data->{$allow}{netdomain}};
|
|
}
|
|
return @data;
|
|
|
|
}
|
|
|
|
sub writenetdomain ($$) {
|
|
my ($prof_data, $depth) = @_;
|
|
my @data;
|
|
|
|
push @data, writenet_rules($prof_data, $depth, 'deny');
|
|
push @data, writenet_rules($prof_data, $depth, 'allow');
|
|
|
|
return @data;
|
|
}
|
|
|
|
sub writelink_rules ($$$) {
|
|
my ($profile_data, $depth, $allow) = @_;
|
|
|
|
my $allowstr = $allow eq 'deny' ? 'deny ' : '';
|
|
my $pre = " " x $depth;
|
|
|
|
my @data;
|
|
if (exists $profile_data->{$allow}{link}) {
|
|
for my $path (sort keys %{$profile_data->{$allow}{link}}) {
|
|
my $to = $profile_data->{$allow}{link}{$path}{to};
|
|
my $subset = ($profile_data->{$allow}{link}{$path}{mode} & $AA_LINK_SUBSET) ? 'subset ' : '';
|
|
my $audit = ($profile_data->{$allow}{link}{$path}{audit}) ? 'audit ' : '';
|
|
# deal with whitespace in path names
|
|
$path = quote_if_needed($path);
|
|
$to = quote_if_needed($to);
|
|
push @data, "${pre}${audit}${allowstr}link ${subset}${path} -> ${to},";
|
|
}
|
|
push @data, "";
|
|
}
|
|
|
|
return @data;
|
|
}
|
|
|
|
sub writelinks ($$) {
|
|
my ($profile_data, $depth) = @_;
|
|
my @data;
|
|
|
|
push @data, writelink_rules($profile_data, $depth, 'deny');
|
|
push @data, writelink_rules($profile_data, $depth, 'allow');
|
|
|
|
return @data;
|
|
}
|
|
|
|
sub writepath_rules ($$$) {
|
|
my ($profile_data, $depth, $allow) = @_;
|
|
|
|
my $allowstr = $allow eq 'deny' ? 'deny ' : '';
|
|
my $pre = " " x $depth;
|
|
|
|
my @data;
|
|
if (exists $profile_data->{$allow}{path}) {
|
|
for my $path (sort keys %{$profile_data->{$allow}{path}}) {
|
|
my $mode = $profile_data->{$allow}{path}{$path}{mode};
|
|
my $audit = $profile_data->{$allow}{path}{$path}{audit};
|
|
my $tail = "";
|
|
$tail = " -> " . $profile_data->{$allow}{path}{$path}{to} if ($profile_data->{$allow}{path}{$path}{to});
|
|
my ($user, $other) = split_mode($mode);
|
|
my ($user_audit, $other_audit) = split_mode($audit);
|
|
# determine whether the rule contains any owner only components
|
|
|
|
while ($user || $other) {
|
|
my $ownerstr = "";
|
|
my ($tmpmode, $tmpaudit) = 0;
|
|
if ($user & ~$other) {
|
|
# user contains bits not set in other
|
|
$ownerstr = "owner ";
|
|
$tmpmode = $user & ~$other;
|
|
$tmpaudit = $user_audit;
|
|
$user &= ~$tmpmode;
|
|
# } elsif ($other & ~$user) {
|
|
# $ownerstr = "other ";
|
|
# $tmpmode = $other & ~$user;
|
|
# $tmpaudit = $other_audit;
|
|
# $other &= ~$tmpmode;
|
|
} else {
|
|
if ($user_audit & ~$other_audit & $user) {
|
|
$ownerstr = "owner ";
|
|
$tmpaudit = $user_audit & ~$other_audit & $user;
|
|
$tmpmode = $user & $tmpaudit;
|
|
$user &= ~$tmpmode;
|
|
# } elsif ($other_audit & ~$user_audit & $other) {
|
|
# $ownerstr = "other ";
|
|
# $tmpaudit = $other_audit & ~$user_audit & $other;
|
|
# $tmpmode = $other & $tmpaudit;
|
|
# $other &= ~$tmpmode;
|
|
} else {
|
|
# user == other && user_audit == other_audit
|
|
$ownerstr = "";
|
|
#include exclusive other for now
|
|
# $tmpmode = $user;
|
|
# $tmpaudit = $user_audit;
|
|
$tmpmode = $user | $other;
|
|
$tmpaudit = $user_audit | $other_audit;
|
|
$user &= ~$tmpmode;
|
|
$other &= ~$tmpmode;
|
|
}
|
|
}
|
|
|
|
if ($tmpmode & $tmpaudit) {
|
|
my $modestr = mode_to_str($tmpmode & $tmpaudit);
|
|
if ($path =~ /\s/) {
|
|
push @data, "${pre}audit ${allowstr}${ownerstr}\"$path\" ${modestr}${tail},";
|
|
} else {
|
|
push @data, "${pre}audit ${allowstr}${ownerstr}$path ${modestr}${tail},";
|
|
}
|
|
$tmpmode &= ~$tmpaudit;
|
|
}
|
|
if ($tmpmode) {
|
|
my $modestr = mode_to_str($tmpmode);
|
|
if ($path =~ /\s/) {
|
|
push @data, "${pre}${allowstr}${ownerstr}\"$path\" ${modestr}${tail},";
|
|
} else {
|
|
push @data, "${pre}${allowstr}${ownerstr}$path ${modestr}${tail},";
|
|
}
|
|
}
|
|
}
|
|
|
|
}
|
|
push @data, "";
|
|
}
|
|
|
|
return @data;
|
|
}
|
|
|
|
sub writepaths ($$) {
|
|
my ($prof_data, $depth) = @_;
|
|
|
|
my @data;
|
|
push @data, writepath_rules($prof_data, $depth, 'deny');
|
|
push @data, writepath_rules($prof_data, $depth, 'allow');
|
|
|
|
return @data;
|
|
}
|
|
|
|
sub write_rules ($$) {
|
|
my ($prof_data, $depth) = @_;
|
|
|
|
my @data;
|
|
push @data, writealiases($prof_data, $depth);
|
|
push @data, writelistvars($prof_data, $depth);
|
|
push @data, writeincludes($prof_data, $depth);
|
|
push @data, writerlimits($prof_data, $depth);
|
|
push @data, writecapabilities($prof_data, $depth);
|
|
push @data, writenetdomain($prof_data, $depth);
|
|
push @data, writelinks($prof_data, $depth);
|
|
push @data, writepaths($prof_data, $depth);
|
|
push @data, writechange_profile($prof_data, $depth);
|
|
|
|
return @data;
|
|
}
|
|
|
|
sub writepiece ($$$$$);
|
|
sub writepiece ($$$$$) {
|
|
my ($profile_data, $depth, $name, $nhat, $write_flags) = @_;
|
|
|
|
my $pre = ' ' x $depth;
|
|
my @data;
|
|
my $wname;
|
|
my $inhat = 0;
|
|
if ($name eq $nhat) {
|
|
$wname = $name;
|
|
} else {
|
|
$wname = "$name//$nhat";
|
|
$name = $nhat;
|
|
$inhat = 1;
|
|
}
|
|
push @data, writeheader($profile_data->{$name}, $depth, $wname, 0, $write_flags);
|
|
push @data, write_rules($profile_data->{$name}, $depth + 1);
|
|
|
|
my $pre2 = ' ' x ($depth + 1);
|
|
# write external hat declarations
|
|
for my $hat (grep { $_ ne $name } sort keys %{$profile_data}) {
|
|
if ($profile_data->{$hat}{declared}) {
|
|
push @data, "${pre2}^$hat,";
|
|
}
|
|
}
|
|
|
|
if (!$inhat) {
|
|
# write embedded hats
|
|
for my $hat (grep { $_ ne $name } sort keys %{$profile_data}) {
|
|
if ((not $profile_data->{$hat}{external}) and
|
|
(not $profile_data->{$hat}{declared})) {
|
|
push @data, "";
|
|
if ($profile_data->{$hat}{profile}) {
|
|
push @data, map { "$_" } writeheader($profile_data->{$hat},
|
|
$depth + 1, $hat,
|
|
1, $write_flags);
|
|
} else {
|
|
push @data, map { "$_" } writeheader($profile_data->{$hat},
|
|
$depth + 1, "^$hat",
|
|
1, $write_flags);
|
|
}
|
|
push @data, map { "$_" } write_rules($profile_data->{$hat},
|
|
$depth + 2);
|
|
push @data, "${pre2}}";
|
|
}
|
|
}
|
|
push @data, "${pre}}";
|
|
|
|
#write external hats
|
|
for my $hat (grep { $_ ne $name } sort keys %{$profile_data}) {
|
|
if (($name eq $nhat) and $profile_data->{$hat}{external}) {
|
|
push @data, "";
|
|
push @data, map { " $_" } writepiece($profile_data, $depth - 1,
|
|
$name, $hat, $write_flags);
|
|
push @data, " }";
|
|
}
|
|
}
|
|
}
|
|
return @data;
|
|
}
|
|
|
|
sub serialize_profile {
|
|
my ($profile_data, $name, $options) = @_;
|
|
|
|
my $string = "";
|
|
my $include_metadata = 0; # By default don't write out metadata
|
|
my $include_flags = 1;
|
|
if ( $options and ref($options) eq "HASH" ) {
|
|
$include_metadata = 1 if ( defined $options->{METADATA} );
|
|
$include_flags = 0 if ( defined $options->{NO_FLAGS} );
|
|
}
|
|
|
|
if ($include_metadata) {
|
|
# keep track of when the file was last updated
|
|
$string .= "# Last Modified: " . localtime(time) . "\n";
|
|
|
|
# print out repository metadata
|
|
if ($profile_data->{$name}{repo} &&
|
|
$profile_data->{$name}{repo}{url} &&
|
|
$profile_data->{$name}{repo}{user} &&
|
|
$profile_data->{$name}{repo}{id}) {
|
|
my $repo = $profile_data->{$name}{repo};
|
|
$string .= "# REPOSITORY: $repo->{url} $repo->{user} $repo->{id}\n";
|
|
} elsif ($profile_data->{$name}{repo}{neversubmit}) {
|
|
$string .= "# REPOSITORY: NEVERSUBMIT\n";
|
|
}
|
|
}
|
|
|
|
# print out initial comment
|
|
if ($profile_data->{$name}{initial_comment}) {
|
|
my $comment = $profile_data->{$name}{initial_comment};
|
|
$comment =~ s/\\n/\n/g;
|
|
$string .= "$comment\n";
|
|
}
|
|
|
|
#bleah this is stupid the data structure needs to be reworked
|
|
my $filename = getprofilefilename($name);
|
|
my @data;
|
|
if ($filelist{$filename}) {
|
|
push @data, writealiases($filelist{$filename}, 0);
|
|
push @data, writelistvars($filelist{$filename}, 0);
|
|
push @data, writeincludes($filelist{$filename}, 0);
|
|
}
|
|
|
|
|
|
# XXX - FIXME
|
|
#
|
|
# # dump variables defined in this file
|
|
# if ($variables{$filename}) {
|
|
# for my $var (sort keys %{$variables{$filename}}) {
|
|
# if ($var =~ m/^@/) {
|
|
# my @values = sort @{$variables{$filename}{$var}};
|
|
# @values = map { escape($_) } @values;
|
|
# my $values = join (" ", @values);
|
|
# print SDPROF "$var = ";
|
|
# print SDPROF $values;
|
|
# } elsif ($var =~ m/^\$/) {
|
|
# print SDPROF "$var = ";
|
|
# print SDPROF ${$variables{$filename}{$var}};
|
|
# } elsif ($var =~ m/^\#/) {
|
|
# my $inc = $var;
|
|
# $inc =~ s/^\#//;
|
|
# print SDPROF "#include <$inc>";
|
|
# }
|
|
# print SDPROF "\n";
|
|
# }
|
|
# }
|
|
|
|
push @data, writepiece($profile_data, 0, $name, $name, $include_flags);
|
|
$string .= join("\n", @data);
|
|
|
|
return "$string\n";
|
|
}
|
|
|
|
sub writeprofile_ui_feedback ($) {
|
|
my $profile = shift;
|
|
UI_Info(sprintf(gettext('Writing updated profile for %s.'), $profile));
|
|
writeprofile($profile);
|
|
}
|
|
|
|
sub writeprofile ($) {
|
|
my ($profile) = shift;
|
|
|
|
my $filename = $sd{$profile}{$profile}{filename} || getprofilefilename($profile);
|
|
|
|
open(SDPROF, ">$filename") or
|
|
fatal_error "Can't write new AppArmor profile $filename: $!";
|
|
my $serialize_opts = { };
|
|
$serialize_opts->{METADATA} = 1;
|
|
|
|
#make sure to write out all the profiles in the file
|
|
my $profile_string = serialize_profile($sd{$profile}, $profile, $serialize_opts);
|
|
print SDPROF $profile_string;
|
|
close(SDPROF);
|
|
|
|
# mark the profile as up-to-date
|
|
delete $changed{$profile};
|
|
$original_sd{$profile} = dclone($sd{$profile});
|
|
}
|
|
|
|
sub getprofileflags {
|
|
my $filename = shift;
|
|
|
|
my $flags = "enforce";
|
|
|
|
if (open(PROFILE, "$filename")) {
|
|
while (<PROFILE>) {
|
|
if (m/^\s*\/\S+\s+flags=\((.+)\)\s+{\s*$/) {
|
|
$flags = $1;
|
|
close(PROFILE);
|
|
return $flags;
|
|
}
|
|
}
|
|
close(PROFILE);
|
|
}
|
|
|
|
return $flags;
|
|
}
|
|
|
|
|
|
sub matchliteral {
|
|
my ($sd_regexp, $literal) = @_;
|
|
|
|
my $p_regexp = convert_regexp($sd_regexp);
|
|
|
|
# check the log entry against our converted regexp...
|
|
my $matches = eval { $literal =~ /^$p_regexp$/; };
|
|
|
|
# doesn't match if we've got a broken regexp
|
|
return undef if $@;
|
|
|
|
return $matches;
|
|
}
|
|
|
|
# test if profile has exec rule for $exec_target
|
|
sub profile_known_exec (\%$$) {
|
|
my ($profile, $type, $exec_target) = @_;
|
|
if ( $type eq "exec" ) {
|
|
my ($cm, $am, @m);
|
|
|
|
# test denies first
|
|
($cm, $am, @m) = rematchfrag($profile, 'deny', $exec_target);
|
|
if ($cm & $AA_MAY_EXEC) {
|
|
return -1;
|
|
}
|
|
($cm, $am, @m) = match_prof_incs_to_path($profile, 'deny', $exec_target);
|
|
if ($cm & $AA_MAY_EXEC) {
|
|
return -1;
|
|
}
|
|
|
|
# now test the generally longer allow lists
|
|
($cm, $am, @m) = rematchfrag($profile, 'allow', $exec_target);
|
|
if ($cm & $AA_MAY_EXEC) {
|
|
return 1;
|
|
}
|
|
|
|
($cm, $am, @m) = match_prof_incs_to_path($profile, 'allow', $exec_target);
|
|
if ($cm & $AA_MAY_EXEC) {
|
|
return 1;
|
|
}
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub profile_known_capability (\%$) {
|
|
my ($profile, $capname) = @_;
|
|
|
|
return -1 if $profile->{deny}{capability}{$capname}{set};
|
|
return 1 if $profile->{allow}{capability}{$capname}{set};
|
|
for my $incname ( keys %{$profile->{include}} ) {
|
|
return -1 if $include{$incname}{$incname}{deny}{capability}{$capname}{set};
|
|
return 1 if $include{$incname}{$incname}{allow}{capability}{$capname}{set};
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub profile_known_network (\%$$) {
|
|
my ($profile, $family, $sock_type) = @_;
|
|
|
|
return -1 if netrules_access_check( $profile->{deny}{netdomain},
|
|
$family, $sock_type);
|
|
return 1 if netrules_access_check( $profile->{allow}{netdomain},
|
|
$family, $sock_type);
|
|
|
|
for my $incname ( keys %{$profile->{include}} ) {
|
|
return -1 if netrules_access_check($include{$incname}{$incname}{deny}{netdomain},
|
|
$family, $sock_type);
|
|
return 1 if netrules_access_check($include{$incname}{$incname}{allow}{netdomain},
|
|
$family, $sock_type);
|
|
}
|
|
|
|
return 0;
|
|
}
|
|
|
|
sub netrules_access_check ($$$) {
|
|
my ($netrules, $family, $sock_type) = @_;
|
|
return 0 if ( not defined $netrules );
|
|
my %netrules = %$netrules;
|
|
my $all_net = defined $netrules{rule}{all};
|
|
my $all_net_family = defined $netrules{rule}{$family} && $netrules{rule}{$family} == 1;
|
|
my $net_family_sock = defined $netrules{rule}{$family} &&
|
|
ref($netrules{rule}{$family}) eq "HASH" &&
|
|
defined $netrules{rule}{$family}{$sock_type};
|
|
|
|
if ( $all_net || $all_net_family || $net_family_sock ) {
|
|
return 1;
|
|
} else {
|
|
return 0;
|
|
}
|
|
}
|
|
|
|
sub reload_base($) {
|
|
my $bin = shift;
|
|
|
|
# don't try to reload profile if AppArmor is not running
|
|
return unless check_for_subdomain();
|
|
|
|
my $filename = getprofilefilename($bin);
|
|
|
|
system("/bin/cat '$filename' | $parser -I$profiledir -r >/dev/null 2>&1");
|
|
}
|
|
|
|
sub reload ($) {
|
|
my $bin = shift;
|
|
|
|
# don't reload the profile if the corresponding executable doesn't exist
|
|
my $fqdbin = findexecutable($bin) or return;
|
|
|
|
return reload_base($fqdbin);
|
|
}
|
|
|
|
sub read_include_from_file {
|
|
my $which = shift;
|
|
|
|
my $data;
|
|
if (open(INCLUDE, "$profiledir/$which")) {
|
|
local $/;
|
|
$data = <INCLUDE>;
|
|
close(INCLUDE);
|
|
}
|
|
|
|
return $data;
|
|
}
|
|
|
|
sub get_include_data {
|
|
my $which = shift;
|
|
|
|
my $data = read_include_from_file($which);
|
|
unless($data) {
|
|
fatal_error "Can't find include file $which: $!";
|
|
}
|
|
return $data;
|
|
}
|
|
|
|
sub loadinclude {
|
|
my $which = shift;
|
|
|
|
# don't bother loading it again if we already have
|
|
return 0 if $include{$which}{$which};
|
|
|
|
my @loadincludes = ($which);
|
|
while (my $incfile = shift @loadincludes) {
|
|
|
|
my $data = get_include_data($incfile);
|
|
my $incdata = parse_profile_data($data, $incfile, 1);
|
|
if ($incdata) {
|
|
attach_profile_data(\%include, $incdata);
|
|
}
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
sub rematchfrag ($$$) {
|
|
my ($frag, $allow, $path) = @_;
|
|
|
|
my $combinedmode = 0;
|
|
my $combinedaudit = 0;
|
|
my @matches;
|
|
|
|
for my $entry (keys %{ $frag->{$allow}{path} }) {
|
|
|
|
my $regexp = convert_regexp($entry);
|
|
|
|
# check the log entry against our converted regexp...
|
|
if ($path =~ /^$regexp$/) {
|
|
|
|
# regexp matches, add it's mode to the list to check against
|
|
$combinedmode |= $frag->{$allow}{path}{$entry}{mode};
|
|
$combinedaudit |= $frag->{$allow}{path}{$entry}{audit};
|
|
push @matches, $entry;
|
|
}
|
|
}
|
|
|
|
return wantarray ? ($combinedmode, $combinedaudit, @matches) : $combinedmode;
|
|
}
|
|
|
|
sub match_include_to_path ($$$) {
|
|
my ($incname, $allow, $path) = @_;
|
|
|
|
my $combinedmode = 0;
|
|
my $combinedaudit = 0;
|
|
my @matches;
|
|
|
|
my @includelist = ( $incname );
|
|
while (my $incfile = shift @includelist) {
|
|
my $ret = eval { loadinclude($incfile); };
|
|
if ($@) { fatal_error $@; }
|
|
my ($cm, $am, @m) = rematchfrag($include{$incfile}{$incfile}, $allow, $path);
|
|
if ($cm) {
|
|
$combinedmode |= $cm;
|
|
$combinedaudit |= $am;
|
|
push @matches, @m;
|
|
}
|
|
|
|
# check if a literal version is in the current include fragment
|
|
if ($include{$incfile}{$incfile}{$allow}{path}{$path}) {
|
|
$combinedmode |= $include{$incfile}{$incfile}{$allow}{path}{$path}{mode};
|
|
$combinedaudit |= $include{$incfile}{$incfile}{$allow}{path}{$path}{audit};
|
|
}
|
|
|
|
# if this fragment includes others, check them too
|
|
if (keys %{ $include{$incfile}{$incfile}{include} }) {
|
|
push @includelist, keys %{ $include{$incfile}{$incfile}{include} };
|
|
}
|
|
}
|
|
|
|
return wantarray ? ($combinedmode, $combinedaudit, @matches) : $combinedmode;
|
|
}
|
|
|
|
sub match_prof_incs_to_path ($$$) {
|
|
my ($frag, $allow, $path) = @_;
|
|
|
|
my $combinedmode = 0;
|
|
my $combinedaudit = 0;
|
|
my @matches;
|
|
|
|
# scan the include fragments for this profile looking for matches
|
|
my @includelist = keys %{ $frag->{include} };
|
|
while (my $include = shift @includelist) {
|
|
my ($cm, $am, @m) = match_include_to_path($include, $allow, $path);
|
|
if ($cm) {
|
|
$combinedmode |= $cm;
|
|
$combinedaudit |= $am;
|
|
push @matches, @m;
|
|
}
|
|
}
|
|
|
|
return wantarray ? ($combinedmode, $combinedaudit, @matches) : $combinedmode;
|
|
}
|
|
|
|
#find includes that match the path to suggest
|
|
sub suggest_incs_for_path {
|
|
my ($incname, $path, $allow) = @_;
|
|
|
|
|
|
my $combinedmode = 0;
|
|
my $combinedaudit = 0;
|
|
my @matches;
|
|
|
|
# scan the include fragments looking for matches
|
|
my @includelist = ($incname);
|
|
while (my $include = shift @includelist) {
|
|
my ($cm, $am, @m) = rematchfrag($include{$include}{$include}, 'allow', $path);
|
|
if ($cm) {
|
|
$combinedmode |= $cm;
|
|
$combinedaudit |= $am;
|
|
push @matches, @m;
|
|
}
|
|
|
|
# check if a literal version is in the current include fragment
|
|
if ($include{$include}{$include}{allow}{path}{$path}) {
|
|
$combinedmode |= $include{$include}{$include}{allow}{path}{$path}{mode};
|
|
$combinedaudit |= $include{$include}{$include}{allow}{path}{$path}{audit};
|
|
}
|
|
|
|
# if this fragment includes others, check them too
|
|
if (keys %{ $include{$include}{$include}{include} }) {
|
|
push @includelist, keys %{ $include{$include}{$include}{include} };
|
|
}
|
|
}
|
|
|
|
if ($combinedmode) {
|
|
return wantarray ? ($combinedmode, $combinedaudit, @matches) : $combinedmode;
|
|
} else {
|
|
return;
|
|
}
|
|
}
|
|
|
|
sub check_qualifiers {
|
|
my $program = shift;
|
|
|
|
if ($cfg->{qualifiers}{$program}) {
|
|
unless($cfg->{qualifiers}{$program} =~ /p/) {
|
|
fatal_error(sprintf(gettext("\%s is currently marked as a program that should not have it's own profile. Usually, programs are marked this way if creating a profile for them is likely to break the rest of the system. If you know what you're doing and are certain you want to create a profile for this program, edit the corresponding entry in the [qualifiers] section in /etc/apparmor/logprof.conf."), $program));
|
|
}
|
|
}
|
|
}
|
|
|
|
sub loadincludes {
|
|
if (opendir(SDDIR, $profiledir)) {
|
|
my @incdirs = grep { (!/^\./) && (-d "$profiledir/$_") } readdir(SDDIR);
|
|
close(SDDIR);
|
|
|
|
while (my $id = shift @incdirs) {
|
|
next if isSkippableDir($id);
|
|
if (opendir(SDDIR, "$profiledir/$id")) {
|
|
for my $path (readdir(SDDIR)) {
|
|
chomp($path);
|
|
next if isSkippableFile($path);
|
|
if (-f "$profiledir/$id/$path") {
|
|
my $file = "$id/$path";
|
|
$file =~ s/$profiledir\///;
|
|
my $ret = eval { loadinclude($file); };
|
|
if ($@) { fatal_error $@; }
|
|
} elsif (-d "$id/$path") {
|
|
push @incdirs, "$id/$path";
|
|
}
|
|
}
|
|
closedir(SDDIR);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
sub globcommon ($) {
|
|
my $path = shift;
|
|
|
|
my @globs;
|
|
|
|
# glob library versions in both foo-5.6.so and baz.so.9.2 form
|
|
if ($path =~ m/[\d\.]+\.so$/ || $path =~ m/\.so\.[\d\.]+$/) {
|
|
my $libpath = $path;
|
|
$libpath =~ s/[\d\.]+\.so$/*.so/;
|
|
$libpath =~ s/\.so\.[\d\.]+$/.so.*/;
|
|
push @globs, $libpath if $libpath ne $path;
|
|
}
|
|
|
|
for my $glob (keys %{$cfg->{globs}}) {
|
|
if ($path =~ /$glob/) {
|
|
my $globbedpath = $path;
|
|
$globbedpath =~ s/$glob/$cfg->{globs}{$glob}/g;
|
|
push @globs, $globbedpath if $globbedpath ne $path;
|
|
}
|
|
}
|
|
|
|
if (wantarray) {
|
|
return sort { length($b) <=> length($a) } uniq(@globs);
|
|
} else {
|
|
my @list = sort { length($b) <=> length($a) } uniq(@globs);
|
|
return $list[$#list];
|
|
}
|
|
}
|
|
|
|
# this is an ugly, nasty function that attempts to see if one regexp
|
|
# is a subset of another regexp
|
|
sub matchregexp ($$) {
|
|
my ($new, $old) = @_;
|
|
|
|
# bail out if old pattern has {foo,bar,baz} stuff in it
|
|
return undef if $old =~ /\{.*(\,.*)*\}/;
|
|
|
|
# are there any regexps at all in the old pattern?
|
|
if ($old =~ /\[.+\]/ or $old =~ /\*/ or $old =~ /\?/) {
|
|
|
|
# convert {foo,baz} to (foo|baz)
|
|
$new =~ y/\{\}\,/\(\)\|/ if $new =~ /\{.*\,.*\}/;
|
|
|
|
# \001 == SD_GLOB_RECURSIVE
|
|
# \002 == SD_GLOB_SIBLING
|
|
|
|
$new =~ s/\*\*/\001/g;
|
|
$new =~ s/\*/\002/g;
|
|
|
|
$old =~ s/\*\*/\001/g;
|
|
$old =~ s/\*/\002/g;
|
|
|
|
# strip common prefix
|
|
my $prefix = commonprefix($new, $old);
|
|
if ($prefix) {
|
|
|
|
# make sure we don't accidentally gobble up a trailing * or **
|
|
$prefix =~ s/(\001|\002)$//;
|
|
$new =~ s/^$prefix//;
|
|
$old =~ s/^$prefix//;
|
|
}
|
|
|
|
# strip common suffix
|
|
my $suffix = commonsuffix($new, $old);
|
|
if ($suffix) {
|
|
|
|
# make sure we don't accidentally gobble up a leading * or **
|
|
$suffix =~ s/^(\001|\002)//;
|
|
$new =~ s/$suffix$//;
|
|
$old =~ s/$suffix$//;
|
|
}
|
|
|
|
# if we boiled the differences down to a ** in the new entry, it matches
|
|
# whatever's in the old entry
|
|
return 1 if $new eq "\001";
|
|
|
|
# if we've paired things down to a * in new, old matches if there are no
|
|
# slashes left in the path
|
|
return 1 if ($new eq "\002" && $old =~ /^[^\/]+$/);
|
|
|
|
# we'll bail out if we have more globs in the old version
|
|
return undef if $old =~ /\001|\002/;
|
|
|
|
# see if we can match * globs in new against literal elements in old
|
|
$new =~ s/\002/[^\/]*/g;
|
|
|
|
return 1 if $old =~ /^$new$/;
|
|
|
|
} else {
|
|
|
|
my $new_regexp = convert_regexp($new);
|
|
|
|
# check the log entry against our converted regexp...
|
|
return 1 if $old =~ /^$new_regexp$/;
|
|
|
|
}
|
|
|
|
return undef;
|
|
}
|
|
|
|
sub combine_name($$) { return ($_[0] eq $_[1]) ? $_[0] : "$_[0]^$_[1]"; }
|
|
sub split_name ($) { my ($p, $h) = split(/\^/, $_[0]); $h ||= $p; ($p, $h); }
|
|
|
|
##########################
|
|
#
|
|
# prompt_user($headers, $functions, $default, $options, $selected);
|
|
#
|
|
# $headers:
|
|
# a required arrayref made up of "key, value" pairs in the order you'd
|
|
# like them displayed to user
|
|
#
|
|
# $functions:
|
|
# a required arrayref of the different options to display at the bottom
|
|
# of the prompt like "(A)llow", "(D)eny", and "Ba(c)on". the character
|
|
# contained by ( and ) will be used as the key to select the specified
|
|
# option.
|
|
#
|
|
# $default:
|
|
# a required character which is the default "key" to enter when they
|
|
# just hit enter
|
|
#
|
|
# $options:
|
|
# an optional arrayref of the choices like the glob suggestions to be
|
|
# presented to the user
|
|
#
|
|
# $selected:
|
|
# specifies which option is currently selected
|
|
#
|
|
# when prompt_user() is called without an $options list, it returns a
|
|
# single value which is the key for the specified "function".
|
|
#
|
|
# when prompt_user() is called with an $options list, it returns an array
|
|
# of two elements, the key for the specified function as well as which
|
|
# option was currently selected
|
|
#######################################################################
|
|
|
|
sub Text_PromptUser ($) {
|
|
my $question = shift;
|
|
|
|
my $title = $question->{title};
|
|
my $explanation = $question->{explanation};
|
|
|
|
my @headers = (@{ $question->{headers} });
|
|
my @functions = (@{ $question->{functions} });
|
|
|
|
my $default = $question->{default};
|
|
my $options = $question->{options};
|
|
my $selected = $question->{selected} || 0;
|
|
|
|
my $helptext = $question->{helptext};
|
|
|
|
push @functions, "CMD_HELP" if $helptext;
|
|
|
|
my %keys;
|
|
my @menu_items;
|
|
for my $cmd (@functions) {
|
|
|
|
# make sure we know about this particular command
|
|
my $cmdmsg = "PromptUser: " . gettext("Unknown command") . " $cmd";
|
|
fatal_error $cmdmsg unless $CMDS{$cmd};
|
|
|
|
# grab the localized text to use for the menu for this command
|
|
my $menutext = gettext($CMDS{$cmd});
|
|
|
|
# figure out what the hotkey for this menu item is
|
|
my $menumsg = "PromptUser: " .
|
|
gettext("Invalid hotkey in") .
|
|
" '$menutext'";
|
|
$menutext =~ /\((\S)\)/ or fatal_error $menumsg;
|
|
|
|
# we want case insensitive comparisons so we'll force things to
|
|
# lowercase
|
|
my $key = lc($1);
|
|
|
|
# check if we're already using this hotkey for this prompt
|
|
my $hotkeymsg = "PromptUser: " .
|
|
gettext("Duplicate hotkey for") .
|
|
" $cmd: $menutext";
|
|
fatal_error $hotkeymsg if $keys{$key};
|
|
|
|
# keep track of which command they're picking if they hit this hotkey
|
|
$keys{$key} = $cmd;
|
|
|
|
if ($default && $default eq $cmd) {
|
|
$menutext = "[$menutext]";
|
|
}
|
|
|
|
push @menu_items, $menutext;
|
|
}
|
|
|
|
# figure out the key for the default option
|
|
my $default_key;
|
|
if ($default && $CMDS{$default}) {
|
|
my $defaulttext = gettext($CMDS{$default});
|
|
|
|
# figure out what the hotkey for this menu item is
|
|
my $defmsg = "PromptUser: " .
|
|
gettext("Invalid hotkey in default item") .
|
|
" '$defaulttext'";
|
|
$defaulttext =~ /\((\S)\)/ or fatal_error $defmsg;
|
|
|
|
# we want case insensitive comparisons so we'll force things to
|
|
# lowercase
|
|
$default_key = lc($1);
|
|
|
|
my $defkeymsg = "PromptUser: " .
|
|
gettext("Invalid default") .
|
|
" $default";
|
|
fatal_error $defkeymsg unless $keys{$default_key};
|
|
}
|
|
|
|
my $widest = 0;
|
|
my @poo = @headers;
|
|
while (my $header = shift @poo) {
|
|
my $value = shift @poo;
|
|
$widest = length($header) if length($header) > $widest;
|
|
}
|
|
$widest++;
|
|
|
|
my $format = '%-' . $widest . "s \%s\n";
|
|
|
|
my $function_regexp = '^(';
|
|
$function_regexp .= join("|", keys %keys);
|
|
$function_regexp .= '|\d' if $options;
|
|
$function_regexp .= ')$';
|
|
|
|
my $ans = "XXXINVALIDXXX";
|
|
while ($ans !~ /$function_regexp/i) {
|
|
# build up the prompt...
|
|
my $prompt = "\n";
|
|
|
|
$prompt .= "= $title =\n\n" if $title;
|
|
|
|
if (@headers) {
|
|
my @poo = @headers;
|
|
while (my $header = shift @poo) {
|
|
my $value = shift @poo;
|
|
$prompt .= sprintf($format, "$header:", $value);
|
|
}
|
|
$prompt .= "\n";
|
|
}
|
|
|
|
if ($explanation) {
|
|
$prompt .= "$explanation\n\n";
|
|
}
|
|
|
|
if ($options) {
|
|
for (my $i = 0; $options->[$i]; $i++) {
|
|
my $f = ($selected == $i) ? ' [%d - %s]' : ' %d - %s ';
|
|
$prompt .= sprintf("$f\n", $i + 1, $options->[$i]);
|
|
}
|
|
$prompt .= "\n";
|
|
}
|
|
$prompt .= join(" / ", @menu_items);
|
|
print "$prompt\n";
|
|
|
|
# get their input...
|
|
$ans = lc(getkey());
|
|
|
|
if ($ans) {
|
|
# handle escape sequences so you can up/down in the list
|
|
if ($ans eq "up") {
|
|
|
|
if ($options && ($selected > 0)) {
|
|
$selected--;
|
|
}
|
|
$ans = "XXXINVALIDXXX";
|
|
|
|
} elsif ($ans eq "down") {
|
|
|
|
if ($options && ($selected < (scalar(@$options) - 1))) {
|
|
$selected++;
|
|
}
|
|
$ans = "XXXINVALIDXXX";
|
|
|
|
} elsif ($keys{$ans} && $keys{$ans} eq "CMD_HELP") {
|
|
|
|
print "\n$helptext\n";
|
|
$ans = "XXXINVALIDXXX";
|
|
|
|
} elsif (ord($ans) == 10) {
|
|
|
|
# pick the default if they hit return...
|
|
$ans = $default_key;
|
|
|
|
} elsif ($options && ($ans =~ /^\d$/)) {
|
|
|
|
# handle option poo
|
|
if ($ans > 0 && $ans <= scalar(@$options)) {
|
|
$selected = $ans - 1;
|
|
}
|
|
$ans = "XXXINVALIDXXX";
|
|
}
|
|
}
|
|
|
|
if ($keys{$ans} && $keys{$ans} eq "CMD_HELP") {
|
|
print "\n$helptext\n";
|
|
$ans = "again";
|
|
}
|
|
}
|
|
|
|
# pull our command back from our hotkey map
|
|
$ans = $keys{$ans} if $keys{$ans};
|
|
return ($ans, $selected);
|
|
|
|
}
|
|
|
|
# Parse event record into key-value pairs
|
|
sub parse_event($) {
|
|
my %ev = ();
|
|
my $msg = shift;
|
|
chomp($msg);
|
|
my $event = LibAppArmor::parse_record($msg);
|
|
my ($rmask, $dmask);
|
|
|
|
$DEBUGGING && debug("parse_event: $msg");
|
|
|
|
$ev{'resource'} = LibAppArmor::aa_log_record::swig_info_get($event);
|
|
$ev{'active_hat'} = LibAppArmor::aa_log_record::swig_active_hat_get($event);
|
|
$ev{'sdmode'} = LibAppArmor::aa_log_record::swig_event_get($event);
|
|
$ev{'time'} = LibAppArmor::aa_log_record::swig_epoch_get($event);
|
|
$ev{'operation'} = LibAppArmor::aa_log_record::swig_operation_get($event);
|
|
$ev{'profile'} = LibAppArmor::aa_log_record::swig_profile_get($event);
|
|
$ev{'name'} = LibAppArmor::aa_log_record::swig_name_get($event);
|
|
$ev{'name2'} = LibAppArmor::aa_log_record::swig_name2_get($event);
|
|
$ev{'attr'} = LibAppArmor::aa_log_record::swig_attribute_get($event);
|
|
$ev{'parent'} = LibAppArmor::aa_log_record::swig_parent_get($event);
|
|
$ev{'pid'} = LibAppArmor::aa_log_record::swig_pid_get($event);
|
|
$ev{'task'} = LibAppArmor::aa_log_record::swig_task_get($event);
|
|
$ev{'info'} = LibAppArmor::aa_log_record::swig_info_get($event);
|
|
$dmask = LibAppArmor::aa_log_record::swig_denied_mask_get($event);
|
|
$rmask = LibAppArmor::aa_log_record::swig_requested_mask_get($event);
|
|
$ev{'magic_token'} =
|
|
LibAppArmor::aa_log_record::swig_magic_token_get($event);
|
|
|
|
# NetDomain
|
|
if ( $ev{'operation'} && $ev{'operation'} =~ /socket/ ) {
|
|
$ev{'family'} =
|
|
LibAppArmor::aa_log_record::swig_net_family_get($event);
|
|
$ev{'protocol'} =
|
|
LibAppArmor::aa_log_record::swig_net_protocol_get($event);
|
|
$ev{'sock_type'} =
|
|
LibAppArmor::aa_log_record::swig_net_sock_type_get($event);
|
|
}
|
|
|
|
LibAppArmor::free_record($event);
|
|
|
|
#map new c and d to w as logprof doesn't support them yet
|
|
$rmask =~ s/c/w/g;
|
|
$rmask =~ s/d/w/g;
|
|
$dmask =~ s/c/w/g;
|
|
$dmask =~ s/d/w/g;
|
|
|
|
if ($rmask && !validate_log_mode(hide_log_mode($rmask))) {
|
|
fatal_error(sprintf(gettext('Log contains unknown mode %s.'),
|
|
$rmask));
|
|
}
|
|
|
|
if ($dmask && !validate_log_mode(hide_log_mode($dmask))) {
|
|
fatal_error(sprintf(gettext('Log contains unknown mode %s.'),
|
|
$dmask));
|
|
}
|
|
#print "str_to_mode deny $dmask = " . str_to_mode($dmask) . "\n" if ($dmask);
|
|
#print "str_to_mode req $rmask = " . str_to_mode($rmask) . "\n" if ($rmask);
|
|
|
|
my ($mask, $name);
|
|
($mask, $name) = log_str_to_mode($ev{profile}, $dmask, $ev{name2});
|
|
$ev{'denied_mask'} = $mask;
|
|
$ev{name2} = $name;
|
|
|
|
($mask, $name) = log_str_to_mode($ev{profile}, $rmask, $ev{name2});
|
|
$ev{'request_mask'} = $mask;
|
|
$ev{name2} = $name;
|
|
|
|
if ( ! $ev{'time'} ) { $ev{'time'} = time; }
|
|
|
|
# remove null responses
|
|
for (keys(%ev)) {
|
|
if ( ! $ev{$_} || $ev{$_} !~ /[\/\w]+/) { delete($ev{$_}); }
|
|
}
|
|
|
|
if ( $ev{'sdmode'} ) {
|
|
#0 = invalid, 1 = error, 2 = AUDIT, 3 = ALLOW/PERMIT,
|
|
#4 = DENIED/REJECTED, 5 = HINT, 6 = STATUS/config change
|
|
if ( $ev{'sdmode'} == 0 ) { $ev{'sdmode'} = "UNKNOWN"; }
|
|
elsif ( $ev{'sdmode'} == 1 ) { $ev{'sdmode'} = "ERROR"; }
|
|
elsif ( $ev{'sdmode'} == 2 ) { $ev{'sdmode'} = "AUDITING"; }
|
|
elsif ( $ev{'sdmode'} == 3 ) { $ev{'sdmode'} = "PERMITTING"; }
|
|
elsif ( $ev{'sdmode'} == 4 ) { $ev{'sdmode'} = "REJECTING"; }
|
|
elsif ( $ev{'sdmode'} == 5 ) { $ev{'sdmode'} = "HINT"; }
|
|
elsif ( $ev{'sdmode'} == 6 ) { $ev{'sdmode'} = "STATUS"; }
|
|
else { delete($ev{'sdmode'}); }
|
|
}
|
|
if ( $ev{sdmode} ) {
|
|
$DEBUGGING && debug( Data::Dumper->Dump([%ev], [qw(*event)]));
|
|
return \%ev;
|
|
} else {
|
|
return( undef );
|
|
}
|
|
}
|
|
|
|
###############################################################################
|
|
# required initialization
|
|
|
|
$cfg = read_config("logprof.conf");
|
|
if ((not defined $cfg->{settings}{default_owner_prompt})) {
|
|
$cfg->{settings}{default_owner_prompt} = 0;
|
|
}
|
|
|
|
$profiledir = find_first_dir($cfg->{settings}{profiledir}) || "/etc/apparmor.d";
|
|
unless (-d $profiledir) { fatal_error "Can't find AppArmor profiles."; }
|
|
|
|
$extraprofiledir = find_first_dir($cfg->{settings}{inactive_profiledir}) ||
|
|
"/etc/apparmor/profiles/extras/";
|
|
|
|
$parser = find_first_file($cfg->{settings}{parser}) || "/sbin/apparmor_parser";
|
|
unless (-x $parser) { fatal_error "Can't find apparmor_parser."; }
|
|
|
|
$filename = find_first_file($cfg->{settings}{logfiles}) || "/var/log/messages";
|
|
unless (-f $filename) { fatal_error "Can't find system log."; }
|
|
|
|
$ldd = find_first_file($cfg->{settings}{ldd}) || "/usr/bin/ldd";
|
|
unless (-x $ldd) { fatal_error "Can't find ldd."; }
|
|
|
|
$logger = find_first_file($cfg->{settings}{logger}) || "/bin/logger";
|
|
unless (-x $logger) { fatal_error "Can't find logger."; }
|
|
|
|
1;
|
|
|