apparmor/utils/SubDomain.pm

# $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 warnings;
use strict;

use Carp;
use Cwd qw(cwd realpath);
use File::Basename;
use Data::Dumper;

use Locale::gettext;
use POSIX;

use Immunix::Severity;

require Exporter;
our @ISA    = qw(Exporter);
our @EXPORT = qw(%sd $filename $profiledir $parser %qualifiers %include %helpers $UI_Mode which getprofilefilename getprofileflags setprofileflags complain enforce autodep reload UI_GetString UI_GetFile UI_YesNo UI_Important UI_Info getkey do_logprof_pass readconfig loadincludes check_for_subdomain UI_PromptUser $running_under_genprof GetDataFromYast SendDataToYast setup_yast shutdown_yast readprofile readprofiles writeprofile get_full_path fatal_error);

no warnings 'all';

our $confdir = "/etc/apparmor";

our $running_under_genprof = 0;
our $finishing = 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, "");
textdomain("apparmor-utils");

# where do we get our log messages from?
our $filename;
if(-f "/var/log/audit/audit.log") {
  $filename = "/var/log/audit/audit.log";
} elsif(-f "/etc/slackware-version") {
  $filename = "/var/log/syslog";
} else {
  $filename = "/var/log/messages";
}

our $profiledir = "/etc/apparmor.d";

# we keep track of the included profile fragments with %include
my %include;

my %existing_profiles;

our $ldd    = "/usr/bin/ldd";
our $parser = "/sbin/subdomain_parser";
$parser = "/sbin/apparmor_parser" if -f "/sbin/apparmor_parser";

our $seenevents = 0;

# behaviour tweaking
our %qualifiers;
our %required_hats;
our %defaulthat;
our %globmap;

# 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

my %seen;
my %profilechanges;
my %prelog;
my %log;
my %changed;
my %skip;
our %helpers;                  # we want to preserve this one between passes

my %variables;                 # variables in config files

### THESE VARIABLES ARE USED WITHIN LOGPROF

sub debug ($) {
  my $message = shift;

  print DEBUG "$message\n" if $DEBUGGING;
}

BEGIN {
  use POSIX qw(:termios_h);

  my ($term, $oterm, $echo, $noecho, $fd_stdin);

  $fd_stdin = fileno(STDIN);

  $term     = POSIX::Termios->new();
  $term->getattr($fd_stdin);
  $oterm     = $term->getlflag();

  $echo     = ECHO | ECHOK | ICANON;
  $noecho   = $oterm & ~$echo;

  sub cbreak {
    $term->setlflag($noecho);
    $term->setcc(VTIME, 1);
    $term->setattr($fd_stdin, TCSANOW);
  }

  sub cooked {
    $term->setlflag($oterm);
    $term->setcc(VTIME, 0);
    $term->setattr($fd_stdin, TCSANOW);
  }

  sub getkey {
    my $key = '';
    cbreak();
    sysread(STDIN, $key, 1);
    cooked();
    return $key;
  }

  # set things up to log extra info if they want...
  if($ENV{LOGPROF_DEBUG}) {
    $DEBUGGING = 1;
    open(DEBUG, ">/tmp/logprof_debug_$$.log");
    my $oldfd = select(DEBUG);
    $| = 1;
    select($oldfd);
  } else {
    $DEBUGGING = 0;
  }
}

END {
  # reset the terminal state
  cooked();

  $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 $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 Immunix::Ycp; };
    unless($@) {
      import Immunix::Ycp;

      no warnings 'all';

      $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.";
      }

      # 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;

  # escape . characters
  $regexp =~ s/(?<!\\)\./SDPROF_INTERNAL_DOT/g;

  # convert ** globs to match anything
  $regexp =~ s/(?<!\\)\*\*/.SDPROF_INTERNAL_GLOB/g;

  # convert * globs to match anything at current path level
  $regexp =~ s/(?<!\\)\*/[^\/]SDPROF_INTERNAL_GLOB/g;

  # convert ? globs to match a single character at current path level
  $regexp =~ s/(?<!\\)\?/[^\/]/g;

  # convert {foo,baz} to (foo|baz)
  $regexp =~ y/\{\}\,/\(\)\|/ if $regexp =~ /\{.*\,.*\}/;

  # twiddle the escaped * chars back
  $regexp =~ s/SDPROF_INTERNAL_GLOB/\*/g;

  # twiddle the escaped . chars back
  $regexp =~ s/SDPROF_INTERNAL_DOT/\\./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 =~ /^\//) {
        $path = $link;             # if it's an absolute link, just replace it
      } else {
        $path = $dir . "/$link";   # if it's relative, let abs_path handle it
      }
    }
  }

  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 complain ($) {
  my $bin = shift;
  my $fqdbin = findexecutable($bin) or fatal_error(sprintf(gettext('Can\'t find %s.'), $bin));

  # skip directories
  return unless -f $fqdbin;

  UI_Info(sprintf(gettext('Setting %s to complain mode.'), $fqdbin));

  my $filename = getprofilefilename($fqdbin);
  setprofileflags($filename, "complain");
}

sub enforce ($) {
  my $bin = shift;

  my $fqdbin = findexecutable($bin) or fatal_error(sprintf(gettext('Can\'t find %s.'), $bin));

  # skip directories
  return unless -f $fqdbin;

  UI_Info(sprintf(gettext('Setting %s to enforce mode.'), $fqdbin));

  my $filename = getprofilefilename($fqdbin);
  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/;

      next if $line =~ /linux-(gate|vdso(32|64)).so/; # avoid new kernel 2.6 poo

      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 = matchincludes($profile, $library);

    # if we found any matching entries, do the modes match?
    next if $combinedmode;

    $library = globcommon($library);
    chomp $library;
    next unless $library;

    if($library =~ /\/lib\/ld-.+/) {
      $profile->{path}->{$library} = "mpx";
    } else {
      $profile->{path}->{$library} = "mr";
    }
  }

  return $profile;
}

