← Back to branch summary

~ubuntu-branches/ubuntu/wily/apparmor/wily

« back to all changes in this revision

Viewing changes to utils/Immunix/Severity.pm

  • Committer: Bazaar Package Importer
  • Author(s): Kees Cook
  • Date: 2011-04-27 10:38:07 UTC
  • mfrom: (5.1.118 natty)
  • Revision ID: james.westby@ubuntu.com-20110427103807-ym3rhwys6o84ith0
Tags: 2.6.1-2
debian/copyright: clarify for some full organization names.

Show diffs side-by-side

added added

removed removed

Lines of Context:
utils/Immunix/Severity.pm
 
1
# ------------------------------------------------------------------
 
2
#
 
3
#    Copyright (C) 2005-2006 Novell/SUSE
 
4
#
 
5
#    This program is free software; you can redistribute it and/or
 
6
#    modify it under the terms of version 2 of the GNU General Public
 
7
#    License published by the Free Software Foundation.
 
8
#
 
9
# ------------------------------------------------------------------
 
10
 
 
11
package Immunix::Severity;
 
12
use strict;
 
13
use Data::Dumper;
 
14
 
 
15
my ($debug) = 0;
 
16
 
 
17
sub debug {
 
18
    print @_ if $debug;
 
19
}
 
20
 
 
21
sub new {
 
22
    my $self = {};
 
23
    $self->{DATABASENAME} = undef;
 
24
    $self->{CAPABILITIES} = {};
 
25
    $self->{FILES}        = {};
 
26
    $self->{REGEXPS}      = {};
 
27
    $self->{DEFAULT_RANK} = 10;
 
28
    bless($self);
 
29
    shift;
 
30
    $self->init(@_) if @_;
 
31
    return $self;
 
32
}
 
