package Gm_Web; ############################################################################### # Greymatter 1.7.2 # Copyright (c)2000-2007, The Greymatter team # http://greymatterforum.proboards82.com/ # By possessing this software, you agree not to hold the author responsible for # any problems that may arise from your installation or usage of Greymatter # itself, or from any content generated by yourself or others through the use of # this program. You may freely modify and redistribute this program, so # long as every copyright notice (including in this manual and in the Greymatter # code) remains fully intact. Finally, you may not sell or in any way # make a financial profit from this program, either in original or modified form. # Your possession of this software signifies that you agree to these terms; # please delete your copy of this software if you don't agree to these terms. # Original Creators Noah Grey ############################################################################### #============================================================================== # Note no exporting because items from this package should be fully qualified ## Gm Web # This package groups functions that deal with html or web experience. # This is pretty much, if a subroutine generates html, it belongs here. # Notice that not everything needs to go here. Notice the radio button # logic basically is there to remove boring if...else checked logic. This # is the place for those kinds of optimizations # # CONVENTIONS # 1. Return a string rather than printing, this is just more elegant. Leave prints # to the calling subroutine, if possible # 2. Private subroutines should start with the '_' character. By private I mean # it will never be called outside of this package. # 3. If you have more than 1 or 2 parameters, especially if they are not required, # use named parameters such as in createRadioButton. By putting stuff in a # hash we gain the flexibility to add more optional parameters without having # to pass in '' placeholders or modify existing code. # 4. Subs starting with 'create' should return a string. # 5. Subs starting with 'display' are expected to contain print statements # 6. Use ' and " where appropriate. If you don't have any variables or newlines # then use ', its quicker and cleaner. # 7. Don't put all text on one huge long line. It messes with some programs # that don't do line wraps. use strict; use warnings; use Gm_Utils qw( println ); use Gm_Constants; use Gm_Storage; use Gm_Trace; use vars qw($gmversion $gmheadtag $gmframetop $gmfonttag $gmframebottom $gmadmincss); $gmversion = Gm_Constants::GM_VERSION; ## god this is stupid, just so the below blocks don't crap ## TODO MOVE TO SOMEOTHER FILE AS SEMI CONSTANTS OR SOMETHING OR CLEAN UP $gmadmincss = qq# #; ## Some TEMP STUFF, PUT THIS BACK IN LIBRARY OR SOMETHING WHEN ITS CLEANED UP $gmheadtag = qq# Greymatter $gmadmincss #; $gmfonttag = qq(); $gmframetop = qq(

$gmfonttaggreymatter $gmversion