sub autodep ($) {
  my $bin = shift;

  # 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.
  my $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;

  my $profile = { flags   => "complain",
                  include => { "abstractions/base" => 1   },
                  path    => { $fqdbin             => "mr" } };

  # if the executable exists on this system, pull in extra dependencies
  if(-f $fqdbin) {
    my $hashbang = head($fqdbin);
    if($hashbang =~ /^#!\s*(\S+)/) {
      my $interpreter = get_full_path($1);
      $profile->{path}->{$interpreter} = "ix";
      if($interpreter =~ /perl/) {
        $profile->{include}->{"abstractions/perl"} = 1;
      } elsif ($interpreter =~ m/\/bin\/(bash|sh)/) {
        $profile->{include}->{"abstractions/bash"} = 1;
      }
      $profile = handle_binfmt($profile, $interpreter);
    } else {
      $profile = handle_binfmt($profile, $fqdbin);
    }
  }

  # stick the profile into our data structure.
  $sd{$fqdbin}{$fqdbin} = $profile;

  # instantiate the required infrastructure hats for this changehat application
  for my $hatglob (keys %required_hats) {
    if($fqdbin =~ /$hatglob/) {
      for my $hat (split(/\s+/, $required_hats{$hatglob})) {
        $sd{$fqdbin}{$hat} = { flags => "complain" };
      }
    }
  }

  if (-f "$profiledir/tunables/global") {
    my $file = getprofilefilename($fqdbin);
  
    unless (exists $variables{$file}) {
     $variables{$file} = { };
    }                            
    $variables{$file}{"#tunables/global"} = 1; # sorry
  }

  # write out the profile...
  writeprofile($fqdbin);
}

sub getprofilefilename ($) {
  my $profile = shift;

  my $filename = $profile;
  $filename =~ s/\///;     # strip leading /
  $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*("??\/.+?"??)\s+(flags=\(.+\)\s+)*\{\s*$/) {
          my ($binary, $flags) = ($1, $2);

          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;
}

##########################################################################
# 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 {
    Immunix::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
    $yes =~ /\((\S)\)/ or fatal_error "PromptUser: Invalid hotkey for '$yes'";
    my $yeskey = lc($1);
    $no =~ /\((\S)\)/ or fatal_error "PromptUser: Invalid hotkey for '$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
    $yes =~ /\((\S)\)/ or fatal_error "PromptUser: Invalid hotkey for '$yes'";
    my $yeskey = lc($1);
    $no =~ /\((\S)\)/ or fatal_error "PromptUser: Invalid hotkey for '$no'";
    my $nokey = lc($1);
    $cancel =~ /\((\S)\)/ or fatal_error "PromptUser: Invalid hotkey for '$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;
}

my %CMDS = (
  CMD_ALLOW      => "(A)llow",
  CMD_DENY       => "(D)eny",
  CMD_ABORT      => "Abo(r)t",
  CMD_FINISHED   => "(F)inish",
  CMD_INHERIT    => "(I)nherit",
  CMD_PROFILE    => "(P)rofile",
  CMD_PROFILE_CLEAN => "(P)rofile Clean Exec",
  CMD_UNCONFINED => "(U)nconfined",
  CMD_UNCONFINED_CLEAN => "(U)nconfined Clean Exec",
  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",
);

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};
  }

  return ($cmd, $arg);
}

##########################################################################
# 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) = Immunix::Ycp::ParseCommand ($_);

    if($ycommand && $ycommand eq "Read") {

      if($DEBUGGING) {
        my $debugmsg = Data::Dumper->Dump([$data], [qw(*data)]);
        debug "SendDataToYast: Sending--\n$debugmsg";
      }

      Immunix::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) = Immunix::Ycp::ParseCommand ($_);

    if($DEBUGGING) {
      my $debugmsg = Data::Dumper->Dump([$yarg], [qw(*data)]);
      debug "GetDataFromYast: Received--\n$debugmsg";
    }

    if($ycmd && $ycmd eq "Write") {

      Immunix::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";
}

##########################################################################
# 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;
        }

        $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;
        }

        # figure out what our default hat for this application is.
        my $defaulthat;
        for my $hatglob (keys %defaulthat) {
          $defaulthat = $defaulthat{$hatglob} if $profile =~ /$hatglob/;
        }

        # keep track of previous answers for this run...
        my $context = $profile;
        $context .= " -> ^$uhat";
        my $ans = $transitions{$context} || "";

        unless($ans) {
          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";
          push @{$q->{functions}}, "CMD_ABORT";
          push @{$q->{functions}}, "CMD_FINISHED";

          $q->{default} = ($sdmode eq "PERMITTING") ? "CMD_ADDHAT" : "CMD_DENY";

          $seenevents++;

          my $arg;
          ($ans, $arg) = UI_PromptUser($q);

          $transitions{$context} = $ans;
        }

        # ugh, there's a bug here.  if they pick "abort" or "finish" and then
        # say "well, no, I didn't really mean that", we need to ask the
        # question again, but we currently go on to the next one.  oops.
        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($ans eq "CMD_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;
          }
        } elsif($ans eq "CMD_FINISHED") {
          my $ans = UI_YesNo(gettext("Are you sure you want to save the current set of profile changes and exit?"), "n");
          if($ans eq "y") {
            UI_Info(gettext("Saving all changes."));
            $finishing = 1;
            # XXX - BUGBUG - this is REALLY nasty, but i'm in a hurry...
            goto SAVE_PROFILES;
          }
        }

      } 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) = @entry;

        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 =~ s/x//g) {
          if(-d $exec_target) {
            $mode .= "ix";
          } else {
            $do_execute = 1;
          }
        }

        if($mode eq "link") {
          $mode = "l";
          if($detail =~ m/^from (.+) to (.+)$/) {
            my ($path, $target) = ($1, $2);

            my $frommode = "lr";
            if(defined $prelog{$sdmode}{$profile}{$hat}{path}{$path}) {
              $frommode .= $prelog{$sdmode}{$profile}{$hat}{path}{$path};
            }
            $frommode = collapsemode($frommode);
            $prelog{$sdmode}{$profile}{$hat}{path}{$path} = $frommode;

            my $tomode = "lr";
            if(defined $prelog{$sdmode}{$profile}{$hat}{path}{$target}) {
              $tomode .= $prelog{$sdmode}{$profile}{$hat}{path}{$target};
            }
            $tomode = collapsemode($tomode);
            $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};
            $mode = collapsemode($mode);
          }

          $prelog{$sdmode}{$profile}{$hat}{path}{$path} = $mode;
