1% ---------------------------------------------------------------------- 2% BEGIN LICENSE BLOCK 3% Version: CMPL 1.1 4% 5% The contents of this file are subject to the Cisco-style Mozilla Public 6% License Version 1.1 (the "License"); you may not use this file except 7% in compliance with the License. You may obtain a copy of the License 8% at www.eclipse-clp.org/license. 9% 10% Software distributed under the License is distributed on an "AS IS" 11% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 12% the License for the specific language governing rights and limitations 13% under the License. 14% 15% The Original Code is The ECLiPSe Constraint Logic Programming System. 16% The Initial Developer of the Original Code is Cisco Systems, Inc. 17% Portions created by the Initial Developer are 18% Copyright (C) 1989-2006 Cisco Systems, Inc. All Rights Reserved. 19% 20% Contributor(s): ECRC GmbH 21% Contributor(s): IC-Parc, Imperal College London 22% 23% END LICENSE BLOCK 24% 25% System: ECLiPSe Constraint Logic Programming System 26% Version: $Id: cgi.pl,v 1.2 2009/07/16 09:11:24 jschimpf Exp $ 27% ---------------------------------------------------------------------- 28 29% 30% ECLiPSe PROLOG LIBRARY MODULE 31% 32% $Id: cgi.pl,v 1.2 2009/07/16 09:11:24 jschimpf Exp $ 33% 34% IDENTIFICATION: cgi.pl 35% 36% AUTHOR: Joachim Schimpf 37% 38% CONTENTS: Some utilities for writing cgi scripts with ECLiPSe 39% 40 41:- module(cgi). 42:- export 43 posted_params/1, 44 get_error_output/1, 45 get_param_value/3, 46 substitute_placeholders/3. 47 48:- comment(categories, ["Interfacing"]). 49:- comment(summary, "Some utilities for writing cgi scripts with ECLiPSe"). 50:- comment(author, "Joachim Schimpf, IC-Parc, Imperial College, London"). 51:- comment(copyright, "Cisco Systems, Inc"). 52:- comment(date, "$Date: 2009/07/16 09:11:24 $"). 53 54:- comment(posted_params/1, [ 55 template:"posted_params(-NameValuePairs)", 56 summary:"Returns the parameters posted to the CGI script", 57 fail_if:"There was a problem obtaining the parameters from the environment", 58 see_also:[get_param_value/3,substitute_placeholders/3,get_error_output/1], 59 desc:html("Returns a list of Name=Value pairs, where Name is an atom 60 and Value is a string, representing the information that was posted to 61 the CGI script. Both POST and GET methods are supported. 62 <P> 63 If there is a problem, the predicate fails. In that case, the caller should 64 retrieve an error message using get_error_output/1 and present it to the 65 user, e.g. by embedding it into the generated html page. 66 ") 67 ]). 68 69:- comment(get_param_value/3, [ 70 template:"get_param_value(+NameValuePairs, +Name, ?Value)", 71 summary:"Look up the value of a posted parameter", 72 see_also:[posted_params/1,substitute_placeholders/3], 73 desc:html("Look up the value of a posted parameter. Returns an empty string 74 if there is no parameter with the given name. Name must be an atom.") 75 ]). 76 77:- comment(substitute_placeholders/3, [ 78 template:"substitute_placeholders(+PageTemplate, +NameValuePairs, -Page)", 79 summary:"Substitute placeholders in a html source with a value string", 80 desc:html("Takes a string (usually a html-source) with embedded 81 placeholders and replaces the placeholders by their value according 82 to the NameValuePairs argument. The syntax for placeholders is their 83 name enclosed in ^ (up arrow) characters."), 84 see_also:[posted_params/1,get_param_value/3] 85 ]). 86 87:- comment(get_error_output/1, [ 88 template:"get_error_output(-Message)", 89 summary:"Retrieve error messages explaining failure of posted_params/1", 90 see_also:[posted_params/1] 91 ]). 92 93 94% suppress "compiled" messages 95:- set_event_handler(139, true/0). 96 97% redirect error output into a string stream 98:- open(string(""), write, error). 99 100get_error_output(Messages) :- 101 get_stream_info(error, name, Messages). 102 103 104posted_params(NameValuePairs) :- 105 ( getenv('REQUEST_METHOD', Method) -> 106 ( Method == "POST" -> 107 ( getenv('CONTENT_LENGTH', ContentLengthString) -> 108 ( number_string(ContentLength, ContentLengthString), 109 ( read_string("", ContentLength, String) -> 110 true 111 ; 112 writeln(error, "Standard input empty"), 113 fail 114 ) 115 ; 116 writeln(error, "CONTENT_LENGTH does not contain a number"), 117 fail 118 ) 119 ; 120 writeln(error, "Environment variable CONTENT_LENGTH not set"), 121 fail 122 ) 123 ; Method == "GET" -> 124 ( getenv('QUERY_STRING', String) -> 125 true 126 ; 127 String="" 128 ) 129 ; 130 printf(error, "Illegal method: %q%n", [Method]), 131 fail 132 ) 133 ; 134 writeln(error, "Environment variable REQUEST_METHOD not set"), 135 fail 136 ), 137% log_request(String), 138 split_string(String, "&", "", NameEqValueStrings), 139 decode_defs(NameEqValueStrings, NameValuePairs). 140 141 log_request(String) :- 142 get_flag(pid, Pid), 143 concat_string(["/tmp/timesheetlog",Pid], Logfile), 144 open(Logfile, write, S), 145 write(S, String), 146 close(S). 147 148 decode_defs([], []). 149 decode_defs([NameEqValueString|Ins], Outs) :- 150 ( split_string(NameEqValueString, "=", "", [NameString,RawValue]) -> 151 atom_string(Name, NameString), 152 string_list(RawValue, RawValueList), 153 dequote(RawValueList, ValueList), 154 string_list(Value, ValueList), 155 Outs = [Name=Value|Outs0] 156 ; 157 Outs = Outs0 158 ), 159 decode_defs(Ins, Outs0). 160 161 :- mode dequote(+,-). 162 dequote([], []). 163 dequote([0'+|More], [0' |Cs]) :- !, 164 dequote(More, Cs). 165 dequote([0'%,H,L|More], [C|Cs]) :- 166 hex(H, HX), 167 hex(L, LX), 168 !, 169 C is HX*16+LX, 170 dequote(More, Cs). 171 dequote([C|More], [C|Cs]) :- 172 dequote(More, Cs). 173 174 :- mode hex(+,-). 175 hex(0'0, 0). hex(0'1, 1). hex(0'2, 2). hex(0'3, 3). hex(0'4, 4). 176 hex(0'5, 5). hex(0'6, 6). hex(0'7, 7). hex(0'8, 8). hex(0'9, 9). 177 hex(0'A, 10). hex(0'B, 11). hex(0'C, 12). hex(0'D, 13). hex(0'E, 14). hex(0'F, 15). 178 hex(0'a, 10). hex(0'b, 11). hex(0'c, 12). hex(0'd, 13). hex(0'e, 14). hex(0'f, 15). 179 180 181get_param_value([], _, ""). 182get_param_value([NameEqValue|T], Name, Value) :- 183 ( NameEqValue = (Name=Value) -> 184 true 185 ; 186 get_param_value(T, Name, Value) 187 ). 188 189 190substitute_placeholders(PageTemplate, NameValuePairs0, Page) :- 191 NameValuePairs = [''="^"|NameValuePairs0], 192 split_string(PageTemplate, "^", "", Parts), 193 ( 194 fromto(Parts, [Text, ParName|Parts1], Parts1, [Last]), 195 fromto(ExpParts, [Text, ParValue|ExpParts1], ExpParts1, [Last]), 196 param(NameValuePairs) 197 do 198 atom_string(ParNameA, ParName), 199 get_param_value(NameValuePairs, ParNameA, ParValue) 200 ), 201 concat_string(ExpParts, Page). 202 203