This file is indexed.

/usr/share/perl5/Apache2/SiteControl.pm is in libapache2-sitecontrol-perl 1.05-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
package Apache2::SiteControl;

use 5.008;
use strict;
use warnings;
use Carp;
use Apache2::AuthCookie;
use Apache::Session::File;

our $VERSION = "1.05";

use base qw(Apache2::AuthCookie);

our %managers = ();

sub getCurrentUser
{
   my $this = shift;
   my $r = shift;
   my $debug = $r->dir_config("SiteControlDebug") || 0;
   my $factory = $r->dir_config("SiteControlUserFactory") || "Apache2::SiteControl::UserFactory";
   my $auth_type = $r->auth_type;
   my $auth_name = $r->auth_name;
   my ($ses_key) = ($r->headers_in->{"Cookie"} || "") =~ /$auth_type\_$auth_name=([^;]+)/;

   $r->log_error("Session cookie: " . ($ses_key ? $ses_key:"UNSET")) if $debug;
   $r->log_error("Loading module $factory") if $debug;
   eval "require $factory" or $r->log_error("Could not load $factory: $@");
   $r->log_error("Using user factory $factory") if $debug;
   my $username = $r->user();
   return undef if(!$username);

   $r->log_error("user name is $username") if $debug;
   my $user = undef;

   $factory = '$user' . " = $factory" . '->findUser($r, $ses_key)';
   $r->log_error("Evaluating: $factory") if $debug;
   eval($factory) or $r->log_error("Eval failed: $@");

   $r->log_error("Got user object: $user") if $debug && defined($user);
   return defined($user) ? $user : 0;
}

sub getPermissionManager
{
   my $this = shift;
   my $r = shift;

   my $debug = $r->dir_config("SiteControlDebug") || 0;
   my $name = $r->dir_config("AuthName") || "default";
   $r->log_error("AuthName is not set! Using 'default'.") if $name eq "default";

   return $managers{$name} if(defined($managers{$name}) && $managers{$name});
   $r->log_error("Building manager") if $debug;

   my $factory = $r->dir_config("SiteControlManagerFactory");
   $r->log_error("Manager Factory not set!") if !defined($factory);

   return undef if !defined($factory);
   $r->log_error("Loading module $factory") if $debug;
   eval "require $factory" or $r->log_error("Could not load $factory: $@");

   $factory = '$managers{$name}' . " = $factory" . '->getPermissionManager()';
   $r->log_error("Building a manager using: $factory") if $debug;
   eval($factory) or $r->log_error("Evaluation failed: $@");

   return $managers{$name};
}

# This is the method that receives the login form data and decides if the 
# user is allowed to log in.
sub authen_cred
{
   my $this = shift;  # Package name (same as AuthName directive)
   my $r    = shift;  # Apache request object
   my @cred = @_;     # Credentials from login form
   my $debug = $r->dir_config("SiteControlDebug") || 0;
   my $checker = $r->dir_config("SiteControlMethod") || "Apache2::SiteControl::Radius";
   my $factory = $r->dir_config("SiteControlUserFactory") || "Apache2::SiteControl::UserFactory";
   my $user = undef;
   my $ok;

   # Load the user authentication module
   eval "require $checker" or $r->log_error("Could not load $checker: $@");
   eval "require $factory" or $r->log_error("Could not load $factory: $@");
   eval '$ok = ' . ${checker} . '::check_credentials($r, @cred)' or $r->log_error("authentication error code: $@");

   if($ok) {
      eval('$user = ' . "$factory" . '->makeUser($r, @cred)');
      if($@) {
         $r->log_error("Error reported during call to ${factory}->makeUser: $@");
      }
   }

   return $user->{sessionid} if defined($user);

   return undef;
}