#          print "$pid $profile $hat $prog $sdmode $mode $path\n";
        }

        if($do_execute) {

          my $context = $profile;
          $context .= "^$hat" if $profile ne $hat;
          $context .= " -> $exec_target";
          my $ans = $transitions{$context} || "";

          my ($combinedmode, $cm, @m);

          # does path match any regexps in original profile?
          ($cm, @m) = rematchfrag($sd{$profile}{$hat}, $exec_target);
          $combinedmode .= $cm if $cm;

          # does path match anything pulled in by includes in original profile?
          ($cm, @m) = matchincludes($sd{$profile}{$hat}, $exec_target);
          $combinedmode .= $cm if $cm;

          my $exec_mode;
          if(contains($combinedmode, "ix")) {
            $ans = "CMD_INHERIT";
            $exec_mode = "ixr";
          } elsif(contains($combinedmode, "px")) {
            $ans = "CMD_PROFILE";
            $exec_mode = "px";
          } elsif(contains($combinedmode, "ux")) {
            $ans = "CMD_UNCONFINED";
            $exec_mode = "ux";
          } elsif(contains($combinedmode, "Px")) {
            $ans = "CMD_PROFILE_CLEAN";
            $exec_mode = "Px";
          } elsif(contains($combinedmode, "Ux")) {
            $ans = "CMD_UNCONFINED_CLEAN";
            $exec_mode = "Ux";
          } else {
            my $options = $qualifiers{$exec_target} || "ipu";

            # force "ix" as the only option when the profiled program
            # executes itself
            $options = "i" if $exec_target eq $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_PROFILE";
            } elsif($options =~ /i/) {
              $default = "CMD_INHERIT";
            } 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;
            }
            push @{$q->{headers}}, gettext("Execute"), $exec_target;
            push @{$q->{headers}}, gettext("Severity"), $severity;

            $q->{functions} = [ ];

            my $prompt = "\n$context\n";
            push @{$q->{functions}}, "CMD_INHERIT"    if $options =~ /i/;
            push @{$q->{functions}}, "CMD_PROFILE"    if $options =~ /p/;
            push @{$q->{functions}}, "CMD_UNCONFINED" if $options =~ /u/;
            push @{$q->{functions}}, "CMD_DENY";
            push @{$q->{functions}}, "CMD_ABORT";
            push @{$q->{functions}}, "CMD_FINISHED";

            $q->{default} = $default;

            $options = join("|", split(//, $options));

            $seenevents++;

            my $arg;
            while($ans !~ m/^CMD_(INHERIT|PROFILE|PROFILE_CLEAN|UNCONFINED|UNCONFINED_CLEAN|DENY)$/) {
              ($ans, $arg) = UI_PromptUser($q);

              # check for Abort or Finish
              if($ans eq "CMD_ABORT") {
                my $ans = UI_YesNo(gettext("Are you sure you want to abandon this set of profile changes and exit?"), "n");
                $DEBUGGING && debug "back from abort yesno";
                if($ans eq "y") {
                  UI_Info(gettext("Abandoning all changes."));
                  shutdown_yast();
                  exit 0;
                }
              } elsif($ans eq "CMD_FINISHED") {
                my $ans = UI_YesNo(gettext("Are you sure you want to save the current set of profile changes and exit?"), "n");
                if($ans eq "y") {
                  UI_Info(gettext("Saving all changes."));
                  $finishing = 1;
                  # XXX - BUGBUG - this is REALLY nasty, but i'm in a hurry...
                  goto SAVE_PROFILES;
                }
              } elsif($ans eq "CMD_PROFILE") {
                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);
                if($ynans eq "y") {
                  $ans = "CMD_PROFILE_CLEAN";
                }
              } elsif($ans eq "CMD_UNCONFINED") {
                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") {
                    $ans = "CMD_UNCONFINED_CLEAN";
                  }
                } else {
                  $ans = "INVALID";
                }
              }
            }
            $transitions{$context} = $ans;


            # if we're inheriting, things'll bitch unless we have r
            if($ans eq "CMD_INHERIT") {
              $exec_mode = "ixr";
            } elsif($ans eq "CMD_PROFILE") {
              $exec_mode = "px";
            } elsif($ans eq "CMD_UNCONFINED") {
              $exec_mode = "ux";
            } elsif($ans eq "CMD_PROFILE_CLEAN") {
              $exec_mode = "Px";
            } elsif($ans eq "CMD_UNCONFINED_CLEAN") {
              $exec_mode = "Ux";
            } else {
              # skip all remaining events if they say to deny the exec
              return if $domainchange eq "change";
            }

            unless($ans eq "CMD_DENY") {
              if(defined $prelog{PERMITTING}{$profile}{$hat}{path}{$exec_target}) {
                $exec_mode .= $prelog{PERMITTING}{$profile}{$hat}{path}{$exec_target};
                $exec_mode = collapsemode($exec_mode);
              }
              $prelog{PERMITTING}{$profile}{$hat}{path}{$exec_target} = $exec_mode;
              $log{PERMITTING}{$profile} = { };
              $sd{$profile}{$hat}{path}{$exec_target} = $exec_mode;
              $changed{$profile} = 1; # mark this profile as changed
              if($ans eq "CMD_INHERIT") {
                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} = "ix";
                  if($interpreter =~ /perl/) {
                    $sd{$profile}{$hat}{include}{"abstractions/perl"} = 1;
                  } elsif ($interpreter =~ m/\/bin\/(bash|sh)/) {
                    $sd{$profile}{$hat}{include}{"abstractions/bash"} = 1;
                  }
                }
              } elsif($ans =~ /^CMD_PROFILE/) {
                # if they want to use px, make sure a profile exists for the target.
                unless(-e getprofilefilename($exec_target)) {
                  $helpers{$exec_target} = "enforce";
                  autodep($exec_target);
                  reload($exec_target);
                }
              }
            }
          }

          #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_INHERIT") {
            $profilechanges{$pid} = $profile;
          } elsif($ans =~ /^CMD_PROFILE/) {
            if($sdmode eq "PERMITTING") {
              if($domainchange eq "change") {
                $profile = $exec_target;
                $hat     = $exec_target;
                $profilechanges{$pid} = $profile;
              }
            }
          } elsif ($ans =~ /^CMD_UNCONFINED/) {
            $profilechanges{$pid} = "unconstrained";
            return if $domainchange eq "change";
          }

        }
      }
    }
  }
}

