# cgi-lib.pl
# Common functions for writing http headers
#----------------------------------------------------------
#
# @APPLE_LICENSE_HEADER_START@
#
#
# Copyright (c) 1999-2008 Apple Inc. All Rights Reserved.
#
# This file contains Original Code and/or Modifications of Original Code
# as defined in and that are subject to the Apple Public Source License
# Version 2.0 (the 'License'). You may not use this file except in
# compliance with the License. Please obtain a copy of the License at
# http://www.opensource.apple.com/apsl/ and read it before using this
# file.
#
# The Original Code and all software distributed under the License are
# distributed on an 'AS IS' basis, WITHOUT WARRANTY OF ANY KIND, EITHER
# EXPRESS OR IMPLIED, AND APPLE HEREBY DISCLAIMS ALL SUCH WARRANTIES,
# INCLUDING WITHOUT LIMITATION, ANY WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, QUIET ENJOYMENT OR NON-INFRINGEMENT.
# Please see the License for the specific language governing rights and
# limitations under the License.
#
# @APPLE_LICENSE_HEADER_END@
#
#
#---------------------------------------------------------
package cgilib;
# init days and months
my $ssl = $ENV{"HTTPS"};
@weekday = ( "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" );
@month = ( "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" );
%status = ( '200' => "OK",
'302' => "Temporarily Unavailable",
'401' => "Unauthorized",
'403' => "Forbidden",
'404' => "File Not Found",
);
# PrintOKTextHeader(servername, cookie)
# changed 7/25/01 by JAA to add support for cookies
sub PrintOKTextHeader {
my $datestr = HttpDate(time());
my $charsetstr = '';
if($ENV{"LANGUAGE"} eq "ja") {
$charsetstr = ';charset=Shift_JIS';
}
my $headerstr = "HTTP/1.0 200 OK\r\nServer: $_[0]\r\nContent-Type: text/html$charsetstr\r\nConnection:close\r\n";
$headerstr .= "Set-Cookie: $_[1]\r\n" if ($_[1] ne "");
# Safari cache control
$headerstr .= "Expires: Mon, 26 Jul 1997 05:00:00 GMT\r\n";
$headerstr .= "Last-Modified: $datestr\r\n";
$headerstr .= "Cache-Control: no-store, no-cache, must-revalidate\r\n";
$headerstr .= "Cache-Control: post-check=0, pre-check=0, false\r\n";
$headerstr .= "Pragma: no-cache\r\n";
$headerstr .= "\r\n";
print $headerstr;
}
# PrintFileDownloadHeader(servername)
# added 4/25/02 by JAA to allow content downloads
sub PrintFileDownloadHeader {
my $datestr = HttpDate(time());
my $charsetstr = '';
if($ENV{"LANGUAGE"} eq "ja") {
$charsetstr = ';charset=Shift_JIS';
}
my $headerstr = "HTTP/1.0 200 OK\r\nDate: $datestr\r\nServer: $_[0]\r\nContent-Type: application/octet-stream\r\nConnection:close\r\n";
print $headerstr;
}
# PrintRedirectHeader(servername, redirectpath)
# changed from PrintRedirectHeader(servername, serverip, serverport, redirectpage)
sub PrintRedirectHeader {
my $datestr = HttpDate(time());
print "HTTP/1.0 302 Temporarily Unavailable\r\nDate: $datestr\r\nServer: $_[0]\r\n"
. "Location: $_[1]\r\nConnection:close\r\n\r\n";
}
# PrintChallengeHeader(servername, challengeheader)
sub PrintChallengeHeader {
my $datestr = HttpDate(time());
print "HTTP/1.0 401 Unauthorized\r\nDate: $datestr\r\nServer: $_[0]\r\n"
. "Content-Type: text/html\r\nConnection:close\r\n$_[1]\r\n\r\n";
}
# PrintChallengeResponse(servername, challengeheader, messageHash)
sub PrintChallengeResponse {
PrintChallengeHeader($_[0], $_[1]);
PrintUnauthorizedHtml($_[2]);
}
# PrintForbiddenHeader(servername)
sub PrintForbiddenHeader {
my $datestr = HttpDate(time());
print "HTTP/1.0 403 Forbidden\r\nDate: $datestr\r\nServer: $_[0]\r\nContent-Type: text/html\r\nConnection:close\r\n\r\n";
}
# PrintForbiddenResponse(servername, filename, messageHash)
sub PrintForbiddenResponse {
PrintForbiddenHeader($_[0]);
PrintForbiddenHtml($_[1], $_[2]);
}
# PrintForbiddenHtml(filename, messageHash)
sub PrintForbiddenHtml {
my $messHash = $_[1];
my %messages = %$messHash;
print "$messages{'Http403Status'}"
. "$messages{'Http403Status'}
$messages{'Http403Body'} : $_[0]
";
}
# PrintNotFoundHeader(servername)
sub PrintNotFoundHeader {
my $datestr = HttpDate(time());
print "HTTP/1.0 404 File Not Found\r\nDate: $datestr\r\nServer: $_[0]\r\nContent-Type: text/html\r\nConnection:close\r\n\r\n";
}
# PrintNotFoundResponse(servername, filename, messageHash)
sub PrintNotFoundResponse {
PrintNotFoundHeader($_[0]);
PrintNotFoundHtml($_[1], $_[2]);
}
# PrintNotFoundHtml(filename, messageHash)
sub PrintNotFoundHtml {
my $messHash = $_[1];
my %messages = %$messHash;
print "$messages{'Http404Status'}"
. "$messages{'Http404Status'}
$messages{'Http404Body'} : $_[0]
";
}
# PrintStatusLine(num)
sub PrintStatusLine {
print "HTTP/1.0 $_[0] $status{$_[0]}\r\n";
}
# PrintDateAndServerStr(server)
sub PrintDateAndServerStr {
my $datestr = HttpDate(time());
print "Date: $datestr\r\nServer: $_[0]\r\n";
}
# PrintTextTypeAndCloseStr()
sub PrintTextTypeAndCloseStr {
print "Content-Type: text/html\r\nConnection: close\r\n\r\n";
}
# PrintUnauthorizedHeader(servername, realm)
sub PrintUnauthorizedHeader {
my $datestr = HttpDate(time());
print "HTTP/1.0 401 Unauthorized\r\nServer:$_[0]\r\nDate: $datestr\r\n"
. "WWW-authenticate: Basic realm=\"$_[1]\"\r\n"
. "Content-Type: text/html\r\nConnection: close\r\n\r\n";
}
# PrintServerNotRunningHtml(messageHash)
sub PrintServerNotRunningHtml {
my $messHash = $_[0];
my %messages = %$messHash;
print "$messages{'ServerNotRunningMessage'}"
. "
$messages{'StartServerMessage'}
"
. "";
}
# PrintUnauthorizedHtml(messageHash)
sub PrintUnauthorizedHtml {
my $messHash = $_[0];
my %messages = %$messHash;
print " $messages{'Http401Status'}"
. " $messages{'Http401Status'}
$messages{'Http401Body'}.\n"
. "
";
}
# PrintUnauthorizedResponse(servername, realm, messageHash)
sub PrintUnauthorizedResponse {
PrintUnauthorizedHeader($_[0], $_[1]);
PrintUnauthorizedHtml($_[2]);
}
# HttpDate(timeinsecfrom1970)
sub HttpDate {
local @tm = gmtime($_[0]);
return sprintf "%s, %d %s %d %2.2d:%2.2d:%2.2d GMT",
$weekday[$tm[6]], $tm[3], $month[$tm[4]], $tm[5]+1900,
$tm[2], $tm[1], $tm[0];
}
1; #return true