$gmfonttag); $gmframebottom = qq(

v$gmversion · ©2000-2006 The Greymatter Team

); ## TODO, make this stuff POD, at least its a standard ... ## Get Web Params # Will get the parameters from the web request # RETURN: a reference to a hash of the web params sub getWebParams { my (%params) = @_; ## NOTE THIS SHOULD BE SWITCHED TO USE THE CGI.PM MODULE # However, due to the use of the 'thomas' variable, see gm.cgi, we can't do that # yet, CGI.pm was introduced to perl v. 5.004 ## Loading up vars from params my $errHandler = $params{'errHandler'} || \&Gm_Utils::gmWarn; my (%IN) = (); my $input = ''; if ($ENV{'REQUEST_METHOD'} eq 'GET'){ $input = $ENV{'QUERY_STRING'}; } else { unless( read(STDIN, $input, $ENV{'CONTENT_LENGTH'} ) == $ENV{'CONTENT_LENGTH'} ){ $input = ''; } } my @pairs = split(/&/, $input); foreach my $pair (@pairs) { my ($name, $value) = split(/=/, $pair); &Gm_Trace::Trace(level => 4, msg => ":$name:$value:"); $name =~ tr/+/ /; ## this could be done differently, but is pack less susceptable to chr? $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; ## for bookmarklets? unless( ($name eq 'logtext') || ($name eq 'loglink') ){ $value =~ tr/+/ /; } $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; #warn "($name, $value)"; ## NOTE that we may not want to put every variable to the same test, some # we can trust more than others, such as the author's entry text, this current # stops someone from posting about the very issues we are trying to stop. # ALSO this messes with saving TEMPLATES and CONFIGS (where those chars can be legit) unless( $name =~ m/^edited/i || $name =~ m/template$/i ){ #warn "($name, $value)"; if( Gm_Utils::hackWebTest( $name ) || Gm_Utils::hackClTest( $name ) || Gm_Utils::hackWebTest( $value ) || Gm_Utils::hackClTest( $value ) ){ &$errHandler('We don\'t take kindly to that sort of activity here. '. 'Your attempt to break the script has been logged and the administrators have '. 'been notified.
'); ## TODO MAKE UTIL HACKNOTIFY FUNCTION, see changelog todo } } # What if we have multiple values for the form element, hmm? if( exists( $IN{$name} ) && defined( $IN{$name} )){ if( $name eq "thomas" ){ # For some reason, this variable appears multiple times on a page, # perhaps so a reload won't mess with it? Who knows..., but anyway # DO NOT APPEND, must replace $IN{$name} = $value; &Gm_Trace::Trace(level => 4, msg => "1:$name:$value:"); warn 'Avoiding appending because of "thomas" variable, bad!'; } else { # really append $IN{$name} .= "\t$value"; &Gm_Trace::Trace(level => 4, msg => "2:$name:$value:"); } } else { $IN{$name} = $value; &Gm_Trace::Trace(level => 4, msg => "3:$name:$value:"); } } return( \%IN ); } ## Create Radio Button # Will return a string of html that represents a radio button # ARG name: name of the radio button # ARG value: the value of the radio button # ARG checked: will compare this to 'value' to see if should be checked # RETURN: the radio html sub createRadioButton { my (%params) = @_; my $name = $params{'name'} || ''; my $value = $params{'value'} || ''; my $checked = $params{'checked'} || ''; my $line = ''; return $line; } ## Print Request Header # Will return the header for the http request (NOT the html header). Can be # modified here to incorperate cookie and other logic. # RETURN: the request header sub createRequestHeader { return "Content-type: text/html\n\n"; } ## Create User Error # Will create the user error using the correct templates # ARG1: Error string # RETURN: the User Error html sub createUserError { my $dangerwarning = shift; # NOTE that we are using the adminerror handler, since we are in the user # if we can't create the user error, calling displayUserErrorExit == infinite loop my $gmTemplates = Gm_Storage::getTemplates( errHandler=>\&displayAdminErrorExit); my $line = $gmTemplates->{'gmusererrorheadertemplate'}; #User error header $line .= $dangerwarning; $line .= $gmTemplates->{'gmusererrorfootertemplate'}; #User error footer # TODO makes this gracefully do template replacement ## currently cannot handle it because gm_formatentry calls ## gm_generatecalendar which enters into a loop that depends on ## a variable being set: gm_generatecalendar (at least, to research further) return $line; } ## Create User Error # Will create the user error using the correct templates # ARG1: Error string # RETURN: the User Error html sub createAdminError { my $dangerwarning = shift; my $line = "$gmheadtag\n$gmframetop"; $line .= "Error Notice

$dangerwarning"; $line .= "$gmframebottom

\n"; return $line; } ## Error Page Exit # Private sub that will display the header, given error message, and exit. # ARG1: Error string to print sub _displayErrorPageExit{ my $error = shift; println( createRequestHeader() ); println( $error ); exit; # its an error so we are done } ## Display User Page Exit # Will display the given error message, print the header, and exit. # ARG1: Error string to print sub displayUserErrorExit { my $error = shift; _displayErrorPageExit( createUserError( $error ) ); } ## Display Admin Error Page Exit # Will display the given error message, print the header, and exit. # ARG1: Error string to print # DEPRECATES: gm_dangermouse sub displayAdminErrorExit { my $error = shift; _displayErrorPageExit( createAdminError( $error ) ); } 1;