sub do_logprof_pass {
  my $logmark = shift || "";

  # zero out the state variables for this pass...
  %t              = ( );
  %transitions    = ( );
  %seen           = ( );
  %sd             = ( );
  %profilechanges = ( );
  %prelog         = ( );
  %log            = ( );
  %changed        = ( );
  %skip           = ( );
  %variables      = ( );

  UI_Info(sprintf(gettext('Reading log entries from %s.'), $filename));
  UI_Info(sprintf(gettext('Updating subdomain profiles in %s.'), $profiledir));

  readprofiles();

  my $seenmark = $logmark ? 0 : 1;

  $sevdb = new Immunix::Severity("$confdir/severity.db", gettext("unknown"));

  my @log;
  my %pid;

  sub add_to_tree ($@) {
    my ($pid, $type, @event) = @_;

    unless(exists $pid{$pid}) {
      my $arrayref = [ ];
      push @log, $arrayref;
      $pid{$pid} = $arrayref;
    }

    push @{$pid{$pid}}, [ $type, $pid, @event ];
  }

  my $stuffed = undef;
  my $last;
  # 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(($_ = $stuffed) || ($_ = <LOG>)) {
    chomp;

    $stuffed = undef;

    $seenmark = 1 if /$logmark/;

    next unless $seenmark;

    # all we care about is subdomain messages
    next unless (/^.* audit\(/ || /type=APPARMOR msg=audit\([\d\.\:]+\):/ || /SubDomain/);
    # workaround for syslog uglyness.
    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
      next if (($profile ne 'null-complain-profile') && (! profile_exists($profile)));

      add_to_tree($pid, "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);

      next 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
      next if (($profile ne 'null-complain-profile') && (! profile_exists($profile)));

      add_to_tree($pid, "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);

      my $domainchange = "nochange";
      if($mode =~ /x/) {
        # we need to try to check if we're doing a domain transition this time
        if($sdmode eq "PERMITTING") {
          do {
          $stuffed = <LOG>;
          } until $stuffed =~ /AppArmor|audit/;
          if($stuffed =~ m/changing_profile/) {
            $domainchange = "change";
            $stuffed = undef;
          }
        }
      } else {
        # we want to ignore duplicates for things other than executes...
        next 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))) {
        $stuffed = undef;
        next;
      }

      # currently no way to stick pipe mediation in a profile, ignore any messages like this
      next 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
      next 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, "exec", $profile, $hat, $prog, $sdmode, $mode, $detail);
      } else {
        add_to_tree($pid, "path", $profile, $hat, $prog, $sdmode, $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...
      next 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
      next if (($profile ne 'null-complain-profile') && (! profile_exists($profile)));

      add_to_tree($pid, "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...
      next 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
      next 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, "path", $profile, $hat, $prog, $sdmode, $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...
      next 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
      next 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
      next if $path eq "/etc/krb5.conf";

      add_to_tree($pid, "path", $profile, $hat, $prog, $sdmode, "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);

      next 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
      next if (($profile ne 'null-complain-profile') && (! profile_exists($profile)));

      add_to_tree($pid, "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
      next 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: $_";
    }
  }
  close(LOG);

  for my $root (@log) {
    handlechildren(undef, undef, $root);
  }

  for my $pid (sort { $a <=> $b } keys %profilechanges) {
    setprocess($pid, $profilechanges{$pid});
  }

  collapselog();

  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}}) {

      $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 $sd{$profile}{$hat}{capability}{$capability};

          my $severity = $sevdb->rank(uc("cap_$capability"));

          my $q = { };
          $q->{headers} = [ ];
          push @{$q->{headers}}, gettext("Profile"), combine_name($profile, $hat);
          push @{$q->{headers}}, gettext("Capability"), $capability;
          push @{$q->{headers}}, gettext("Severity"), $severity;

          $q->{functions} = [ "CMD_ALLOW", "CMD_DENY", "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 ($ans, $arg) = UI_PromptUser($q);

          if($ans eq "CMD_ALLOW") {
            # they picked (a)llow, so...

            # stick the capability into the profile
            $sd{$profile}{$hat}{capability}{$capability} = 1;

            # mark this profile as changed
            $changed{$profile} = 1;

            # give a little feedback to the user
            UI_Info(sprintf(gettext('Adding capability %s to profile.'), $capability));
          } elsif($ans eq "CMD_DENY") {
            UI_Info(sprintf(gettext('Denying capability %s to profile.'), $capability));
          } elsif($ans eq "CMD_ABORT") {
            # if we're in yast, they've already been asked for confirmation
            if($UI_Mode eq "yast") {
              UI_Info(gettext("Abandoning all changes."));
              shutdown_yast();
              exit 0;
            }
            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;
            } else {
              redo;
            }
          } elsif($ans eq "CMD_FINISHED") {
            # if we're in yast, they've already been asked for confirmation
            if($UI_Mode eq "yast") {
              UI_Info(gettext("Saving all changes."));
              $finishing = 1;
              # XXX - BUGBUG - this is REALLY nasty, but i'm in a hurry...
              goto SAVE_PROFILES;
            }
            my $ans = UI_YesNo(gettext("Are you sure you want to save the current set of profile changes and exit?"), "n");
            if($ans eq "y") {
              UI_Info(gettext("Saving all changes."));
              $finishing = 1;
              # XXX - BUGBUG - this is REALLY nasty, but i'm in a hurry...
              goto SAVE_PROFILES;
            } 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};

          # 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 =~ /X/) {

            # get rid of the access() markers.
            $mode =~ s/X//g;

            my $combinedmode = "";

            my ($cm, @m);

            # does path match any regexps in original profile?
            ($cm, @m) = rematchfrag($sd{$profile}{$hat}, $path);
            $combinedmode .= $cm if $cm;

            # does path match anything pulled in by includes in original profile?
            ($cm, @m) = matchincludes($sd{$profile}{$hat}, $path);
            $combinedmode .= $cm if $cm;

            if($combinedmode) {
              if(contains($combinedmode, "ix") ||
                 contains($combinedmode, "px") ||
                 contains($combinedmode, "ux") ||
                 contains($combinedmode, "Px") ||
                 contains($combinedmode, "Ux")) {
              } else {
                $mode .= "ix";
              }
            } else {
              $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 =~ /m/) {
            my $combinedmode = "";
            my ($cm, @m);

            # does path match any regexps in original profile?
            ($cm, @m) = rematchfrag($sd{$profile}{$hat}, $path);
            $combinedmode .= $cm if $cm;

            # does path match anything pulled in by includes in original profile?
            ($cm, @m) = matchincludes($sd{$profile}{$hat}, $path);
            $combinedmode .= $cm if $cm;

            # ix implies m.  don't ask if they want to add an "m" rule when
            # we already have a matching ix rule.
            if($combinedmode && contains($combinedmode, "ix")) {
              $mode =~ s/m//g;
            }
          }

          next unless $mode;

          my $combinedmode = "";
          my @matches;

          my ($cm, @m);

          # does path match any regexps in original profile?
          ($cm, @m) = rematchfrag($sd{$profile}{$hat}, $path);
          if($cm) {
            $combinedmode .= $cm;
            push @matches, @m;
          }

          # does path match anything pulled in by includes in original profile?
          ($cm, @m) = matchincludes($sd{$profile}{$hat}, $path);
          if($cm) {
            $combinedmode .= $cm;
            push @matches, @m;
          }

          unless($combinedmode && contains($combinedmode, $mode)) {

            my $defaultoption = 1;
            my @options = ( );

            # check the path against the available set of include files
            my @newincludes;
            for my $incname (keys %include) {

              # don't suggest it if we're already including it, that's dumb
              next if $sd{$profile}{$hat}{$incname};

              ($cm, @m) = matchinclude($incname, $path);
              if($cm && contains($cm, $mode)) {
                unless(grep { $_ eq "/**" } @m) {
                  push @newincludes, $incname if $incname =~ /abstractions/;
                }
              }
            }

            # 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);

            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($combinedmode) {
                $combinedmode = collapsemode($combinedmode);
                push @{$q->{headers}}, gettext("Old Mode"), $combinedmode;
                $mode = collapsemode("$mode$combinedmode");
                push @{$q->{headers}}, gettext("New Mode"), $mode;
              } else {
                push @{$q->{headers}}, gettext("Mode"), $mode;
              }
              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" ];

              $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_ALLOW") {
                $path = $selected;
                $done = 1;
                if($path =~ m/^#include <(.+)>$/) {
                  my $inc = $1;

                  my $deleted = 0;
                  for my $entry (keys %{$sd{$profile}{$hat}{path}}) {

                    next if $path eq $entry;

                    my $cm = matchinclude($inc, $entry);
                    if($cm && contains($cm, $sd{$profile}{$hat}{path}{$entry})) {
                      delete $sd{$profile}{$hat}{path}{$entry};
                      $deleted++;
                    }
                  }

                  # 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}{path}{$path}) {
                    $mode = collapsemode($mode . $sd{$profile}{$hat}{path}{$path});
                  }

                  my $deleted = 0;
                  for my $entry (keys %{$sd{$profile}{$hat}{path}}) {

                    next if $path eq $entry;

                    if(matchregexp($path, $entry)) {
                      # regexp matches, add it's mode to the list to check against
                      if(contains($mode, $sd{$profile}{$hat}{path}{$entry})) {
                        delete $sd{$profile}{$hat}{path}{$entry};
                        $deleted++;
                      }
                    }
                  }

                  # record the new entry
                  $sd{$profile}{$hat}{path}{$path} = $mode;

                  $changed{$profile} = 1;
                  UI_Info(sprintf(gettext('Adding %s %s to profile.'), $path, $mode));
                  UI_Info(sprintf(gettext('Deleted %s previous matching profile entries.'), $deleted)) if $deleted;
                }
              } elsif($ans eq "CMD_DENY") {
                # go on to the next entry without saving this one
                $done = 1;
              } elsif($ans eq "CMD_NEW") {
                if($selected !~ /^#include/) {
                  $ans = UI_GetString(gettext("Enter new path: "), $selected);
                  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
                unless($selected =~ /^#include/) {
                  my $newpath = $selected;
                  # 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
                unless($selected =~ /^#include/) {
                  my $newpath = $selected;
                  # 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;
              } elsif($ans eq "CMD_ABORT") {
                $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;
                }
              } elsif($ans eq "CMD_FINISHED") {
                $ans = UI_YesNo(gettext("Are you sure you want to save the current set of profile changes and exit?"), "n");
                if($ans eq "y") {
                  UI_Info(gettext("Saving all changes."));
                  $finishing = 1;
                  # XXX - BUGBUG - this is REALLY nasty, but i'm in a hurry...
                  goto SAVE_PROFILES;
                }
              }
            }
          }
        }
      }
    }
  }

  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.

