← Back to branch summary

~ubuntu-branches/ubuntu/raring/apparmor/raring

« back to all changes in this revision

Viewing changes to utils/Severity.pm

  • Committer: Bazaar Package Importer
  • Author(s): Kees Cook
  • Date: 2007-03-23 16:42:01 UTC
  • Revision ID: james.westby@ubuntu.com-20070323164201-jkax6f0oku087b7l
Tags: upstream-2.0.1+510.dfsg
Import upstream version 2.0.1+510.dfsg

Show diffs side-by-side

added added

removed removed

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