# This sub is called for every request that is under the control of
# SiteControl. It is responsible for verifying that the user id (session
# key) is valid and that the user is ok.
# It returns a user name if all is well, and undef if not.
sub authen_ses_key
{
   my ($this, $r, $session_key) = @_;
   my $debug = $r->dir_config("SiteControlDebug") || 0;
   my $factory = $r->dir_config("SiteControlUserFactory") || "Apache2::SiteControl::UserFactory";
   my $user = undef;

   eval "require $factory" or $r->log_error("Could not load $factory: $@");
   $r->log_error("Attempting auth using session key $session_key") if $debug;
   eval {
      eval('$user = ' . "$factory" . '->findUser($r, $session_key)');
      if($@) {
         $r->log_error("Error reported during call to ${factory}->findUser: $@");
      }
   };
   if($@) {
      $r->log_error("User tried access with invalid/nonexistent session: $@");
      return undef;
   }

   return $user->getUsername if defined($user);

   return undef;
}

1;

__END__

=head1 NAME

Apache2::SiteControl - Perl web site authentication/authorization system

=head1 SYNOPSIS

See samples/site for complete example. Note, this module is intended for
mod_perl. See Apache2::SiteControl for mod_perl2.

=head1 DESCRIPTION

Apache2::SiteControl is a set of perl object-oriented classes that
implement a fine-grained security control system for a web-based application.
The intent is to provide a clear, easy-to-integrate system that does not
require the policies to be written into your application components. It
attempts to separate the concerns of how to show and manipulate data from the
concerns of who is allowed to view and manipulate data and why.

For example, say your web application is written in HTML::Mason. Your
individual "screens" are composed of Mason modules, and you would like to keep
those as clean as possible, but decisions have to be made about what to allow
as the component is processed. SiteControl attempts to make that as easy as
possible.

=head2 DEVELOPER'S VIEWPOINT - EXAMPLE

In this document we use HTML::Mason to create examples of how to use the
control mechanisms, but any mod_perl based system should be supportable.

A good mason component tries to do most of the perl processing in a separate
block, so that simple substitutions can be made in HTML in the rest of
the page. This makes it much easier for web developers and perl developers to
co-exist on a project. 

The SiteControl system tries to make it possible to continue to follow this
model. You obtain a user object and permission manager from the SiteControl
system. These are intended to be opaque data types to the page designer,
and are defined elsewhere (see USERS). The actual web page component
should carry these objects around without implementing anything in the way of
policy.

For example, your mason component might look like this:

   <HTML>
      <HEAD> ... </HEAD>
   % if($manager->can($currentUser, "edit", $table)) {
         <FORM METHOD=POST ACTION="...">
            <P><INPUT TYPE=TEXT NAME="x" VALUE="<% $table->{x} %>">
            ...
         </FORM>
   % } else {
         <P>x is <% $table->{x} %>
   % }

   <%init>
   my $currentUser = Apache2::SiteControl->getCurrentUser($r);
   my $manager = Apache2::SiteControl->getPermissionManager($r);

   ... application specific stuff...
   i.e. 

   my $table = ...
   </%init>

Notice that the component does not bother looking at the user object, and there
is no policy code...just a request for permission:

   if($manager->can($currentUser, "do something to", $resource))

Of course the developer needs to know I<something> about the underlying system.
For example, the action string "do something to" is rather arbitrary. These can
be anything, and must be specified as rule actions. It is recommended that you
use some form of Perl constants for these instead of strings, but that is up to
you.

The resource is intended to be less opaque. This is likely the object that the
page developer wants to muck with, and so probably knows the internals of that
object a bit better. This is the crossover point from what SiteControl can
figure out on its own to information you have to supply. 

The default behavior is for the manager to deny any request.  In order for a
request to be approved, someone has to write a rule that joins together the
user, action, and resource and makes a decision about the permissibility of the
action.

If all you want is login and user tracking (but no permission manager), then it
is safe to ignore the permission manager altogether.

=head1 USERS

Users and Rules are the central components of the SiteControl system. The user
object must be Apache2::SiteControl::User (or a subclass). See
Apache2::SiteControl::User for a description of what it supports (session
storage, logout, etc.).  The glue to SiteControl is the UserFactory, which you
can define or accept the default of Apache2::SiteControl::UserFactory
(recommended). 