All 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();
      }
    }
  }

SAVE_PROFILES:
  # make sure the profile changes we've made are saved to disk...
  for my $profile (sort keys %changed) {
    writeprofile($profile);
    reload($profile);
  }

  # 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 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>;
  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 = "";

          # is it in the original profile?
          if($sd{$profile}{$hat}{path}{$path}) {
            $combinedmode .= $sd{$profile}{$hat}{path}{$path};
          }

          # does path match any regexps in original profile?
          $combinedmode .= rematchfrag($sd{$profile}{$hat}, $path);

          # does path match anything pulled in by includes in original profile?
          $combinedmode .= matchincludes($sd{$profile}{$hat}, $path);

          # if we found any matching entries, do the modes match?
          unless($combinedmode && contains($combinedmode, $mode)) {

            # merge in any previous modes from this run
            if($log{$sdmode}{$profile}{$hat}{path}{$path}) {
              $mode = collapsemode($mode . $log{$sdmode}{$profile}{$hat}{path}{$path});
            }

            # record the new entry
            $log{$sdmode}{$profile}{$hat}{path}{$path} = collapsemode($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}{capability}{$capability}) {
            $log{$sdmode}{$profile}{$hat}{capability}{$capability} = 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;
}

sub collapsemode ($) {
  my $old = shift;

  my %seen;
  my $new = join "",
            sort
            grep { ! $seen{$_}++ }
            $old =~ m/\G(r|w|l|m|ix|px|ux|Px|Ux)/g;
  return $new;
}

sub contains ($$) {
  my ($glob, $single) = @_;

  $glob = "" unless defined $glob;

  my %h;
  $h{$_}++ for ($glob =~ m/\G(r|w|l|m|ix|px|ux|Px|Ux)/g);

  for my $mode ($single =~ m/\G(r|w|l|m|ix|px|ux|Px|Ux)/g) {
    return 0 unless $h{$mode};
  }

  return 1;
}

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 $file =~ /\.rpm(save|new)$/;
    readprofile("$profiledir/$file");
  }
  closedir(SDDIR);
}