33
 
 
34
sub init ($;$) {
 
35
    my ($self, $resource, $read, $write, $execute, $severity);
 
36
    $self = shift;
 
37
    $self->{DATABASENAME} = shift;
 
38
    $self->{DEFAULT_RANK} = shift if defined $_[0];
 
39
    open(DATABASE, $self->{DATABASENAME})
 
40
      or die "Could not open severity db $self->{DATABASENAME}: $!\n";
 
41
    while (<DATABASE>) {
 
42
        chomp();
 
43
        next if m/^\s*#/;
 
44
        next if m/^\s*$/;
 
45
 
 
46
        # leading whitespace is fine; maybe it shouldn't be?
 
47
        if (/^\s*\/(\S+)\s+(\d+)\s+(\d+)\s+(\d+)\s*$/) {
 
48
            my ($path, $read, $write, $execute) = ($1, $2, $3, $4);
 
49
 
 
50
            if (index($path, "*") == -1) {
 
51
 
 
52
                $self->{FILES}{$path} = {
 
53
                    r => $read,
 
54
                    w => $write,
 
55
                    x => $execute
 
56
                };
 
57
 
 
58
            } else {
 
59
 
 
60
                my $ptr = $self->{REGEXPS};
 
61
                my @pieces = split(/\//, $path);
 
62
 
 
63
                while (my $piece = shift @pieces) {
 
64
                    if (index($piece, "*") != -1) {
 
65
                        my $path = join("/", $piece, @pieces);
 
66
                        my $regexp = convert_regexp($path);
 
67
                        $ptr->{$regexp}{SD_RANK} = {
 
68
                            r => $read,
 
69
                            w => $write,
 
70
                            x => $execute
 
71
                        };
 
72
                        last;
 
73
                    } else {
 
74
                        $ptr->{$piece} = {} unless exists $ptr->{$piece};
 
75
                        $ptr = $ptr->{$piece};
 
76
                    }
 
77
                }
 
78
            }
 
79
        } elsif (m|^\s*CAP|) {
 
80
            ($resource, $severity) = split;
 
81
            $self->{CAPABILITIES}{$resource} = $severity;
 
82
        } else {
 
83
            print "unexpected database line: $_\n";
 
84
        }
 
85
    }
 
86
    close(DATABASE);
 
87
    debug Dumper($self);
 
88
    return $self;
 
89
}
 
90
 
 
91
#rank:
 
92
# handle capability
 
93
# handle file
 
94
#
 
95
# handle capability
 
96
#   if the name is in the database, return it
 
97
#   otherwise, send a diagnostic message to stderr and return the default
 
98
#
 
99
# handle file
 
100
#   initialize the current return value to 0
 
101
#   loop over each entry in the database;
 
102
#     find the max() value for each mode that matches and set a 'found' flag
 
103
#   if the found flag has not been set, return the default;
 
104
#   otherwise, return the maximum from the database
 
105
 
 
106
sub handle_capability ($) {
 
107
    my ($self, $resource) = @_;
 
108
 
 
109
    my $ret = $self->{CAPABILITIES}{$resource};
 
110
    if (!defined($ret)) {
 
111
        return "unexpected capability rank input: $resource\n";
 
112
    }
 
113
    return $ret;
 
114
}
 
115
 
 
116
sub check_subtree {
 
117
    my ($tree, $mode, $sev, $first, @rest) = @_;
 
118
 
 
119
    # reassemble the remaining path from this directory level
 
120
    my $path = join("/", $first, @rest);
 
121
 
 
122
    # first check if we have a literal directory match to descend into
 
123
    if ($tree->{$first}) {
 
124
        $sev = check_subtree($tree->{$first}, $mode, $sev, @rest);
 
125
    }
 
126
 
 
127
    # if we didn't get a severity already, check for matching globs
 
128
    unless ($sev) {
 
129
 
 
130
        # check each glob at this directory level
 
131
        for my $chunk (grep { index($_, "*") != -1 } keys %{$tree}) {
 
132
 
 
133
            # does it match the rest of our path?
 
134
            if ($path =~ /^$chunk$/) {
 
135
 
 
136
                # if we've got a ranking, check if it's higher than
 
137
                # current one, if any
 
138
                if ($tree->{$chunk}->{SD_RANK}) {
 
139
                    for my $m (split(//, $mode)) {
 
140
                        if ((!defined $sev)
 
141
                            || $tree->{$chunk}->{SD_RANK}->{$m} > $sev)
 
142
                        {
 
143
                            $sev = $tree->{$chunk}->{SD_RANK}->{$m};
 
144
                        }
 
145
                    }
 
146
                }
 
147
            }
 
148
        }
 
149
    }
 
150
 
 
151
    return $sev;
 
152
}
 
153
 
 
154
sub handle_file ($$) {
 
155
    my ($self, $resource, $mode) = @_;
 
156
 
 
157
    # strip off the initial / from the path we're checking
 
158
    $resource = substr($resource, 1);
 
159
 
 
160
    # break the path into directory-level chunks
 
161
    my @pieces = split(/\//, $resource);
 
162
 
 
163
    my $sev;
 
164
 
 
165
    # if there's a exact match for this path in the db, use that instead of
 
166
    # checking the globs
 
167
    if ($self->{FILES}{$resource}) {
 
168
 
 
169
        # check each piece of the passed mode against the db entry
 
170
        for my $m (split(//, $mode)) {
 
171
            if ((!defined $sev) || $self->{FILES}{$resource}{$m} > $sev) {
 
172
                $sev = $self->{FILES}{$resource}{$m};
 
173
            }
 
174
        }
 
175
 
 
176
    } else {
 
177
 
 
178
        # descend into the regexp tree looking for matches
 
179
        $sev = check_subtree($self->{REGEXPS}, $mode, $sev, @pieces);
 
180
 
 
181
    }
 
182
 
 
183
    return (defined $sev) ? $sev : $self->{DEFAULT_RANK};
 
184
}
 
185
 
 
186
sub rank ($;$) {
 
187
    my ($self, $resource, $mode) = @_;
 
188
 
 
189
    if (substr($resource, 0, 1) eq "/") {
 
190
        return $self->handle_file($resource, $mode);
 
191
    } elsif (substr($resource, 0, 3) eq "CAP") {
 
192
        return $self->handle_capability($resource);
 
193
    } else {
 
194
        return "unexpected rank input: $resource\n";
 
195
    }
 
196
}
 
197
 
 
198
sub convert_regexp ($) {
 
199
    my ($input) = shift;
 
200
 
 
201
    # we need to convert subdomain regexps to perl regexps
 
202
    my $regexp = $input;
 
203
 
 
204
    # escape + . [ and ] characters
 
205
    $regexp =~ s/(\+|\.|\[|\])/\\$1/g;
 
206
 
 
207
    # convert ** globs to match anything
 
208
    $regexp =~ s/\*\*/.SDPROF_INTERNAL_GLOB/g;
 
209
 
 
210
    # convert * globs to match anything at current path level
 
211
    $regexp =~ s/\*/[^\/]SDPROF_INTERNAL_GLOB/g;
 
212
 
 
213
    # convert {foo,baz} to (foo|baz)
 
214
    $regexp =~ y/\{\}\,/\(\)\|/ if $regexp =~ /\{.*\,.*\}/;
 
215
 
 
216
    # twiddle the escaped * chars back
 
217
    $regexp =~ s/SDPROF_INTERNAL_GLOB/\*/g;
 
218
    return $regexp;
 
219
}
 
220
 
 
221
1;    # so the require or use succeeds