Whenever a login attempt succeeds, the factory returns an object that
represents a valid, logged-in user. See Apache2::SiteControl::UserFactory for
more information.

=head2 PERMISSION MANAGER

Each site will have a permission manager. There is usually no need for you
to subclass Apache2::SiteControl::PermissionManager, but you do need to create one
and populate it with your access rules. You do this by creating a
factory class, which looks something like this:

   package samples::site::MyPermissionFactory;

   use Apache2::SiteControl::PermissionManager;
   use Apache2::SiteControl::GrantAllRule;
   use samples::site::EditControlRule;

   use base qw(Apache2::SiteControl::ManagerFactory);

   our $manager;

   sub getPermissionManager
   {
      return $manager if defined($manager);

      $manager = new Apache2::SiteControl::PermissionManager;
      $manager->addRule(new Apache2::SiteControl::GrantAllRule);
      $manager->addRule(new samples::site::EditControlRule);

      return $manager;
   }

   1;

The primary goal of your factory is to produce an instance of a permission 
manager that knows the rules for permitting access to your site. This is 
an easy process that involves calling the constructor (via new) and then
calling addRule one or more times.

=head2 RULES

The PermissionManager is the object that the site developers ask about
what is allowed and what is not. As you saw in the previous section, you 
create a manager, and add some rules.

Each rule is a custom-written class that implements some aspect of your
site's access logic. Rules can choose to grant or deny a request. The following
is a pretty complex example that demonstrates the features of a rule. 

Most rules with either specifically grant permission, or deny it. Most will not
deal with both possibilities. In this example we are assuming that the user is
implemented as an object that has attributes which can be retrieved with a
getAttribute method (of course, you would have to have implemented that as
well). The basic action that this rule handles is called "beat up", so the site
makes calls like: 
 
   if($referee->can($userA, "beat up", $userB)) { ... }

In terms of English, we would describe the rule "If A is taller than B, then
we say that A can beat up B. If A is less skilled than B, then we say that
A cannot beat up B".  The rule looks like this:

   package samples::FightRules;

   use strict;
   use warnings;
   use Carp;
   use Apache2::SiteControl::Rule;

   use base qw(Apache2::SiteControl::Rule);

   sub grants($$$$)
   {
      my $this = shift;
      my $user = shift;
      my $action = shift;
      my $resource = shift;

      if($action eq "beat up" && $resource->isa("Apache2::SiteControl::User")) {
         my ($h1, $h2);
         $h1 = $user->getAttribute("height");
         $h2 = $resource->getAttribute("height");
         return 1 if(defined($h1) && defined($h2) && $h1 > $h2);
      }

      return 0;
   }

   sub denies($$$$)
   {
      my $this = shift;
      my $user = shift;
      my $action = shift;
      my $resource = shift;

      if($action eq "beat up" && $resource->isa("Apache2::SiteControl::User")) {
         my ($s1, $s2);
         $s1 = $user->getAttribute("skill");
         $s2 = $resource->getAttribute("skill");
         return 1 if(defined($s1) && defined($s2) && $s1 < $s2);
      }

      return 0;
   }

   1;

The PermissionManager will only give permission if I<at least> one rule grants
permission, I<and> no rule denies it. 

I think it is clearer to separate rules like the previous one into separate
rule classes altogether. A HeightMakesMightRule and a DefenseSkillRule.
Splitting into two rules makes things clearer, and there is no limit to the
number of rules that the PermissionManager can check.

It is important that your rules never grant or deny a request they do not
understand, so it is a good idea to use type checking to prevent strangeness.
B<Assertions should not be used> if you expect different rules to accept
different resource types or user types, since each rule is used on every access
request.

=head1 EXPORT

None by default.

=head1 SEE ALSO

Apache2::SiteControl::UserFactory, Apache::SiteControl::ManagerFactory,
Apache2::SiteControl::PermissionManager, Apache::SiteControl::Rule

=head1 AUTHOR

This module was written by Tony Kay, E<lt>tkay@uoregon.eduE<gt>.

=head1 COPYRIGHT AND LICENSE

This modules is covered by the GNU public license.
=cut