sub readprofile ($) {
  my $file = shift;

  if(open(SDPROF, "$file")) {
    my ($profile, $hat, $in_contained_hat);
    my $initial_comment = "";
    while(<SDPROF>) {
      chomp;

      # we don't care about blank lines
      next if /^\s*$/;

      # start of a profile...
      if(m/^\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) {
          fatal_error "$profile profile in $file contains syntax errors.";
        }

        # we hit the start of a profile, keep track of it...
        $profile  = $1;
        my $flags = $2;
        $in_contained_hat = 0;

        # hat is same as profile name if we're not in a hat
        ($profile, $hat) = split /\^/, $profile;

        # deal with whitespace in profile and hat names.
        $profile = $1 if $profile =~ /^"(.+)"$/;
        $hat     = $1 if $hat     =~ /^"(.+)"$/;

        # if we run into old-style hat declarations mark the profile as
        # changed so we'll write it out as new-style
        if($hat && $hat ne $profile) {
          $changed{$profile} = 1;
        }

        $hat           ||= $profile;

        # keep track of profile flags
        if($flags && $flags =~ /^flags=\((.+)\)\s*$/) {
          $flags = $1;
          $sd{$profile}{$hat}{flags} = $flags;
        }

        $sd{$profile}{$hat}{netdomain} = [];

        # store off initial comment if they have one
        $sd{$profile}{$hat}{initial_comment} = $initial_comment if $initial_comment;
        $initial_comment = "";

      } 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) {
          fatal_error(sprintf(gettext('%s contains syntax errors.'), $file));
        }

        if($in_contained_hat) {
          $hat = $profile;
          $in_contained_hat = 0;
        } else {

          # if we're finishing a profile, make sure that any required
          # infrastructure hats for this changehat application exist
          for my $hatglob (keys %required_hats) {
            if($profile =~ /$hatglob/) {
              for my $hat (split(/\s+/, $required_hats{$hatglob})) {
                unless($sd{$profile}{$hat}) {
                  $sd{$profile}{$hat} = { };
                  # if we had to auto-instantiate a hat, we want to write out
                  # an updated version of the profile
                  $changed{$profile} = 1;
                }
              }
            }
          }

          # mark that we're outside of a profile now...
          $profile = undef;
          $initial_comment = "";
        }

      } elsif(m/^\s*capability\s+(\S+)\s*,\s*$/) {  # capability entry
        if(not $profile) {
          fatal_error(sprintf(gettext('%s contains syntax errors.'), $file));
        }

        my $capability = $1;
        $sd{$profile}{$hat}{capability}{$capability} = 1;

      } elsif(/^\s*(\$\{?[[:alpha:]][[:alnum:]_]*\}?)\s*=\s*(true|false)\s*$/i) { # boolean definition
      } elsif(/^\s*(@\{?[[:alpha:]][[:alnum:]_]+\}?)\s*\+=\s*(.+)\s*$/) { # variable additions
      } elsif(/^\s*(@\{?[[:alpha:]][[:alnum:]_]+\}?)\s*=\s*(.+)\s*$/) { # variable definitions
      } 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*([\"\@\/].*)\s+(\S+)\s*,\s*$/) {     # path entry
        if(not $profile) {
          fatal_error(sprintf(gettext('%s contains syntax errors.'), $file));
        }

        my ($path, $mode) = ($1, $2);

        # strip off any trailing spaces.
        $path =~ s/\s+$//;

        $path = $1 if $path =~ /^"(.+)"$/;

        # make sure they don't have broken regexps in the profile
        my $p_re = convert_regexp($path);
        eval { "foo" =~ m/^$p_re$/; };
        if($@) {
          fatal_error sprintf(gettext('Profile %s contains invalid regexp %s.'), $file, $path);
        }

        $sd{$profile}{$hat}{path}{$path} = $mode;

      } elsif(m/^\s*#include <(.+)>\s*$/) {     # include stuff
        my $include = $1;

        if ($profile) {         
          $sd{$profile}{$hat}{include}{$include} = 1;
        } else {                
          unless (exists $variables{$file}) {
           $variables{$file} = { };
          }                            
          $variables{$file}{"#" . $include} = 1; # sorry
        }

        loadinclude($include);

      } elsif(/^\s*(tcp_connect|tcp_accept|udp_send|udp_receive)/) {
        if(not $profile) {
          fatal_error(sprintf(gettext('%s contains syntax errors.'), $file));
        }

        # XXX - BUGBUGBUG - don't strip netdomain entries

        unless($sd{$profile}{$hat}{netdomain}) {
          $sd{$profile}{$hat}{netdomain} = [ ];
        }

        # strip leading spaces and trailing comma
        s/^\s+//;
        s/,\s*$//;

        # keep track of netdomain entries...
        push @{$sd{$profile}{$hat}{netdomain}}, $_;

      } elsif(m/^\s*\^(\"?.+?)\s+(flags=\(.+\)\s+)*\{\s*$/) { # start of a hat
        # if we hit the start of a contained hat when we're not in a profile
        # something is wrong...
        if(not $profile) {
          fatal_error(sprintf(gettext('%s contains syntax errors.'), $file));
        }

        $in_contained_hat = 1;

        # we hit the start of a hat inside the current profile
        $hat = $1;
        my $flags = $2;

        # deal with whitespace in hat names.
        $hat     = $1 if $hat     =~ /^"(.+)"$/;

        # keep track of profile flags
        if($flags && $flags =~ /^flags=\((.+)\)\s*$/) {
          $flags = $1;
          $sd{$profile}{$hat}{flags} = $flags;
        }

        $sd{$profile}{$hat}{path} = { };
        $sd{$profile}{$hat}{netdomain} = [];

        # store off initial comment if they have one
        $sd{$profile}{$hat}{initial_comment} = $initial_comment if $initial_comment;
        $initial_comment = "";

      } 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:/;
          $initial_comment .= "$_\n";
        }
      } else {

        # we hit something we don't understand in a profile...
        fatal_error(sprintf(gettext('%s contains syntax errors.'), $file));
      }
    }

    # if we're still in a profile when we hit the end of the file, it's bad
    if($profile) {
      fatal_error "Reached the end of $file while we were still inside the $profile profile.";
    }

    close(SDPROF);
  } else {
    $DEBUGGING && debug "readprofile: can't read $file - skipping";
  }

}

