mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-16 06:14:59 +00:00
2a8be7bbf6
extras/*/*.m: Replace the use of '__' as a module qualifier in the rest of the extras. s/io\.state/io/ in the extras. Use '=' instead of is/2 in a spot.
244 lines
8.8 KiB
Mathematica
244 lines
8.8 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 1997-2001, 2006 The University of Melbourne.
|
|
% This file may only be copied under the terms of the GNU Library General
|
|
% Public License - see the file COPYING.LIB in the Mercury distribution.
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% File: cgi.m.
|
|
% Author: fjh.
|
|
%
|
|
% This module provides a Mercury interface to HTML forms using CGI.
|
|
% For documentation on HTML forms and the CGI interface, see
|
|
% <http://www.ncsa.uiuc.edu/SDG/Software/Mosaic/Docs/fill-out-forms/
|
|
% overview.html>.
|
|
%
|
|
% This is intended to conform to versions 1.0 and 1.1 of the
|
|
% CGI specification.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module cgi.
|
|
:- interface.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module io.
|
|
:- import_module maybe.
|
|
:- import_module string.
|
|
|
|
% cgi.get_form(MaybeFormEntries):
|
|
% This procedure should be called form within a CGI program
|
|
% that should be invoked with a METHOD of POST.
|
|
% If all goes well, it will return the form entries.
|
|
% If something goes wrong, it will print an appropriate HTML-formatted
|
|
% error message to stdout, call io.set_exit_status(1),
|
|
% and return `no'.
|
|
:- pred cgi.get_form(maybe(assoc_list(string, string))::out,
|
|
io::di, io::uo) is det.
|
|
|
|
% cgi.maybe_get_form(MaybeFormEntries):
|
|
% This procedure should be called form within a CGI program
|
|
% that *may* be invoked with a METHOD of POST.
|
|
% If all goes well, it will return the form entries.
|
|
% If not invoked using a METHOD of POST, it will return `no'.
|
|
% If something goes wrong, it will print an appropriate HTML-formatted
|
|
% error message to stdout, call io.set_exit_status(1),
|
|
% and return `no'.
|
|
:- pred cgi.maybe_get_form(maybe(assoc_list(string, string))::out,
|
|
io::di, io::uo) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module html.
|
|
|
|
:- import_module char.
|
|
:- import_module int.
|
|
:- import_module list.
|
|
:- import_module pair.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
cgi.maybe_get_form(FormEntries) -->
|
|
io.get_environment_var("REQUEST_METHOD", REQUEST_METHOD),
|
|
( { REQUEST_METHOD \= yes("POST") } ->
|
|
{ FormEntries = no }
|
|
;
|
|
cgi.get_form_contents(FormEntries)
|
|
).
|
|
|
|
cgi.get_form(FormEntries) -->
|
|
io.get_environment_var("REQUEST_METHOD", REQUEST_METHOD),
|
|
( { REQUEST_METHOD \= yes("POST") } ->
|
|
cgi.error([
|
|
"This script should be referenced with a ",
|
|
"<code>REQUEST_METHOD</code> of <code>POST</code>.\n\n",
|
|
"If you don't understand this, see this ",
|
|
"<A HREF=""http://www.ncsa.uiuc.edu/SDG/Software/Mosaic/Docs",
|
|
"/fill-out-forms/overview.html"">forms overview</A>.\n"
|
|
]),
|
|
{ FormEntries = no }
|
|
;
|
|
cgi.get_form_contents(FormEntries)
|
|
).
|
|
|
|
:- pred cgi.get_form_contents(maybe(assoc_list(string, string))::out,
|
|
io::di, io::uo) is det.
|
|
|
|
cgi.get_form_contents(FormEntries) -->
|
|
io.get_environment_var("CONTENT_TYPE", CONTENT_TYPE),
|
|
io.get_environment_var("CONTENT_LENGTH", CONTENT_LENGTH),
|
|
( { CONTENT_TYPE \= yes("application/x-www-form-urlencoded") } ->
|
|
cgi.error([
|
|
"This script can only be used to decode form results.\n",
|
|
"It should be referenced with a <code>CONTENT_TYPE</code> of ",
|
|
"<code>application/x-www-form-urlencoded</code>.\n\n",
|
|
"If you don't understand this, see this ",
|
|
"<A HREF=""http://www.ncsa.uiuc.edu/SDG/Software/Mosaic/Docs",
|
|
"/fill-out-forms/overview.html"">forms overview</A>.\n"
|
|
]),
|
|
{ FormEntries = no }
|
|
;
|
|
{ CONTENT_LENGTH = yes(ContentLengthString) },
|
|
{ string.to_int(ContentLengthString, ContentLength) },
|
|
{ ContentLength >= 0 }
|
|
->
|
|
cgi.get_form_contents(ContentLength, FormEntries)
|
|
;
|
|
cgi.error([
|
|
"Invalid <code>CONTENT_LENGTH</code>.\n",
|
|
"This may be due to a bug in your WWW browser?\n"
|
|
]),
|
|
{ FormEntries = no }
|
|
).
|
|
|
|
:- pred cgi.get_form_contents(int::in, maybe(assoc_list(string, string))::out,
|
|
io::di, io::uo) is det.
|
|
cgi.get_form_contents(ContentLength, MaybeFormEntries) -->
|
|
cgi.read_n_characters(ContentLength, Chars, Result),
|
|
( { Result = eof },
|
|
cgi.error([
|
|
"Unexpected end-of-file, or invalid ",
|
|
"<code>CONTENT_LENGTH</code>.\n\n",
|
|
"This may be due to a bug in your WWW browser?\n"
|
|
]),
|
|
{ MaybeFormEntries = no }
|
|
; { Result = error(Error) },
|
|
{ io.error_message(Error, ErrorMsg) },
|
|
cgi.error([
|
|
"I/O error reading standard input: ", ErrorMsg, "\n\n"
|
|
]),
|
|
{ MaybeFormEntries = no }
|
|
; { Result = ok },
|
|
( { cgi.parse_form_entries(FormEntries, Chars, []) } ->
|
|
{ MaybeFormEntries = yes(FormEntries) }
|
|
;
|
|
{ MaybeFormEntries = no }
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred cgi.read_n_characters(int, list(char), io.result,
|
|
io, io).
|
|
:- mode cgi.read_n_characters(in, out, out, di, uo) is det.
|
|
|
|
cgi.read_n_characters(NumChars, Chars, Result) -->
|
|
cgi.read_n_characters_rev(NumChars, [], RevChars, Result),
|
|
{ list.reverse(RevChars, Chars) }.
|
|
|
|
:- pred cgi.read_n_characters_rev(int, list(char), list(char), io.result,
|
|
io, io).
|
|
:- mode cgi.read_n_characters_rev(in, in, out, out, di, uo) is det.
|
|
|
|
cgi.read_n_characters_rev(NumChars, Chars0, Chars, Result) -->
|
|
( { NumChars = 0 } ->
|
|
{ Result = ok },
|
|
{ Chars = Chars0 }
|
|
;
|
|
io.read_char(CharResult),
|
|
( { CharResult = eof },
|
|
{ Result = eof },
|
|
{ Chars = Chars0 }
|
|
; { CharResult = error(Error) },
|
|
{ Result = error(Error) },
|
|
{ Chars = Chars0 }
|
|
; { CharResult = ok(Char) },
|
|
{ NumChars1 is NumChars - 1 },
|
|
read_n_characters_rev(NumChars1, [Char | Chars0], Chars, Result)
|
|
)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred cgi.parse_form_entries(assoc_list(string, string),
|
|
list(char), list(char)).
|
|
:- mode cgi.parse_form_entries(out, in, out) is semidet.
|
|
|
|
cgi.parse_form_entries(FormEntries) -->
|
|
cgi.parse_form_entry(Name, Value),
|
|
( ['&'] ->
|
|
cgi.parse_form_entries(Rest),
|
|
{ FormEntries = [Name - Value | Rest] }
|
|
;
|
|
{ FormEntries = [Name - Value] }
|
|
).
|
|
|
|
:- pred cgi.parse_form_entry(string, string, list(char), list(char)).
|
|
:- mode cgi.parse_form_entry(out, out, in, out) is semidet.
|
|
|
|
cgi.parse_form_entry(Name, Value) -->
|
|
cgi.parse_word(Name),
|
|
['='],
|
|
cgi.parse_word(Value).
|
|
|
|
:- pred cgi.parse_word(string, list(char), list(char)).
|
|
:- mode cgi.parse_word(out, in, out) is semidet.
|
|
|
|
cgi.parse_word(Word) -->
|
|
cgi.parse_word_chars([], WordChars),
|
|
{ string.from_rev_char_list(WordChars, Word) }.
|
|
|
|
:- pred cgi.parse_word_chars(list(char), list(char), list(char), list(char)).
|
|
:- mode cgi.parse_word_chars(in, out, in, out) is semidet.
|
|
|
|
cgi.parse_word_chars(RevChars0, RevChars) -->
|
|
( [Char], { Char \= ('&'), Char \= ('=') } ->
|
|
( { Char = ('%') } ->
|
|
[Hex1, Hex2],
|
|
{ hex_pair_to_char(Hex1, Hex2, RealChar) }
|
|
; { Char = ('+') } ->
|
|
{ RealChar = ' ' }
|
|
;
|
|
{ RealChar = Char }
|
|
),
|
|
cgi.parse_word_chars([RealChar | RevChars0], RevChars)
|
|
;
|
|
{ RevChars = RevChars0 }
|
|
).
|
|
|
|
:- pred hex_pair_to_char(char::in, char::in, char::out) is semidet.
|
|
|
|
hex_pair_to_char(Hex1, Hex2, Char) :-
|
|
char.is_hex_digit(Hex1),
|
|
char.is_hex_digit(Hex2),
|
|
char.digit_to_int(Hex1, Int1),
|
|
char.digit_to_int(Hex2, Int2),
|
|
Val = Int1 * 16 + Int2,
|
|
char.to_int(Char, Val).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred cgi.error(list(string)::in, io::di, io::uo) is det.
|
|
|
|
cgi.error(MessageList) -->
|
|
{ string.append_list(MessageList, Message) },
|
|
output_content_type_html,
|
|
html.output_html(html([title(text("CGI Error Message"))],
|
|
(heading(1, text("CGI Error")),
|
|
markup(Message)))),
|
|
io.set_exit_status(1).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|