### Local Variables: ***
### mode:perl ***
### comment-column:0 ***
### comment-start: "### " ***
### comment-end: "***" ***
### End: ***
#
# ****************DO NOT MOVE OR CHANGE LINES ABOVE THIS*********************
#
# The first set of lines runs perl from any shell. The second set of lines
# identifies the rest of the file as PERL for EMACS autoformatting.
# See end of copyright for more information.
#
#
# -------------------------------------------------------------------
# X-BONE
#
# http://www.isi.edu/xbone
# USC Information Sciences Institute (USC/ISI)
# Marina del Rey, California 90292, USA
# Copyright (c) 1998-2005
#
# -------------------------------------------------------------------
#
# Copyright (c) 1998-2005 by the University of Southern California.
# All rights reserved.
#
# Permission to use, copy, modify, and distribute this software and
# its documentation in source and binary forms for non-commercial
# purposes and without fee is hereby granted, provided that the above
# copyright notice appear in all copies and that both the copyright
# notice and this permission notice appear in supporting
# documentation, and that any documentation, advertising materials,
# and other materials related to such distribution and use acknowledge
# that the software was developed by the University of Southern
# California, Information Sciences Institute. The name of the
# University may not be used to endorse or promote products derived
# from this software without specific prior written permission.
#
# THE UNIVERSITY OF SOUTHERN CALIFORNIA MAKES NO REPRESENTATIONS ABOUT
# THE SUITABILITY OF THIS SOFTWARE FOR ANY PURPOSE. THIS SOFTWARE IS
# PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES,
# INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
# Other copyrights might apply to parts of this software and are so
# noted when applicable.
#
# -------------------------------------------------------------------
#
# Effort partly sponsored by the Defense Advanced Research Projects
# Agency (DARPA) and Air Force Research Laboratory, Air Force Materiel
# Command, USAF, under agreement numbers F30602-98-1-0200 (X-Bone) and
# F30602-01-2-0529 (DynaBone). The views and conclusions contained
# herein are those of the authors and should not be interpreted as
# necessarily representing the official policies or endorsements,
# either expressed or implied, of the Defense Advanced Research
# Projects Agency (DARPA), the Air Force Research Laboratory, or the
# U.S. Government.
#
# This work was partly supported by the NSF STI-XTEND (ANI-0230789)
# and NETFS (ANI-0129689) projects. Any opinions, findings, and
# conclusions or recommendations expressed in this material are those
# of the authors and do not necessarily reflect the views of the
# National Science Foundation.
#
# -------------------------------------------------------------------
# $RCSfile: XB_Common.pm,v $
#
# $Revision: 1.28 $
# $Author: pingali $
# $Date: 2005/03/31 07:04:02 $
# $State: Exp $
# ----------------------------------------------------------------------------
#
# Primary Author: Lars Eggert
package XB_Common;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(fail_page my_th process_req user_info);
@EXPORT_OK = qw ();
use strict;
use sigtrap;
use CGI qw(:standard :html3);
use CGI::Carp qw(fatalsToBrowser);
sub fail_page ($$;@) {
my ($header, $msg, @cookies) = @_;
if($#cookies == -1) { print header; }
else { print header("-cookie" => \@cookies); }
print start_html(-title => $header,
-background => "/xml/images/background_med_tan.gif",
-style => { -src =>"/xml/xbone.css" }),
h1( {-class => "secheader"}, $header), p($msg),
p("Back to the ", a({-href => "/"}, "main X-Bone page") . "."), end_html;
exit(0);
}
sub my_th ($$) {
my ($tag, $name) = @_;
if(not defined param($tag) or param($tag) eq "") {
return th({-class => "redbg"}, $name);
}
return th($name);
}
sub process_req () {
# process the request
unless($ENV{'DOCUMENT_ROOT'}) {
fail_page "DOCUMENT_ROOT not defined.",
p("This should not happen when being called from apache.") .
p("Something is seriously broken."); }
my $base_dir = $ENV{'DOCUMENT_ROOT'};
# untaint
if ($base_dir =~ /^((\/([[:alnum:]]|[-_\.])*)*)$/) { $base_dir = $1; }
else { die "tainted: $base_dir"; }
$base_dir =~ s/\/(s-)?htdocs//;
my $certs_dir = "$base_dir/unsigned-cert-requests";
if(not -d $certs_dir) {
mkdir $certs_dir, 0600 or die "cannot mkdir $certs_dir: $!";
}
my $counter = new File::CounterFile("$certs_dir/.counter", 1);
unless($counter) {
fail_page "Request Counter Failure",
p("Could not create request counter file: $!");
}
my $count = $counter->inc();
# untaint
if ($count =~ /^(\d+)$/) { $count = $1; }
else { die "tainted: $count"; }
my $req_file = "$certs_dir/cert$count.req"; # certificate request filename
my ($message, $mail_message) = ("") x 2;
my $key = param('SPKAC'); # this will fail if not Netscape browser
unless($key) {
fail_page "Netscape Required",
p("No private key included in request. Maybe you are not " .
"running Netscape Navigator as I thought?");
}
# Explicitly list form fields we must have for certificate creation to work
my @req_names = ('commonName', 'emailAddress', 'organizationName',
'organizationalUnitName', 'localityName',
'stateOrProvinceName', 'countryName', 'SPKAC');
foreach my $name (@req_names) {
my $value = param("$name");
$value =~ tr/\n//d;
# this goes into the request file that will be signed by the CA
my $line = "$name = $value\n";
$message .= $line;
# this goes into the mail message sent to the CA (omit SPKAC)
unless($name eq "SPKAC") { $mail_message .= "$name: $value\n"; }
}
# build the request file
open(REQ, ">$req_file") or
fail_page "Request Creation Failed",
p("Could not create request file ($!): $req_file");
print REQ $message;
close(REQ);
chmod 0444, $req_file;
# make sure we actually created a request file
unless(-f $req_file) {
fail_page "Request Creation Failed",
p("Request file missing: $req_file");
}
# send email to the CA guys
my $email = param('emailAddress');
my $sender = param('commonName');
my %letter = ( To => $XB_Params::CA_EMAIL,
From => "$sender <$email>",
Subject => "X-Bone Certificate Request",
Message =>
"This file needs to be passed through the signing script:\n".
$req_file . "\n\nSubmitted from overlay ".
"manager $XB_Params::XBONE_OVERLAY_MANAGER.\n\n".
"$mail_message\n"
);
unless (Mail::Sendmail::sendmail(%letter)) {
fail_page "Error Sending Mail",
p("Could not send email: $Mail::Sendmail::error");
}
}
sub user_info () {
my %user = ( User => "$ENV{SSL_CLIENT_S_DN_CN} <" .
a({-href => "mailto:$ENV{SSL_CLIENT_S_DN_Email}"},
$ENV{SSL_CLIENT_S_DN_Email}) . ">",
Organization => $ENV{SSL_CLIENT_S_DN_O} .
($ENV{SSL_CLIENT_S_DN_OU} ?
", $ENV{SSL_CLIENT_S_DN_OU}" : ""),
Location => $ENV{SSL_CLIENT_S_DN_L} .
($ENV{SSL_CLIENT_S_DN_ST} ?
", $ENV{SSL_CLIENT_S_DN_ST}" : "") .
($ENV{SSL_CLIENT_S_DN_C} ?
", $ENV{SSL_CLIENT_S_DN_C}" : ""));
my $user_rows = "";
while(my ($key, $val) = each %user) { $user_rows .= Tr(th($key), td($val)); }
return p("You are logged in with these credentials ",
"(taken from your X.509 certificate):") . table($user_rows);
}
1;
syntax highlighted by Code2HTML, v. 0.9.1