sub escape($) {
  my $dangerous = shift;
  if ($dangerous =~ m/^"(.+)"$/) {
    $dangerous = $1;
  }
  $dangerous =~ s/((?<!\\))"/$1\\"/g;
  if ($dangerous =~ m/(\s|^$|")/) {
    $dangerous = "\"$dangerous\"";
  }
  return $dangerous;
}

sub writeheader ($$$$) {
  my ($fh, $profile, $hat, $indent) = @_;

  # deal with whitespace in profile names...
  my $p = $profile;
  $p = "\"$p\"" if $p =~ /\s/;

  if($sd{$profile}{$hat}{flags}) {
    print $fh "$p flags=($sd{$profile}{$hat}{flags}) {\n";
  } else {
    print $fh "$p {\n";
  }
}

sub writeincludes ($$$$) {
  my ($fh, $profile, $hat, $indent) = @_;

  # dump out the includes
  if(exists $sd{$profile}{$hat}{include}) {
    for my $include (sort keys %{$sd{$profile}{$hat}{include}}) {
      print $fh "$indent  #include <$include>\n";
    }
    print $fh "\n" if keys %{$sd{$profile}{$hat}{include}};
  }
}

sub writecapabilities ($$$$) {
  my ($fh, $profile, $hat, $indent) = @_;

  # dump out the capability entries...
  if(exists $sd{$profile}{$hat}{capability}) {
    for my $capability (sort keys %{$sd{$profile}{$hat}{capability}}) {
      print $fh "$indent  capability $capability,\n";
    }
    print $fh "\n" if keys %{$sd{$profile}{$hat}{capability}};
  }
}

sub writenetdomain ($$$$) {
  my ($fh, $profile, $hat, $indent) = @_;

  # dump out the netdomain entries...
  if(exists $sd{$profile}{$hat}{netdomain}) {
    for my $nd (sort @{$sd{$profile}{$hat}{netdomain}}) {
      print $fh "$indent  $nd,\n";
    }
    print $fh "\n" if @{$sd{$profile}{$hat}{netdomain}};
  }
}

sub writepaths ($$$$) {
  my ($fh, $profile, $hat, $indent) = @_;

  if(exists $sd{$profile}{$hat}{path}) {
    for my $path (sort keys %{$sd{$profile}{$hat}{path}}) {
      my $mode = $sd{$profile}{$hat}{path}{$path};

      # strip out any fake access() modes that might have slipped through
      $mode =~ s/X//g;

      # deal with whitespace in path names
      if($path =~ /\s/) {
        print $fh "$indent  \"$path\" $mode,\n";
      } else {
        print $fh "$indent  $path $mode,\n";
      }
    }
  }
}

sub writepiece ($$) {
  my ($sdprof, $profile) = @_;

  writeheader ($sdprof, $profile, $profile, "");
  writeincludes ($sdprof, $profile, $profile, "");
  writecapabilities ($sdprof, $profile, $profile, "");
  writenetdomain ($sdprof, $profile, $profile, "");
  writepaths ($sdprof, $profile, $profile, "");

  for my $hat (grep { $_ ne $profile } sort keys %{$sd{$profile}}) {
    # deal with whitespace in profile names...
    my $h = $hat;
    $h = "\"$h\"" if $h =~ /\s/;

    if($sd{$profile}{$hat}{flags}) {
      print $sdprof "\n  ^$h flags=($sd{$profile}{$hat}{flags}) {\n";
    } else {
      print $sdprof "\n  ^$h {\n";
    }

    writeincludes ($sdprof, $profile, $hat, "  ");
    writecapabilities ($sdprof, $profile, $hat, "  ");
    writenetdomain ($sdprof, $profile, $hat, "  ");
    writepaths ($sdprof, $profile, $hat, "  ");

    print $sdprof "  }\n";
  }

  print $sdprof "}\n";
}

sub writeprofile ($) {
  my $profile = shift;

  UI_Info(sprintf(gettext('Writing updated profile for %s.'), $profile));

  my $filename = getprofilefilename($profile);

  open(SDPROF, ">$filename") or fatal_error "Can't write new AppArmor profile $filename: $!";

  # stick in a vim mode line to turn on subdomain syntax highlighting
  print SDPROF "# vim:syntax=apparmor\n";

  # keep track of when the file was last updated
  print SDPROF "# Last Modified: " . localtime(time) . "\n";

  # print out initial comment
  if($sd{$profile}{$profile}{initial_comment}) {
    $sd{$profile}{$profile}{initial_comment} =~ s/\\n/\n/g;
    print SDPROF $sd{$profile}{$profile}{initial_comment};
    print SDPROF "\n";
  }

  # 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";
    }
  }

  print SDPROF "\n";

  writepiece(\*SDPROF, $profile);

  close(SDPROF);
}



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);
        $flags =~ s/flags=\((.+)\)/$1/;
        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;
}

sub reload ($) {
  my $bin = shift;

  # don't try to reload profile if subdomain is not running
  return unless check_for_subdomain();

  # don't reload the profile if the corresponding executable doesn't exist
  my $fqdbin = findexecutable($bin) or return;

  my $filename = getprofilefilename($fqdbin);

  system("/bin/cat '$filename' | $parser -I$profiledir -r >/dev/null 2>&1");
}

sub loadinclude {
  my $which= shift;

  # don't bother loading it again if we already have
  return if $include{$which};

  my @loadincludes = ( $which );
  while(my $incfile = shift @loadincludes) {

    # load the include from the directory we found earlier...
    open(INCLUDE, "$profiledir/$incfile") or fatal_error "Can't find include file $incfile: $!";

    while(<INCLUDE>) {
      chomp;

      if(/^\s*(\$\{?[[:alpha:]][[:alnum:]_]*\}?)\s*=\s*(true|false)\s*$/i) { # boolean definition
      } elsif(/^\s*(@\{?[[:alpha:]][[:alnum:]_]+\}?)\s*\+=\s*(.+)\s*$/) { # variable additions
      } elsif(/^\s*(@\{?[[:alpha:]][[:alnum:]_]+\}?)\s*=\s*(.+)\s*$/) { # variable definitions
      } 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*\}\s*$/) {                    # end of a profile or conditional
      } elsif(m/^\s*([\"\@\/].*)\s+(\S+)\s*,\s*$/) {     # path entry
        my ($path, $mode) = ($1, $2);

        # strip off any trailing spaces.
        $path =~ s/\s+$//;

        $path = $1 if $path =~ /^"(.+)"$/;

        # make sure they don't have broken regexps in the profile
        my $p_re = convert_regexp($path);
        eval { "foo" =~ m/^$p_re$/; };
        if($@) {
          fatal_error sprintf(gettext('Include %s contains invalid regexp %s.'), $incfile, $path);
        }

        $include{$incfile}{path}{$path} = $mode;
      } elsif(/^\s*capability\s+(.+)\s*,\s*$/) {

        my $capability = $1;
        $include{$incfile}{capability}{$capability} = 1;

      } elsif(/^\s*#include <(.+)>\s*$/) {     # include stuff

        my $newinclude = $1;
        push @loadincludes, $newinclude unless $include{$newinclude};
        $include{$incfile}{include}{$newinclude} = 1;

      } elsif(/^\s*(tcp_connect|tcp_accept|udp_send|udp_receive)/) {
      } else {

        # we don't care about blank lines or comments
        next if /^\s*$/;
        next if /^\s*\#/;

        # we hit something we don't understand in a profile...
        fatal_error sprintf(gettext('%s contains syntax errors.'), $incfile);
      }

    }
    close(INCLUDE);
  }
}

sub rematchfrag{
  my ($frag, $path) = @_;

  my $combinedmode = "";
  my @matches;

  for my $entry (keys %{$frag->{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->{path}{$entry};
      push @matches, $entry;
    }
  }

  return wantarray ? ($combinedmode, @matches) : $combinedmode;
}

sub matchincludes {
  my ($frag, $path) = @_;

  my $combinedmode = "";
  my @matches;


  # scan the include fragments for this profile looking for matches
  my @includelist = keys %{$frag->{include}};
  while(my $include = shift @includelist) {
    loadinclude($include);
    my ($cm, @m) = rematchfrag($include{$include}, $path);
    if($cm) {
      $combinedmode .= $cm;
      push @matches, @m;
    }

    # check if a literal version is in the current include fragment
    if($include{$include}{path}{$path}) {
      $combinedmode .= $include{$include}{path}{$path};
    }

    # if this fragment includes others, check them too
    if(keys %{$include{$include}{include}}) {
      push @includelist, keys %{$include{$include}{include}};
    }
  }

  return wantarray ? ($combinedmode, @matches) : $combinedmode;
}

sub matchinclude {
  my ($incname, $path) = @_;

  my $combinedmode = "";
  my @matches;

  # scan the include fragments for this profile looking for matches
  my @includelist = ( $incname );
  while(my $include = shift @includelist) {
    my ($cm, @m) = rematchfrag($include{$include}, $path);
    if($cm) {
      $combinedmode .= $cm;
      push @matches, @m;
    }

    # check if a literal version is in the current include fragment
    if($include{$include}{path}{$path}) {
      $combinedmode .= $include{$include}{path}{$path};
    }

    # if this fragment includes others, check them too
    if(keys %{$include{$include}{include}}) {
      push @includelist, keys %{$include{$include}{include}};
    }
  }

  if($combinedmode) {
    return wantarray ? ($combinedmode, @matches) : $combinedmode;
  } else {
    return;
  }
}

sub readconfig () {

  my $which;

  if(open(LPCONF, "$confdir/logprof.conf")) {
    while(<LPCONF>) {
      chomp;

      next if /^\s*#/;

      if(m/^\[(\S+)\]/) {
        $which = $1;
      } elsif(m/^\s*(\S+)\s*=\s*(.+)\s*$/) {
        my ($key, $value) = ($1, $2);
        if($which eq "defaulthat") {
          $defaulthat{$key} = $value;
        } elsif($which eq "qualifiers") {
          $qualifiers{$key} = $value;
        } elsif($which eq "globs") {
          $globmap{$key} = $value;
        } elsif($which eq "required_hats") {
          $required_hats{$key} = $value;
        }
      }
    }
    close(LPCONF);
  }
}

sub loadincludes {
if(opendir(SDDIR, $profiledir )) {
  my @incdirs = grep { (! /^\./) && (-d "$profiledir/$_") } readdir(SDDIR);
  close(SDDIR);

  while(my $id = shift @incdirs) {
    if(opendir(SDDIR, "$profiledir/$id" )) {
      for my $path (grep { ! /^\./ } readdir(SDDIR)) {
        chomp($path);
        next if $path =~ /\.rpm(save|new)$/;
        if(-f "$profiledir/$id/$path") {
          my $file = "$id/$path";
          $file =~ s/$profiledir\///;
          loadinclude($file);
        } 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 %globmap) {
    if($path =~ /$glob/) {
      my $globbedpath = $path;
      $globbedpath =~ s/$glob/$globmap{$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 @headers   = ( @{$question->{headers}} );
  my @functions = ( @{$question->{functions}} );

  my $default   = $question->{default};
  my $options   = $question->{options};
  my $selected  = $question->{selected};

  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
    fatal_error "PromptUser: Unknown command $cmd" 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
    $menutext =~ /\((\S)\)/ or fatal_error "PromptUser: Invalid hotkey in '$menutext'";

    # 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
    fatal_error "PromptUser: Duplicate hotkey for $cmd: $menutext" 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
    $defaulttext =~ /\((\S)\)/ or fatal_error "PromptUser: Invalid hotkey in default item '$defaulttext'";

    # we want case insensitive comparisons so we'll force things to lowercase
    $default_key = lc($1);

    fatal_error "PromptUser: Invalid default $default" 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";
    my @poo = @headers;
    while(my $header = shift @poo) {
      my $value = shift @poo;
      $prompt .= sprintf($format, "$header:", $value);
    }
    $prompt .= "\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 && $keys{$ans} && $keys{$ans} eq "CMD_HELP") {
      print "\n$helptext\n";
      $ans = undef;
    }

    # pick the default if they hit return...
    $ans = $default_key if ord($ans) == 10;

    # ugly code to handle escape sequences so you can up/down in the list
    if(ord($ans) == 27) {
      $ans = getkey;
      if(ord($ans) == 91) {
        $ans = getkey;
        if(ord($ans) == 65) {
          if($options) {
            if($selected > 0) {
              $ans = $selected;
            } else {
              $ans = "again";
            }
          } else {
            $ans = "again";
          }
        } elsif(ord($ans) == 66) {
          if($options) {
            if($selected <= scalar(@$options)) {
              $ans = $selected + 2;
            } else {
              $ans = "again";
            }
          }
        } else {
          $ans = "again";
        }
      } else {
        $ans = "again";
      }
    }

    # handle option poo
    if($options && ($ans =~ /^\d$/)) {
      if($ans > 0 && $ans <= scalar(@$options)) {
        $selected = $ans - 1;
      }
      $ans = undef;
    }
  }

  # pull our command back from our hotkey map
  $ans = $keys{$ans} if $keys{$ans};

#  if($options) {
#    die "ERROR: not looking for array when options passed" unless wantarray;
    if($options) {
      return ($ans, $options->[$selected]);
    } else {
      return ($ans, $selected);
    }
#  } else {
#    die "ERROR: looking for list when options not passed" if wantarray;
#    return $ans;
#  }
}

unless(-x $ldd)    {
  $ldd    = which("ldd")              or fatal_error "Can't find ldd.";
}

unless(-x $parser) {
  $parser = which("apparmor_parser") || which("subdomain_parser")
	or fatal_error "Can't find apparmor_parser.";
}


1;