Anubis / Xlib | GitLab

Browse Code »

Commit 9ca943bd56b1b4602b82d993dc5bc67a7b999ece

Authored by Cédric RICARD 2008-08-28 16:24:39 +0000

1 parent 291234f3

Calexium_lib branch for MF 1.1

Showing 22 changed files with 15059 additions and 0 deletions Show diff stats

Inline Side-by-side

MF_1_1/CXM_errors.anubis 0 → 100644

Wrap text Show/Hide comments View file @9ca943b

	1	+/*
	2	+ * Created by PyramIDE.
	3	+ * User: ricard
	4	+ * Date: 16/09/2007
	5	+ * Time: 21:10
	6	+ *
	7	+ * To change this template use Tools \| Options \| Coding \| Edit Standard Headers.
	8	+ */
	9	+
	10	+public type GeneralError:
	11	+ ok,
	12	+ unknown(Word32 val),
	13	+ bad_type,
	14	+ bad_value,
	15	+ bad_parameters,
	16	+ no_init,
	17	+ unknown_command,
	18	+ wrong_authentification, // Wrong login or password
	19	+ access_denied, // login ok but no suffisiant right to access to this area. Can be use with wrong authentification too...
	20	+ io_error, // general error on reading or writing from/to IO (file, socket, etc...)
	21	+ cant_start_process. // A execute to an external process has failed
	22	+
	23	+public define Word32
	24	+ to_Word32
	25	+ (
	26	+ GeneralError e
	27	+ ) =
	28	+ if e is
	29	+ {
	30	+ ok then 0,
	31	+ unknown(val) then val,
	32	+ bad_type then 0x1,
	33	+ bad_value then 0x2,
	34	+ bad_parameters then 0x3,
	35	+ no_init then 0x4,
	36	+ unknown_command then 0x5,
	37	+ wrong_authentification then 0x6,
	38	+ access_denied then 0x7,
	39	+ io_error then 0x8,
	40	+ cant_start_process then 0x9,
	41	+ }.
...	...

MF_1_1/CXM_message_constants.anubis 0 → 100644

Wrap text Show/Hide comments View file @9ca943b

	1	+/*
	2	+ *
	3	+ * User: David RENE
	4	+ * Date: 07/04/2007
	5	+ * Time: 16:06
	6	+ * (c) Calexium
	7	+ *
	8	+ * To change this template use Tools \| Options \| Coding \| Edit Standard Headers.
	9	+ */
	10	+
	11	+ // ************** PACKAGE BUILDER *************
	12	+
	13	+public define Word32 _CXM_PKG_MSG_BASIS = 0x33770400. //
	14	+public define Word32 _CXM_PKG_CONTAINER = 0x33770401.
	15	+public define Word32 _CXM_PKG_HEADER_PART = 0x33770402. // Header Message for Script
	16	+public define Word32 _CXM_PKG_SCRIPT_PART = 0x33770403. // Main Message for Script
	17	+public define Word32 _CXM_PKG_S_ADD_FILE = 0x33770404. // script action to add file in the destination
	18	+public define Word32 _CXM_PKG_S_RUN = 0x33770405. // script action to run a command
	19	+public define Word32 _CXM_PKG_INDEX_PART = 0x33770440. // ID of package Index part
	20	+public define Word32 _CXM_PKG_IDX_ENTRY = 0x33770441. // Index entry information
	21	+
	22	+ // ************** UPDATE SERVICE *************
	23	+
	24	+public define Word32 _CXM_UPDATE_SERVICE_MSG_BASIS = 0x33770800. //
	25	+public define Word32 _CXM_UPD_SERVICE_ID = 0x33770801.
	26	+public define Word32 _CXM_UPD_HAS_UPDATE = 0x33770802. //
	27	+
	28	+ // ************** SERVICE NEGOCIATION *************
	29	+
	30	+public define Word32 _CXM_SERVICE_NEGOCIATION_BASIS = 0x33770C00. //
	31	+public define Word32 _CXM_REQUEST_FOR_SERVICE = 0x33770C01. //
	32	+
	33	+ // ************** GENERIC PROTOCOL *************
	34	+
	35	+public define Word32 _CXM_GENERIC_PROTOCOL_BASIS = 0x33771000. //
	36	+public define Word32 _CXM_ACK = 0x33771001. //
	37	+public define Word32 _CXM_ACK_RESULT_MSG = 0x33771002. //
	38	+
	39	+ // ************** FTP SERVICE *************
	40	+
	41	+public define Word32 _CXM_FTP_SERVICE_MSG_BASIS = 0x33771400. //
	42	+public define Word32 _CXM_FTP_SERVICE_ID = 0x33771401.
	43	+public define Word32 _CXM_FTP_GET_FILE = 0x33771402.
	44	+public define Word32 _CXM_FTP_START_TRANSFERT = 0x33771403.
	45	+public define Word32 _CXM_FTP_DATA = 0x33771404.
	46	+
	47	+ // ************ LOGGER SERVICE ************
	48	+
	49	+public define Word32 _CXM_LOGGER_SERVICE_MSG_BASIS = 0x33771800. //
	50	+public define Word32 _CXM_LOGGER_SERVICE_ID = 0x33771801.
	51	+public define Word32 _CXM_LOGGER_LOG = 0x33771802.
	52	+
	53	+ // ************ DOMAIN SERVICE ************
	54	+
	55	+// MF <-> DomainManager
	56	+public define Word32 _CXM_DOMAIN_SERVICE_MSG_BASIS = 0x33771C00. //
	57	+public define Word32 _CXM_DOMAIN_SERVICE_ID = 0x33771C01.
	58	+public define Word32 _CXM_DOMAIN_PUBLISH_MF_CONFIG = 0x33771C02.
	59	+public define Word32 _CXM_DOMAIN_GET_NAME = 0x33771C03.
	60	+public define Word32 _CXM_DOMAIN_GET_MY_IP = 0x33771C04.
	61	+public define Word32 _CXM_DOMAIN_PUBLISH_MY_IP = 0x33771C05.
	62	+public define Word32 _CXM_DOMAIN_PUBLISH_DYN_TEST = 0x33771C06.
	63	+public define Word32 _CXM_DOMAIN_GET_STATUS = 0x33771C07.
	64	+public define Word32 _CXM_DOMAIN_GET_DOMAIN_INFO = 0x33771C08.
	65	+
	66	+
	67	+// DomainManager <-> Gandi
	68	+public define Word32 _CXM_GANDI_SERVICE_ID = 0x33771D00.
	69	+public define Word32 _CXM_GANDI_CHECK_AVAILABILITY = 0x33771D01. // 'NAME' (String): Base names (without extension) of the wanted domains
	70	+ // --> CXM_ACK with 'DOMAINS' (String): Array of avaiblable domains
	71	+public define Word32 _CXM_GANDI_CREATE_CONTACT = 0x33771D02. // 'CLASS' (String):
	72	+ // 'FIRSTNAME', 'LASTNAME', 'ADDRESS', 'ZIPCODE', 'CITY', 'COUNTRY', 'PHONE', 'EMAIL' (String)
	73	+ // --> CXM_ACK with 'CONTACT_HANDLE' (String): Created handle for this contact
	74	+public define Word32 _CXM_GANDI_CREATE_DOMAIN = 0x33771D03. // 'DOMAIN' (String): Domain full name
	75	+ // 'OWNER' (String): Owner handle
	76	+ // --> CXM_ACK with 'DOMAIN_HANDLE' (String): Created handle for this domain
	77	+ // ************ MF INSTALLER SERVICE ************
	78	+
	79	+public define Word32 _CXM_INSTALLER_SERVICE_MSG_BASIS= 0x33772000.
	80	+public define Word32 _CXM_INSTALLER_SERVICE_ID = 0x33772001.
	81	+public define Word32 _CXM_INSTALLER_REGISTER_APP_ID = 0x33772002.
	82	+public define Word32 _CXM_INSTALLER_GET_NEW_SERIALS = 0x33772003.
	83	+public define Word32 _CXM_INSTALLER_CONFIRM_SERIALS_PUBLICATION = 0x33772004.
...	...

MF_1_1/database/db_utils.anubis 0 → 100644

Wrap text Show/Hide comments View file @9ca943b

	1	+/*
	2	+ *
	3	+ * User: David RENE
	4	+ * Date: 11/12/2007
	5	+ * Time: 01:16
	6	+ * (c) Calexium
	7	+ *
	8	+ */
	9	+
	10	+read tools/basis.anubis
	11	+read system/logger.anubis
	12	+read data_base/sqlite.anubis
	13	+
	14	+read calexium_lib/net_services_protocols/logger_service.anubis
	15	+
	16	+
	17	+define Result(SQLite3Error, SQLite3HeadersOrRow -> SQLite3Row)
	18	+ sql_query_timeout
	19	+ (
	20	+ SQLite3DataBase db,
	21	+ String sql_command,
	22	+ Int timeout
	23	+ ) =
	24	+
	25	+ if sql_query(db, sql_command) is
	26	+ {
	27	+ error(sql_error) then (
	28	+ if (sql_error.code /= 1 & sql_error.code /= 5 & sql_error.code /= 6) \| now > timeout then
	29	+ error(sql_error)
	30	+ else
	31	+ (
	32	+ if sql_error.code = 5 then
	33	+ unique
	34	+ else
	35	+ print_db_error(sql_error)
	36	+ );
	37	+ sleep(100);
	38	+ sql_query_timeout(db, sql_command, timeout)),
	39	+ ok(cursor) then ok(cursor)
	40	+ }.
	41	+
	42	+public define Result(SQLite3Error, One)
	43	+ sql_transaction
	44	+ (
	45	+ SQLite3DataBase db,
	46	+ String sql_command,
	47	+ String message
	48	+ ) =
	49	+// logDebug(debug_log, "Entering into transaction [" + message + "].");
	50	+ if db_do_transaction(
	51	+ db,
	52	+ (One _) \|->
	53	+ if sql_query(db, sql_command) is
	54	+ {
	55	+ error(err) then logError("DB", db_error(err,message));failure //error in the SQL request
	56	+ ok(cursor) then success(unique)
	57	+ },
	58	+ success( (SQLite3Error err) \|-> logError("DB", db_error(err,message))),
	59	+ 60000, // max 60s
	60	+ 100 // retry every 100 ms
	61	+ ) is
	62	+ {
	63	+ error(err_and_result) then
	64	+// logDebug(debug_log, "Exiting from transaction [" + message + "] with error.");
	65	+ if err_and_result is (err, mb_result) then
	66	+ error(err),
	67	+ ok(_) then
	68	+// logDebug(debug_log, "Exiting from transaction [" + message + "].");
	69	+ ok(unique)
	70	+ }.
	71	+
	72	+
	73	+public define Maybe(SQLite3HeadersOrRow -> SQLite3Row)
	74	+ sql_query_timeout
	75	+ (
	76	+ SQLite3DataBase db, //database handle
	77	+ String sql_query, //sql query itself
	78	+ String msg //message to be shown if an error occure
	79	+ ) =
	80	+ //we try with 30 sec of timeout
	81	+ if sql_query_timeout(db, sql_query, now + 60) is
	82	+ {
	83	+ error(sql_error) then logError("DB", db_error(sql_error,msg));failure,
	84	+ ok(cursor) then success(cursor)
	85	+ }.
	86	+
	87	+// -- Extractors HELPERS ---------------
	88	+
	89	+public define List(String)
	90	+ db_get_string_list
	91	+ (
	92	+ SQLite3HeadersOrRow -> SQLite3Row table_cursor,
	93	+ List(String) so_far
	94	+ ) =
	95	+ if table_cursor(next_row) is
	96	+ {
	97	+ error(sql_error) then logError("DB", db_error(sql_error, "db_get_string_list")); reverse(so_far),
	98	+ no_more_row then reverse(so_far), //can't find the symbol in the table, because the row is empty
	99	+ row(explorer) then
	100	+ with s = text(explorer)(0),
	101	+ db_get_string_list(table_cursor, [s . so_far])
	102	+ }.
	103	+
	104	+public define List(Int)
	105	+ db_get_integer_list
	106	+ (
	107	+ SQLite3HeadersOrRow -> SQLite3Row table_cursor,
	108	+ List(Int) so_far
	109	+ ) =
	110	+ if table_cursor(next_row) is
	111	+ {
	112	+ error(sql_error) then logError("DB", db_error(sql_error, "db_get_integer_list")); reverse(so_far),
	113	+ no_more_row then reverse(so_far), //can't find the symbol in the table, because the row is empty
	114	+ row(explorer) then
	115	+ with s = (Int)db_integer(explorer)(0),
	116	+ db_get_integer_list(table_cursor, [s . so_far])
	117	+ }.
	118	+
	119	+
	120	+
	121	+
...	...

MF_1_1/net_services/CXM_generic_client.anubis 0 → 100644

Wrap text Show/Hide comments View file @9ca943b

	1	+/*
	2	+ * Created by PyramIDE.
	3	+ * User: ricard
	4	+ * Date: 02/02/2008
	5	+ * Time: 11:47
	6	+ *
	7	+ * To change this template use Tools \| Options \| Coding \| Edit Standard Headers.
	8	+ */
	9	+
	10	+
	11	+read tools/basis.anubis
	12	+read system/muscle.anubis
	13	+read system/data_io.anubis
	14	+read system/convert.anubis
	15	+read system/string.anubis
	16	+read system/message_queue.anubis
	17	+read system/message_transceiver.anubis
	18	+read tools/connections.anubis
	19	+
	20	+read calexium_lib/CXM_message_constants.anubis
	21	+read calexium_lib/net_services/CXM_net_services.anubis
	22	+read calexium_lib/net_services/CXM_generic_protocol.anubis
	23	+
	24	+// --Generic types---------------------------------------------------------------------
	25	+public type NetServiceAnswer:
	26	+ netservice_error (Word32 cmd,
	27	+ Word32 result_code,
	28	+ String result_string),
	29	+ netservice_ok (Word32 cmd,
	30	+ Maybe(Message) result_msg).
	31	+
	32	+// --Generic functions---------------------------------------------------------------------
	33	+
	34	+
	35	+public define Maybe(NetServiceAnswer)
	36	+ generic_send_message
	37	+ (
	38	+ MessageQueue queue,
	39	+ Message msg_to_send,
	40	+ Int timeout,
	41	+ (String) -> One logger
	42	+ )=
	43	+ queue.add_Message_to_send(msg_to_send);
	44	+ if queue.get_next_received_Message(timeout) is
	45	+ {
	46	+ timeout then logger("["+queue.get_name(unique)+"]: receive timeout");failure,
	47	+ closed then logger("["+queue.get_name(unique)+"]: socket closed");failure,
	48	+ msg(msg) then
	49	+ if find_int32(msg, "CMD") is
	50	+ {
	51	+ failure then logger("["+queue.get_name(unique)+"]: CMD field not found"); failure,
	52	+ success(cmd) then
	53	+ if find_int32(msg, "STATUS") is
	54	+ {
	55	+ failure then logger("["+queue.get_name(unique)+"]: STATUS field not found"); failure,
	56	+ success(v) then
	57	+ if v = _CXM_OK then
	58	+ success(netservice_ok(cmd, find_message(msg, "RESULT")))
	59	+ else
	60	+ with error_string = if find_string(msg, "STATUS_STR") is success(s) then s else "",
	61	+ success(netservice_error(cmd, v, error_string))
	62	+ }
	63	+ }
	64	+ }.
	65	+
	66	+public define Maybe($T)
	67	+ generic_handler
	68	+ (
	69	+ MessageQueue queue,
	70	+ Int timeout,
	71	+ Message msg_to_send,
	72	+ (Message) -> Maybe($T) handler,
	73	+ (String) -> One logger
	74	+ )=
	75	+ queue.add_Message_to_send(msg_to_send);
	76	+ if queue.get_next_received_Message(timeout) is
	77	+ {
	78	+ timeout then logger("["+queue.get_name(unique)+"]: receive timeout");failure,
	79	+ closed then logger("["+queue.get_name(unique)+"]: socket closed");failure,
	80	+ msg(msg) then
	81	+ if find_int32(msg, "STATUS") is
	82	+ {
	83	+ failure then logger("["+queue.get_name(unique)+"]: status not found");failure,
	84	+ success(v) then
	85	+ if v = _CXM_OK then
	86	+ //println("generic_handler("+queue.get_name(unique)+"): message status ok");
	87	+ if find_message(msg, "RESULT") is
	88	+ {
	89	+ failure then logger("["+queue.get_name(unique)+"]: can't find RESULT");failure,
	90	+ success(result) then handler(result)
	91	+ }
	92	+ else
	93	+ logger("["+queue.get_name(unique)+"]: message status ERROR");failure
	94	+ }
	95	+ }.
	96	+
	97	+public define (MessageQueue, String) -> Maybe($T)
	98	+ make_generic_handler
	99	+ (
	100	+ Int timeout,
	101	+ Message msg_to_send,
	102	+ (Message) -> Maybe($T) handler,
	103	+ (String) -> One logger
	104	+ ) =
	105	+ (MessageQueue queue, String timestamp) \|->
	106	+ generic_handler(queue, timeout, msg_to_send, handler, logger).
	107	+
	108	+define Maybe($T)
	109	+ generic_request_for_service
	110	+ (
	111	+ MessageQueue queue,
	112	+ Word32 service_id,
	113	+ Word32 service_version,
	114	+ (MessageQueue, String) -> Maybe($T) handler,
	115	+ (String) -> One logger
	116	+ )=
	117	+ with test_msg = message(_CXM_REQUEST_FOR_SERVICE),
	118	+ forget(add_int32(test_msg, "SERVICE", service_id));
	119	+ forget(add_int32(test_msg, "VERSION", service_version));
	120	+ queue.add_Message_to_send(test_msg);
	121	+ if queue.get_next_received_Message(10) is
	122	+ {
	123	+ timeout then logger("["+queue.get_name(unique)+"]: requesting service receive timeout");failure,
	124	+ closed then logger("["+queue.get_name(unique)+"]: requesting service socket closed");failure,
	125	+ msg(msg) then
	126	+ if find_int32(msg, "STATUS") is
	127	+ {
	128	+ failure then logger("["+queue.get_name(unique)+"]: requesting service STATUS not found");failure,
	129	+ success(v) then
	130	+ if v = _CXM_OK then
	131	+ if find_message(msg, "RESULT") is
	132	+ {
	133	+ failure then logger("["+queue.get_name(unique)+"]: requesting service RESULT not found");failure,
	134	+ success(result) then
	135	+ with timestamp = if find_string(result, "TIMESTAMP") is
	136	+ {
	137	+ failure then logger("["+queue.get_name(unique)+"]: requesting service TIMESTAMP not found"); "",
	138	+ success(timestamp) then timestamp
	139	+ },
	140	+ handler(queue, timestamp)
	141	+ }
	142	+ else
	143	+ logger("["+queue.get_name(unique)+"]: requested service started won't start");failure
	144	+ }
	145	+ }.
	146	+
	147	+public define Maybe($T)
	148	+ generic_connect_to_net_service
	149	+ (
	150	+ String queue_name,
	151	+ Word32 server,
	152	+ Word32 port,
	153	+ Word32 service_id,
	154	+ Word32 service_version,
	155	+ (MessageQueue, String) -> Maybe($T) handler,
	156	+ (String) -> One logger
	157	+ )
	158	+ =
	159	+ if connect( server, port) is
	160	+ {
	161	+ error(_) then logger(queue_name + ": Can't connect to domain manager ["+ip_addr_to_string(server)+":"+port+"]");failure,
	162	+ ok(conn) then
	163	+ with queue = create_MessageQueue(queue_name),
	164	+ message_transceiver(tcp(conn), queue);
	165	+ with result = generic_request_for_service(queue, service_id, service_version, handler, logger),
	166	+ queue.quit(unique);
	167	+ //logInfo(debug_log,"domain_manager client quit");
	168	+ result
	169	+ }.
	170	+
	171	+public define Maybe($T)
	172	+ generic_connect_to_net_service_SSL
	173	+ (
	174	+ String queue_name,
	175	+ String server_name,
	176	+ Word32 server_ip,
	177	+ Word32 port,
	178	+ (Maybe(X509)) -> Bool accept_policy, // your policy for accepting the server certificate in
	179	+ // case of an invalid, non trusted or missing certificate
	180	+ Word32 service_id,
	181	+ Word32 service_version,
	182	+ (MessageQueue, String) -> Maybe($T) handler,
	183	+ (String) -> One logger
	184	+ )
	185	+ =
	186	+ if open_SSL_connection( server_name, server_ip, port, accept_policy) is
	187	+ {
	188	+ error(_) then logger(queue_name + ": Can't connect to domain manager ["+ip_addr_to_string(server_ip)+":"+port+"]");failure,
	189	+ ok(conn) then
	190	+ with queue = create_MessageQueue(queue_name),
	191	+ message_transceiver(ssl(conn), queue);
	192	+ with result = generic_request_for_service(queue, service_id, service_version, handler, logger),
	193	+ queue.quit(unique);
	194	+ //logInfo(debug_log,"domain_manager client quit");
	195	+ result
	196	+ }.
...	...

MF_1_1/net_services/CXM_generic_protocol.anubis 0 → 100644

Wrap text Show/Hide comments View file @9ca943b

	1	+/*
	2	+ *
	3	+ * User: David RENE
	4	+ * Date: 25/04/2007
	5	+ * Time: 16:20
	6	+ * (c) Calexium
	7	+ *
	8	+ */
	9	+
	10	+read system/muscle.anubis
	11	+read system/data_io.anubis
	12	+read system/string.anubis
	13	+read tools/basis.anubis
	14	+read system/message_queue.anubis
	15	+read calexium_lib/CXM_message_constants.anubis
	16	+
	17	+public define Word32 _CXM_OK = 0.
	18	+public define Word32 _CXM_ERROR = 1.
	19	+public define Word32 _CXM_UNKNOW_CMD = 2.
	20	+public define Word32 _CXM_UNKNOW_SERVICE = 3.
	21	+
	22	+public type ProtocolResult:
	23	+ failure,
	24	+ timeout,
	25	+ unknow_cmd,
	26	+ error,
	27	+ ok,
	28	+ ok_msg(Message).
	29	+
	30	+public define One
	31	+ send_ACK_error
	32	+ (
	33	+ MessageQueue queue,
	34	+ Word32 cmd_id,
	35	+ Word32 error_code,
	36	+ String error_string,
	37	+ )=
	38	+ with err_msg = message(_CXM_ACK),
	39	+ forget(add_int32(err_msg, "CMD", cmd_id));
	40	+ forget(add_int32(err_msg, "STATUS", error_code));
	41	+ (if error_string /= "" then forget(add_string(err_msg, "STATUS_STR", error_string))
	42	+ else unique);
	43	+ forget(queue.add_Message_to_send(err_msg)).
	44	+
	45	+public define One
	46	+ send_ACK_error
	47	+ (
	48	+ MessageQueue queue,
	49	+ Word32 cmd_id
	50	+ )=
	51	+ send_ACK_error(queue, cmd_id, _CXM_ERROR, "").
	52	+
	53	+public define One
	54	+ send_ACK_ok
	55	+ (
	56	+ MessageQueue queue,
	57	+ Word32 cmd_id
	58	+ )=
	59	+ with ok_msg = message(_CXM_ACK),
	60	+ forget(add_int32(ok_msg, "CMD", cmd_id));
	61	+ forget(add_int32(ok_msg, "STATUS", _CXM_OK));
	62	+ forget(queue.add_Message_to_send(ok_msg))
	63	+ .
	64	+
	65	+public define One
	66	+ send_ACK_ok
	67	+ (
	68	+ MessageQueue queue,
	69	+ Word32 cmd_id,
	70	+ Message result
	71	+ )=
	72	+ with ok_msg = message(_CXM_ACK),
	73	+ forget(add_int32(ok_msg, "CMD", cmd_id));
	74	+ forget(add_int32(ok_msg, "STATUS", _CXM_OK));
	75	+ forget(add_message(ok_msg, "RESULT", result));
	76	+ forget(queue.add_Message_to_send(ok_msg))
	77	+ .
	78	+
	79	+public define One
	80	+ send_result
	81	+ (
	82	+ MessageQueue queue,
	83	+ Word32 cmd_id,
	84	+ Maybe(Message) mb_msg
	85	+ )=
	86	+ if mb_msg is
	87	+ {
	88	+ failure then send_ACK_error(queue, cmd_id),
	89	+ success(msg) then send_ACK_ok(queue, cmd_id, msg)
	90	+ }.
	91	+
	92	+public define One
	93	+ send_result
	94	+ (
	95	+ MessageQueue queue,
	96	+ Word32 cmd_id,
	97	+ Bool result
	98	+ )=
	99	+ if result then
	100	+ send_ACK_ok(queue, cmd_id)
	101	+ else
	102	+ send_ACK_error(queue, cmd_id).
	103	+
	104	+public define ProtocolResult
	105	+ wait_for_reply
	106	+ (
	107	+ MessageQueue mQ,
	108	+ Word32 wait_cmd,
	109	+ Int t_out
	110	+ ) =
	111	+ if mQ.get_next_received_Message(t_out) is
	112	+ {
	113	+ timeout then timeout,
	114	+ closed then failure, //println("wait_for_reply closed");
	115	+
	116	+ msg(_msg) then
	117	+ if *_msg.what = _CXM_ACK then
	118	+ if find_int32(_msg, "CMD") is
	119	+ {
	120	+ failure then failure, //println("wait_for_reply CMD");
	121	+ success(cmd) then
	122	+// println("wait_for_reply CMD="+to_hexa(cmd));
	123	+ if find_int32(_msg, "STATUS") is
	124	+ {
	125	+ failure then failure, //println("wait_for_reply STATUS");
	126	+ success(status) then
	127	+ if cmd = wait_cmd & status = _CXM_OK then
	128	+ if find_message(_msg, "RESULT") is
	129	+ {
	130	+ failure then ok,
	131	+ success(ok_message) then ok_msg(ok_message)
	132	+ }
	133	+ else if cmd = wait_cmd & status = _CXM_ERROR then
	134	+ error
	135	+ else if cmd = wait_cmd & status = _CXM_UNKNOW_CMD then
	136	+ unknow_cmd
	137	+ else
	138	+ failure //println("wait_for_reply ");
	139	+ }
	140	+ }
	141	+ else
	142	+ failure //println("wait_for_reply not ACK");
	143	+ }.
	144	+
...	...

MF_1_1/net_services/CXM_net_services.anubis 0 → 100644

Wrap text Show/Hide comments View file @9ca943b

	1	+/*
	2	+ *
	3	+ * User: David RENE
	4	+ * Date: 25/04/2007
	5	+ * Time: 11:01
	6	+ * (c) Calexium
	7	+ *
	8	+ */
	9	+read tools/basis.anubis
	10	+read system/convert.anubis
	11	+read system/string.anubis
	12	+read system/muscle.anubis
	13	+read system/data_io.anubis
	14	+read system/message_queue.anubis
	15	+read system/message_transceiver.anubis
	16	+read CXM_generic_protocol.anubis
	17	+read calexium_lib/CXM_message_constants.anubis
	18	+
	19	+public type NetService:
	20	+ net_service(
	21	+ Word32 version,
	22	+ Word32 id,
	23	+ String name,
	24	+ (MessageQueue, String, String) -> One handler // Parameters are MessageQueue, peer IP and timestamp string
	25	+ ).
	26	+
	27	+define One
	28	+ print_services
	29	+ (
	30	+ List(NetService) net_services
	31	+ ) =
	32	+ map_forget((NetService net_s)\|->
	33	+ println(" id : 0x"+ to_hexa(net_s.id));
	34	+ println(" version : " + to_String(net_s.version));
	35	+ println(" name : "+ net_s.name );
	36	+ println("----------------------------------------")
	37	+ ,net_services).
	38	+
	39	+ /** Try to find the service_id in services_list. If the service is found in that list
	40	+ * the corresponding NetService object is return
	41	+ */
	42	+define Maybe(NetService)
	43	+ find_service
	44	+ (
	45	+ List(NetService) services_list,
	46	+ Word32 service_id,
	47	+ Word32 service_version
	48	+ )=
	49	+ if services_list is
	50	+ {
	51	+ [] then failure,
	52	+ [h.t] then
	53	+ if h.id = service_id & h.version >=+ service_version then
	54	+ success(h)
	55	+ else
	56	+ find_service(t, service_id, service_version)
	57	+ }.
	58	+
	59	+ /** Check if the muscle message msg has the correct fields for requesting a net_services
	60	+ * if we found "service" and "version" fields on the message, we try to find if the service
	61	+ * referenced in "service" is available in net_services list
	62	+ */
	63	+define Maybe(NetService)
	64	+ has_service
	65	+ (
	66	+ MessageQueue queue,
	67	+ Message msg,
	68	+ List(NetService) net_services
	69	+ )=
	70	+ if find_int32(msg, "SERVICE") is
	71	+ {
	72	+ failure then //send_ACK_error(queue, _CXM_REQUEST_FOR_SERVICE); failure,
	73	+ // old names... should be removed soon
	74	+ if find_int32(msg, "service") is
	75	+ {
	76	+ failure then send_ACK_error(queue, _CXM_REQUEST_FOR_SERVICE); failure,
	77	+ success(service_id) then
	78	+ if find_int32(msg, "version") is
	79	+ {
	80	+ failure then send_ACK_error(queue, _CXM_REQUEST_FOR_SERVICE);failure,
	81	+ success(service_version) then find_service(net_services, service_id, service_version)
	82	+ }
	83	+ }
	84	+
	85	+ success(service_id) then
	86	+ if find_int32(msg, "VERSION") is
	87	+ {
	88	+ failure then send_ACK_error(queue, _CXM_REQUEST_FOR_SERVICE);failure,
	89	+ success(service_version) then find_service(net_services, service_id, service_version)
	90	+ }
	91	+ }.
	92	+
	93	+define String
	94	+ get_time_stamp
	95	+ =
	96	+ with time = (UTime) unow,
	97	+ "<"+virtual_machine_id+"@"+time.seconds+">".
	98	+
	99	+ /** This message_received function just handle the negociation process the available net_services.
	100	+ * In other words, it only recognize the _CXM_REQUEST_FOR_SERVICE message and try to launch the
	101	+ * corresponding servcice
	102	+ */
	103	+
	104	+define One
	105	+ service_negociation
	106	+ (
	107	+ MessageQueue queue,
	108	+ Message msg,
	109	+ List(NetService) net_services,
	110	+ String peer
	111	+ )=
	112	+ //TODO DR add a real management of error
	113	+ //println("Service NEGOCIATION [" + to_hexa(*msg.what) + "] received");
	114	+ if * msg.what = _CXM_REQUEST_FOR_SERVICE then
	115	+ if has_service(queue, msg, net_services) is
	116	+ {
	117	+ failure then
	118	+ send_ACK_error(queue, _CXM_REQUEST_FOR_SERVICE, _CXM_UNKNOW_SERVICE, "Unknown service")
	119	+ success(net_service) then
	120	+ with result = message(0),
	121	+ timestamp = get_time_stamp,
	122	+ forget(add_string(result, "TIMESTAMP", timestamp));
	123	+ send_ACK_ok(queue, _CXM_REQUEST_FOR_SERVICE, result);
	124	+ net_service.handler(queue, peer, timestamp)
	125	+ }
	126	+ else
	127	+ send_ACK_error(queue, msg.what, _CXM_UNKNOW_CMD, "Unknown command [" + (msg.what) + "]")
	128	+ .
	129	+
	130	+ /**
	131	+ * this function unflatten muscle message and give the correct message to service_negociation function
	132	+ */
	133	+define One
	134	+ message_receiver
	135	+ (
	136	+ MessageQueue queue,
	137	+ List(NetService) net_services,
	138	+ String peer
	139	+ ) =
	140	+ if queue.quit_requested(unique) then
	141	+ unique
	142	+ else
	143	+ //println("PRE SERVICE message_receiver "+"["+virtual_machine_id + "]");
	144	+ if queue.get_next_received_Message(1) is
	145	+ {
	146	+ timeout then //println("PRE timeout");
	147	+ message_receiver(queue, net_services, peer),
	148	+ closed then //println("PRE closed");
	149	+ unique,
	150	+ msg(msg) then unique; //println("PRE negociation");
	151	+ service_negociation(queue, msg, net_services, peer);
	152	+ message_receiver(queue, net_services, peer)
	153	+ }.
	154	+
	155	+define Server -> (RWStream) -> One
	156	+ net_services_handler
	157	+ (
	158	+ List(NetService) net_services,
	159	+ ) =
	160	+ (Server server) \|-> (RWStream conn) \|->
	161	+ if remote_IP_address_and_port(conn) is (num_peer,_) then
	162	+ //convert IP address of the client to string
	163	+ with peer = ip_addr_to_string(num_peer),
	164	+ //println("NET SERVICES Accepting connection with "+peer);
	165	+
	166	+ //now managing the list of SERVICES
	167	+ with queue = create_MessageQueue("CXM Net Services"),
	168	+ message_transceiver(conn, queue);
	169	+ message_receiver(queue, net_services, peer).
	170	+
	171	+
	172	+public define Maybe(Server)
	173	+ start_net_services
	174	+ (
	175	+ List(NetService) net_services,
	176	+ Word32 network_port,
	177	+ Var(Bool) shutdown_required
	178	+ )=
	179	+ if start_server(0,
	180	+ network_port,
	181	+ net_services_handler(net_services),
	182	+ (One u) \|-> unique) is
	183	+ {
	184	+ cannot_create_the_socket then println("Cannot create the listening socket."); failure,
	185	+ cannot_bind_to_port then println("Cannot bind to port " + network_port ); failure,
	186	+ cannot_listen_on_port then println("Cannot listen on port " + network_port); failure,
	187	+ ok(server) then
	188	+ println("Net services started on port " + network_port);
	189	+ println("------ Available services ------");
	190	+ print_services(net_services);
	191	+ success(server)
	192	+ }.
...	...

MF_1_1/net_services_protocols/ftp_client.anubis 0 → 100644

Wrap text Show/Hide comments View file @9ca943b

	1	+/*
	2	+ *
	3	+ * User: David RENE
	4	+ * Date: 11/05/2007
	5	+ * Time: 22:34
	6	+ * (c) Calexium
	7	+ *
	8	+ * To change this template use Tools \| Options \| Coding \| Edit Standard Headers.
	9	+ */
	10	+
	11	+read calexium_lib/CXM_message_constants.anubis
	12	+read calexium_lib/net_services/CXM_generic_protocol.anubis
	13	+read system/message_queue.anubis
	14	+read system/message_transceiver.anubis
	15	+read system/muscle.anubis
	16	+read system/files.anubis
	17	+read tools/basis.anubis
	18	+
	19	+define Maybe(One)
	20	+ receive_data
	21	+ (
	22	+ MessageQueue mQ,
	23	+ WStream fd,
	24	+ Int so_far,
	25	+ Int left_read
	26	+ )=
	27	+ //println("receive_data ");
	28	+ if mQ.get_next_received_Message(30) is
	29	+ {
	30	+ timeout then failure,
	31	+ closed then failure,
	32	+ msg(_msg) then
	33	+ with last_block = if find_bool(_msg, "End") is {failure then false, success(r) then r},
	34	+ if find_raw(_msg, "Data") is
	35	+ {
	36	+ failure then println("Can't find raw Data"); send_ACK_error(mQ, _CXM_FTP_DATA); failure,
	37	+ success(data) then
	38	+ if write(fd, data) is
	39	+ {
	40	+ failure then println("Can't write into file"); send_ACK_error(mQ, _CXM_FTP_DATA);failure,
	41	+ success(len) then
	42	+ send_ACK_ok(mQ, _CXM_FTP_DATA);
	43	+ if last_block then
	44	+ println("File received successfully");
	45	+ //TODO this is a big hack, we must check if all data are sent from the mQ
	46	+ sleep(10000);
	47	+ success(unique)
	48	+ else
	49	+// println("Bytes received : " + (so_far + len));
	50	+ receive_data(mQ, fd, so_far + len, left_read - len)
	51	+ }
	52	+ }
	53	+ }
	54	+ .
	55	+
	56	+define Maybe(One)
	57	+ start_get_file_transtert
	58	+ (
	59	+ MessageQueue mQ,
	60	+ String local_file,
	61	+ Int size
	62	+ )=
	63	+ make_directories(local_file);
	64	+ if file(local_file, new) is
	65	+ {
	66	+ failure then println("Can't create \""+local_file+"\" file"); failure,
	67	+ success(fd) then //the local file is open
	68	+ with start = message(_CXM_FTP_START_TRANSFERT),
	69	+ mQ.add_Message_to_send(start);
	70	+ receive_data(mQ, weaken(fd), 0, size)
	71	+ }
	72	+ .
	73	+
	74	+define Maybe(One)
	75	+ get_file
	76	+ (
	77	+ MessageQueue mQ,
	78	+ String remote_file,
	79	+ String local_file
	80	+ )=
	81	+ with get_file_msg = message(_CXM_FTP_GET_FILE),
	82	+ if add_string(get_file_msg, "FileName", remote_file) is
	83	+ {
	84	+ failure then failure,
	85	+ success(_) then
	86	+ mQ.add_Message_to_send(get_file_msg);
	87	+ if wait_for_reply(mQ, _CXM_FTP_GET_FILE, 30) is
	88	+ {
	89	+ failure then println("get_file failure");failure,
	90	+ timeout then println("get_file timeout");failure,
	91	+ unknow_cmd then println("get_file unknow_cmd");failure,
	92	+ error then println("get_file remote error msg");failure,
	93	+ ok then println("get_file ok");failure,
	94	+ ok_msg(msg)then
	95	+ if find_int32(msg, "FileSize") is
	96	+ {
	97	+ failure then println("file size not found"); failure,
	98	+ success(size) then println("file size "+size);
	99	+ start_get_file_transtert(mQ, local_file, to_Int(size))
	100	+ }
	101	+ }
	102	+ }.
	103	+
	104	+
	105	+define Bool
	106	+ request_for_service
	107	+ (
	108	+ MessageQueue queue
	109	+ )=
	110	+ with test_msg = message(_CXM_REQUEST_FOR_SERVICE),
	111	+ forget(add_int32(test_msg, "service", _CXM_FTP_SERVICE_ID));
	112	+ forget(add_int32(test_msg, "version", 1));
	113	+ queue.add_Message_to_send(test_msg);
	114	+ if queue.get_next_received_Message(30) is
	115	+ {
	116	+ timeout then println("request_for_service receive timeout");false,
	117	+ closed then println("request_for_service socket closed");false,
	118	+ msg(msg) then
	119	+ if find_int32(msg, "STATUS") is
	120	+ {
	121	+ failure then println("status not found");false,
	122	+ success(v) then
	123	+ if v = _CXM_OK then
	124	+ true
	125	+ else
	126	+ false
	127	+ }
	128	+ }.
	129	+
	130	+public define Maybe(One)
	131	+ ftp_get_file
	132	+ (
	133	+ String server,
	134	+ Word32 ip_port,
	135	+ String remote_file,
	136	+ String local_file
	137	+ )=
	138	+ if dns(server) is ok(ip_adr) then
	139	+ if connect( ip_adr, ip_port) is
	140	+ {
	141	+ error(_) then println("can't connect to ftp server"); failure,
	142	+ ok(conn) then
	143	+ with queue = create_MessageQueue("ftp_get_file"),
	144	+ message_transceiver(conn, queue);
	145	+ if request_for_service(queue) then
	146	+ with result = get_file(queue, remote_file, local_file),
	147	+ queue.quit(unique);result
	148	+ else
	149	+ queue.quit(unique);
	150	+ println("Service not found");failure
	151	+ }
	152	+ else
	153	+ println("server "+server+" DNS error");failure
	154	+ .
	155	+
...	...

MF_1_1/net_services_protocols/logger_service.anubis 0 → 100644

Wrap text Show/Hide comments View file @9ca943b

	1	+/*
	2	+ *
	3	+ * User: David RENE
	4	+ * Date: 29/07/2007
	5	+ * Time: 02:04
	6	+ * (c) Calexium
	7	+ *
	8	+ */
	9	+
	10	+read tools/basis.anubis
	11	+read system/muscle.anubis
	12	+read system/data_io.anubis
	13	+read system/convert.anubis
	14	+read system/string.anubis
	15	+read system/logger.anubis
	16	+read system/message_queue.anubis
	17	+read system/message_transceiver.anubis
	18	+
	19	+read calexium_lib/CXM_message_constants.anubis
	20	+read calexium_lib/net_services/CXM_net_services.anubis
	21	+read calexium_lib/net_services/CXM_generic_protocol.anubis
	22	+
	23	+// Special non-existing file. This is a work arround for a impossibility to define global configuration in anubis.
	24	+// So this file allows you to specify on which UDP port the logger server is listening.
	25	+// You have to provide this file in your base source directory (or any other folder which is scanned by the compilater,
	26	+// and you define a function named 'logger_port' which simply return the port number as an Word32.
	27	+// Example:
	28	+// public define Word32 logger_port = 33610.
	29	+read logger_config.anubis
	30	+
	31	+public define Word32 logger_srv_version = 1.
	32	+
	33	+ /**
	34	+ * has_update scan the given message for finding corresponding available update
	35	+ * package for the application. The request message come with AppId field which contain
	36	+ * package or application signature and CurrentVersion field which is current version
	37	+ * installed on the requester.
	38	+ *
	39	+ * --- REQUEST message format
	40	+ * msg [_CXM_UPD_HAS_UPDATE]
	41	+ * string "AppId" = hash or unique signature of the package
	42	+ * string "CurrentVersion" = current version installed on the remote caller
	43	+ *
	44	+ * --- ANSWER message format
	45	+ *
	46	+ * ERROR case message format
	47	+ * msg [_CXM_ACK]
	48	+ * int32 "CMD" = _CXM_UPD_HAS_UPDATE
	49	+ * int32 "STATUS" = _CXM_ERROR
	50	+ *
	51	+ * OK without update available
	52	+ * msg [_CXM_ACK]
	53	+ * int32 "CMD" = _CXM_UPD_HAS_UPDATE
	54	+ * int32 "STATUS" = _CXM_OK
	55	+ * msg "RESULT" [_CXM_ACK_RESULT_MSG]
	56	+ * int32 "PackageStatus" = no_update // numerical value = 0
	57	+ *
	58	+ */
	59	+
	60	+define Bool
	61	+ process_log
	62	+ (
	63	+ Logger log,
	64	+ Message msg
	65	+ )=
	66	+ if find_string(msg, "LogString") is
	67	+ {
	68	+ failure then logError(log, "process_log can't find LogString");false,
	69	+ success(log_string) then
	70	+ if find_int32(msg, "Level") is
	71	+ {
	72	+ failure then logError(log, "process_log can't find Level");false,
	73	+ success(int_level) then
	74	+ if find_int32(msg, "Thread") is
	75	+ {
	76	+ failure then logError(log, "process_log can't find Level");false,
	77	+ success(thread_id) then
	78	+ with level = get_LogLevel_from_value(to_Int(int_level)),
	79	+ if level is logTrace then
	80	+ if find_string(msg, "LogMask") is
	81	+ {
	82	+ failure then logError(log, "process_log can't find LogMask");false,
	83	+ success(log_mask) then logTrace(log, logMask(log_mask), log_string, thread_id); true
	84	+ }
	85	+ else doLog(log, log_string, level, thread_id); true
	86	+// {
	87	+// logNone then true,
	88	+// logCriticalError then logCriticalError(log, log_string); true,
	89	+// logError then logError(log, log_string); true,
	90	+// logWarning then logWarning(log, log_string); true,
	91	+// logInfo then logInfo(log, log_string); true,
	92	+// logDebug then logDebug(log, log_string); true
	93	+// logTrace then
	94	+// if find_string(msg, "LogMask") is
	95	+// {
	96	+// failure then logError(log, "process_log can't find LogMask");false,
	97	+// success(log_mask) then logTrace(log, logMask(log_mask),log_string); true
	98	+// }
	99	+// }
	100	+ }
	101	+ }
	102	+ }.
	103	+
	104	+define Bool
	105	+ process_log
	106	+ (
	107	+ List(Logger) logs,
	108	+ Message msg
	109	+ )=
	110	+ if find_string(msg, "LogName") is
	111	+ {
	112	+ failure then println("process_log can't find LogName");false,
	113	+ success(log_name) then
	114	+ if get_logger(logs, log_name) is
	115	+ {
	116	+ failure then println("can't find log ["+log_name+"]");false,
	117	+ success(log) then process_log(log, msg)
	118	+ }
	119	+ }.
	120	+
	121	+ /** message_received is the principal
	122	+ */
	123	+ /*
	124	+ define One
	125	+ message_received
	126	+ (
	127	+ MessageQueue queue,
	128	+ List(Logger) logs,
	129	+ Message msg
	130	+ )=
	131	+ with msg_what = *msg.what,
	132	+ if msg_what = _CXM_LOGGER_LOG then
	133	+ send_result(queue, _CXM_LOGGER_LOG, process_log(logs, msg))
	134	+ else
	135	+ println("wrong message_received is not _CXM_LOGGER_LOG ");unique
	136	+ .
	137	+
	138	+ define One
	139	+ logger_handler
	140	+ (
	141	+ MessageQueue queue,
	142	+ List(Logger) logs
	143	+ )=
	144	+ if queue.get_next_received_Message(1) is
	145	+ {
	146	+ timeout then //println("logger_handler timeout ["+queue.get_name(unique)+"]");
	147	+ logger_handler(queue, logs),
	148	+ closed then //println("logger_handler closed ["+queue.get_name(unique)+"]");
	149	+ unique,
	150	+ msg(msg) then //println("logger_handler msg received ["+queue.get_name(unique)+"]");
	151	+ message_received(queue, logs, msg);
	152	+ logger_handler(queue, logs)
	153	+ }.
	154	+
	155	+ public define NetService
	156	+ logger_service
	157	+ (
	158	+ List(Logger) logs
	159	+ )=
	160	+ net_service(
	161	+ logger_srv_version,
	162	+ _CXM_LOGGER_SERVICE_ID, //id of the service declared in CXM_message_constants
	163	+ "Logger service", //human readable name of the service
	164	+ (
	165	+ MessageQueue queue,
	166	+ String peer
	167	+ ) \|-> logger_handler(queue, logs)).
	168	+
	169	+ */
	170	+ /**************** LOCAL UDP SERVICE ***********/
	171	+
	172	+
	173	+public define String
	174	+ data_preview
	175	+ (
	176	+ ByteArray data,
	177	+ Int max
	178	+ ) =
	179	+ with l = length(data),
	180	+ firsts_bytes = extract(data, 0, max),
	181	+ "Length=" + l + "; String='"+to_string(firsts_bytes)+"' Buffer=[" + to_ascii(firsts_bytes) + (if l > max then "...]" else "]").
	182	+
	183	+
	184	+define (UDP_Socket, ByteArray, Truncation, Word32, Word32) -> One
	185	+ make_udp_handler
	186	+ (
	187	+ List(Logger) logs,
	188	+ Logger debug_logger
	189	+ ) =
	190	+ (
	191	+ UDP_Socket socket,
	192	+ ByteArray data,
	193	+ Truncation truncation,
	194	+ Word32 ip_address,
	195	+ Word32 ip_port
	196	+ ) \|->
	197	+ with ip = ip_addr_to_string(ip_address),
	198	+ logTrace(debug_logger, logMask("Logger"), "LoggerServer: data received (" + length(data) + " bytes) from IP " + ip + "... ");
	199	+ if receive_message_from_io(make_data_io(data)) is
	200	+ {
	201	+ failure then logWarning(debug_logger, "LoggerServer: Bad data packet received from IP " + ip + ": " + data_preview(data, 20)),
	202	+ success(msg) then
	203	+ if *msg.what = _CXM_LOGGER_LOG then
	204	+ forget(process_log(logs, msg))
	205	+ else
	206	+ println("LoggerService: wrong message_received. [" + to_hexa(*msg.what) + "] is not _CXM_LOGGER_LOG ")
	207	+ }.
	208	+
	209	+define One
	210	+ my_notify
	211	+ (
	212	+ One dummy
	213	+ ) =
	214	+ unique.
	215	+
	216	+public define Maybe(UDP_Server)
	217	+ start_logger_server
	218	+ (
	219	+ List(Logger) logs,
	220	+ Logger debug_logger
	221	+ ) =
	222	+ if start_udp_server(0,
	223	+ logger_port,
	224	+ make_udp_handler(logs, debug_logger),
	225	+ 8*1024,
	226	+ my_notify) is
	227	+ {
	228	+ cannot_create_the_socket then logError(debug_logger, "Cannot create the listening socket."); failure,
	229	+ cannot_bind_address_port then logError(debug_logger, "Cannot bind to port " + logger_port + ".");failure,
	230	+ access_denied then logError(debug_logger, "Cannot listen on port " + logger_port + ".");failure,
	231	+ ok(server) then logInfo(debug_logger, "LocalLog Server started on port " + logger_port + "."); success(server)
	232	+ }.
	233	+
	234	+
	235	+ /**************** CLIENT PART *****************/
	236	+
	237	+/*
	238	+ define One
	239	+ send_log_msg
	240	+ (
	241	+ MessageQueue queue,
	242	+ Message log_msg
	243	+ )=
	244	+ with test_msg = message(_CXM_REQUEST_FOR_SERVICE),
	245	+ forget(add_int32(test_msg, "service", _CXM_LOGGER_SERVICE_ID));
	246	+ forget(add_int32(test_msg, "version", 1));
	247	+ queue.add_Message_to_send(test_msg);
	248	+ if queue.get_next_received_Message(30) is
	249	+ {
	250	+ timeout then println("send_log_msg receive timeout"),
	251	+ closed then println("send_log_msg socket closed"),
	252	+ msg(msg) then
	253	+ if find_int32(msg, "STATUS") is
	254	+ {
	255	+ failure then println("status not found"),
	256	+ success(v) then
	257	+ if v = _CXM_OK then
	258	+ queue.add_Message_to_send(log_msg);
	259	+ forget(wait_for_reply(queue, _CXM_LOGGER_LOG, 30))
	260	+ else
	261	+ println("requested service started won't start")
	262	+ }
	263	+ }.
	264	+*/
	265	+
	266	+define One
	267	+ local_net_logger
	268	+ (
	269	+ String logger_server,
	270	+ Message log_message
	271	+ )=
	272	+ forget(send_message_by_udp(log_message, ip_address((127,0,0,1)), logger_port)).
	273	+
	274	+/* if find_string(log_message, "LogString") is
	275	+ {
	276	+ failure then println("process_log can't find LogString"),
	277	+ success(log_string) then println(log_string)
	278	+ }.
	279	+ if connect( ip_address((127,0,0,1)), 33125) is
	280	+ {
	281	+ error(_) then println("can't connect to logger server ["+logger_server+"]");
	282	+ forget(process_log(fullLogger, log_message)),
	283	+ ok(conn) then
	284	+ with queue = create_MessageQueue("net logger sender"),
	285	+ message_transceiver(conn, queue);
	286	+ send_log_msg(queue, log_message);
	287	+ queue.quit(unique)
	288	+ }.*/
	289	+
	290	+define Message
	291	+ create_log_msg
	292	+ (
	293	+ String logger_name,
	294	+ String log_string,
	295	+ Int level
	296	+ )=
	297	+ with string = if length(log_string) > 1024 then (if sub_string(log_string, 0, 1024) is success(s) then s else "?") + "..."
	298	+ else log_string,
	299	+ with log_msg = message(_CXM_LOGGER_LOG),
	300	+ forget(add_string(log_msg, "LogName", logger_name));
	301	+ forget(add_string(log_msg, "LogString", string));
	302	+ forget(add_int32(log_msg, "Level", truncate_to_Word32(level)));
	303	+ forget(add_int32(log_msg, "Thread", virtual_machine_id));
	304	+ log_msg
	305	+ .
	306	+
	307	+public define One
	308	+ logNone(
	309	+ String logger_name,
	310	+ String log_string
	311	+ )=
	312	+ local_net_logger("127.0.0.1", create_log_msg(logger_name, log_string, 0)).
	313	+
	314	+public define One
	315	+ logCriticalError(
	316	+ String logger_name,
	317	+ String log_string
	318	+ )=
	319	+ local_net_logger("127.0.0.1", create_log_msg(logger_name, log_string, 1)).
	320	+
	321	+public define One
	322	+ logError(
	323	+ String logger_name,
	324	+ String log_string
	325	+ )=
	326	+ local_net_logger("127.0.0.1", create_log_msg(logger_name, log_string, 2)).
	327	+
	328	+public define One
	329	+ logWarning(
	330	+ String logger_name,
	331	+ String log_string
	332	+ )=
	333	+ local_net_logger("127.0.0.1", create_log_msg(logger_name, log_string, 3)).
	334	+
	335	+public define One
	336	+ logInfo(
	337	+ String logger_name,
	338	+ String log_string
	339	+ )=
	340	+ local_net_logger("127.0.0.1", create_log_msg(logger_name, log_string, 4)).
	341	+
	342	+public define One
	343	+ logDebug(
	344	+ String logger_name,
	345	+ String log_string
	346	+ )=
	347	+ local_net_logger("127.0.0.1", create_log_msg(logger_name, log_string, 5)).
	348	+
	349	+public define One
	350	+ logTrace(
	351	+ String logger_name,
	352	+ LogMask log_mask,
	353	+ String log_string
	354	+ )=
	355	+ with log_msg = create_log_msg(logger_name, log_string, 6),
	356	+ forget(add_string(log_msg, "LogMask", log_mask.mask));
	357	+ local_net_logger("127.0.0.1", log_msg).
...	...

MF_1_1/net_services_protocols/pkg_updater_protocol.anubis 0 → 100644

Wrap text Show/Hide comments View file @9ca943b

	1	+/*
	2	+ *
	3	+ * User: David RENE
	4	+ * Date: 26/04/2007
	5	+ * Time: 19:08
	6	+ * (c) Calexium
	7	+ *
	8	+ */
	9	+
	10	+
	11	+public define Word32 no_update = 0.
	12	+public define Word32 update_available = 1.
...	...

MF_1_1/web/CXM_common.anubis 0 → 100644

Wrap text Show/Hide comments View file @9ca943b

	1	+
	2	+ Project The Anubis Project
	3	+ Title Some common stuff for the web.
	4	+
	5	+ Copyright Copyright (c) Alain Prouté 2003.
	6	+
	7	+
	8	+
	9	+ Author Alain Prouté
	10	+
	11	+ Public
	12	+ Name HTTP_header
	13	+ Description
	14	+
	15	+read system/string.anubis
	16	+
	17	+/**
	18	+ * The type 'HTTP_header' describes HTTP headers, which are just pairs '(name,value)'.
	19	+ */
	20	+public type HTTP_header:
	21	+ http_header(String name,
	22	+ String value).
	23	+
	24	+
	25	+public define Maybe(String)
	26	+ http_header_value
	27	+ (
	28	+ List(HTTP_header) l,
	29	+ String name
	30	+ ) =
	31	+ if l is
	32	+ {
	33	+ [ ] then failure,
	34	+ [h . t] then if h is
	35	+ {
	36	+ http_header(n, v) then //print("DEBUG: http_header_value --> HEADER = " + n + ":" + v + "\n");
	37	+ if insensitive_equal(name, n) then success(v)
	38	+ else http_header_value(t, name),
	39	+ }
	40	+ }.
	41	+
	42	+ Name Web_arg
	43	+ Description
	44	+
	45	+ The type 'Web_arg' describes 'web arguments'. A web argument is either a pair
	46	+ '(name,value)' (for example it may be 'web_arg("password","foobar")', if the client
	47	+ clicks on the submit button of a form containing a password input field named
	48	+ 'password'), or an uploaded file. In this last case, it is a triplet containing the
	49	+ name of the file upload input field, the value of this input field (name of the
	50	+ uploaded file), and the name of the temporary file as saved by the server in its
	51	+ 'upload temporary directory'; see 'web/http_server.anubis' and the 'upload' Web_item in
	52	+ 'web/html.anubis').
	53	+
	54	+public type Web_arg:
	55	+ web_arg(String name,
	56	+ String value),
	57	+ upload (String name, // name of corresponding 'upload' Web_item
	58	+ String value, // name of uploaded file
	59	+ String temp_file_path). // temporary file path (relative to server directory)
	60	+
	61	+
	62	+ Name Web_arg_value
	63	+ Description
	64	+ Of course, within the body of a 'web page' operation, you may want to recover the value
	65	+ of a particular web argument. To that end, use the operation 'web_arg_value', which
	66	+ takes 2 argument:
	67	+
	68	+ - the list of all web arguments (the operand of the web page operation),
	69	+ - the name of the argument whose value is wanted.
	70	+
	71	+ This operation has the following return type:
	72	+
	73	+public type Web_arg_value:
	74	+ not_found,
	75	+ found(String value).
	76	+
	77	+ Name Web_arg_value
	78	+ Description
	79	+ If the requested argument name is not found in the list, 'not_found' is
	80	+ returned. Otherwise, the value returned by 'web_arg_value' has the form 'found(v)',
	81	+ where 'v' is the value of the argument.
	82	+
	83	+ The operation 'web_arg_value' is defined below.
	84	+
	85	+public define Web_arg_value
	86	+ web_arg_value
	87	+ (
	88	+ List(Web_arg) l,
	89	+ String name
	90	+ ) =
	91	+ if l is
	92	+ {
	93	+ [ ] then not_found,
	94	+ [h . t] then if h is
	95	+ {
	96	+ web_arg(n,v) then
	97	+ if name=n
	98	+ then found(v)
	99	+ else web_arg_value(t,name),
	100	+
	101	+ upload(n,v,tfn) then
	102	+ if name=n
	103	+ then found(v)
	104	+ else web_arg_value(t,name)
	105	+ }
	106	+ }.
	107	+
	108	+ Ignore
	109	+
	110	+public define Maybe((String,String))
	111	+ file_upload_value
	112	+ (
	113	+ List(Web_arg) l,
	114	+ String name
	115	+ ) =
	116	+ if l is
	117	+ {
	118	+ [ ] then failure,
	119	+ [h . t] then if h is
	120	+ {
	121	+ web_arg(_,_) then file_upload_value(t,name),
	122	+ upload(n,v,tfn) then
	123	+ if n = name
	124	+ then success((v,tfn))
	125	+ else file_upload_value(t,name)
	126	+ }
	127	+ }.
	128	+
	129	+public type Redirection:
	130	+ redirect(String required_uri, // URI required by the client
	131	+ String required_host, // value of 'Host' HTTP header sent by the client
	132	+ String corresponding_uri). // URI which will be served to the client
	133	+
	134	+public type Redirections:
	135	+ redirection_list(List(Redirection) redirections),
	136	+ redirection_fn((String input_uri, // URI required by the client
	137	+ String host) -> String f). // value of 'Host' HTTP header sent by the client
	138	+
	139	+
	140	+ Now, you may also want to recover web argument values which have been encoded (by
	141	+ 'web_arg_encode'). In this case, use the following:
	142	+
	143	+read CXM_web_arg_encode.anubis
	144	+
	145	+
	146	+public define Maybe($T)
	147	+ decode_web_arg_value
	148	+ (
	149	+ List(Web_arg) l,
	150	+ String name
	151	+ ) =
	152	+ if web_arg_value(l,name) is
	153	+ {
	154	+ not_found then failure,
	155	+ found(v) then web_arg_decode(v)
	156	+ }.
	157	+
	158	+public define List(String)
	159	+ web_arg_list_values
	160	+ (
	161	+ List(Web_arg) l,
	162	+ String name
	163	+ ) =
	164	+ if l is
	165	+ {
	166	+ [] then [],
	167	+ [h . t] then
	168	+ if h is web_arg(n, v) then
	169	+ if n = name then
	170	+ [ v . web_arg_list_values(t, name)]
	171	+ else
	172	+ web_arg_list_values(t, name)
	173	+ else
	174	+ web_arg_list_values(t, name)
	175	+
	176	+ }
	177	+ .
	178	+
	179	+public define String
	180	+ dump_web_arg_values
	181	+ (
	182	+ List(Web_arg) l,
	183	+ ) =
	184	+ if l is
	185	+ {
	186	+ [ ] then "\n",
	187	+ [h . t] then if h is
	188	+ {
	189	+ web_arg(n,v) then "\n["+n+"] = '"+v+"'" + dump_web_arg_values(t),
	190	+ upload(n,v,tfn) then "\n["+n+"] = '"+v+"'" + dump_web_arg_values(t)
	191	+ }
	192	+ }.
...	...

MF_1_1/web/CXM_cookies.anubis 0 → 100644

Wrap text Show/Hide comments View file @9ca943b

	1	+
	2	+ Project The Anubis Project
	3	+
	4	+ Title Managing Cookies.
	5	+
	6	+ Copyright Copyright (c) Alain Prouté 2001.
	7	+
	8	+
	9	+ Author Alain Prouté
	10	+
	11	+
	12	+
	13	+
	14	+read tools/basis.anubis
	15	+read system/string.anubis
	16	+read CXM_common.anubis
	17	+read CXM_html.anubis
	18	+read CXM_http_get_common.anubis
	19	+
	20	+
	21	+ Overview
	22	+ Cookies are defined in RFC 2109. Here is the corresponding Anubis type:
	23	+
	24	+ Each cookie has an server name (the name of the server who constructed the cookie), a
	25	+ name, a value, and several attributes.
	26	+
	27	+public type Cookie:
	28	+ cookie(String server_name, // of the server who sent the cookie
	29	+ String name, // of the cookie
	30	+ String value, // of the cookie
	31	+ // attributes:
	32	+ Maybe(String) comment, // cookies may have human readable comments
	33	+ Maybe(String) domain, // domain name as sent by the server
	34	+ Int validity, // cookie still valid if this is > now
	35	+ Maybe(String) path, // server path for which the cookie is valid
	36	+ Bool secure, // if true, do not send this cookie over an insecure link
	37	+ Int version). // Cookie version (normally 1: rfc 2109)
	38	+
	39	+
	40	+ Cookies are sent by servers through 'Set-Cookie' HTTP headers. The function
	41	+ 'get_cookies' retrieves a list of cookies from a list of HTTP headers.
	42	+
	43	+public define List(Cookie)
	44	+ get_cookies
	45	+ (
	46	+ String server_name, // name of server who sent the cookies
	47	+ List(HTTP_header) headers // HTTP headers sent by this server
	48	+ ).
	49	+
	50	+public define Maybe(Cookie)
	51	+ find_cookie
	52	+ (
	53	+ String name,
	54	+ List(Cookie) cookies
	55	+ ).
	56	+
	57	+
	58	+
	59	+
	60	+
	61	+ Normally, this function is used on the list of HTTP headers returned by either
	62	+ 'http_get' of 'https_get'.
	63	+
	64	+
	65	+ Before they can be sent back to their origin server, cookies must be reformated, in
	66	+ order to produce 'Cookie' HTTP headers:
	67	+
	68	+public define List(HTTP_header)
	69	+ reformat_cookies
	70	+ (
	71	+ String server_name,
	72	+ String uri,
	73	+ List(Cookie) cookies
	74	+ ).
	75	+
	76	+ The result of 'reformat_cookies' may be appended to the list of headers given as
	77	+ argument to 'http_get' or to 'https_get'.
	78	+
	79	+ In the meantime, you may examine and maybe discard cookies, you may 'save' them into a
	80	+ file, and 'retrieve' them later.
	81	+
	82	+
	83	+
	84	+
	85	+ ------- That all for the public part. -------------------------------------------------
	86	+
	87	+
	88	+ Here is the syntax of a 'Set-Cookie' header (according to RFC 2109):
	89	+
	90	+ set-cookie = "Set-Cookie:" cookies
	91	+ cookies = 1#cookie
	92	+ cookie = NAME "=" VALUE *(";" cookie-av)
	93	+ NAME = token
	94	+ VALUE = value
	95	+ value = token \| quoted-string
	96	+ cookie-av = "Comment" "=" value
	97	+ \| "Domain" "=" value
	98	+ \| "Max-Age" "=" value
	99	+ \| "Path" "=" value
	100	+ \| "Secure"
	101	+ \| "Version" "=" 1*DIGIT
	102	+
	103	+
	104	+ According to RFC 2616 (obsolating RFC 2068) defining HTTP 1.1, 'control characters' are
	105	+ 0 to 31 and DEL (127). A 'separator' is one of:
	106	+
	107	+ ( ) < > @ , ; : \ " / [ ] ? = { } 32(space) and 9(tab) "
	108	+
	109	+ Now, a token is a non empty sequence of ASCII characters (0 to 127), but not including
	110	+ any control character or any separator. As a consequence, characters admissible in a
	111	+ 'RFC 2616 token' are:
	112	+
	113	+ 33 !
	114	+ 35 to 39 # $ & '
	115	+ 42 43 * +
	116	+ 45 46 - .
	117	+ 48 to 57 0 ... 9
	118	+ 65 to 90 A ... Z
	119	+ 94 to 122 ^ _ ` a ... z
	120	+ 124 126 \| ~
	121	+
	122	+define Bool
	123	+ is_token_char
	124	+ (
	125	+ Word8 c
	126	+ ) =
	127	+ if c +< 33 then false else
	128	+ if c +< 34 then true else
	129	+ if c +< 35 then false else
	130	+ if c +< 40 then true else
	131	+ if c +< 42 then false else
	132	+ if c +< 44 then true else
	133	+ if c +< 45 then false else
	134	+ if c +< 47 then true else
	135	+ if c +< 48 then false else
	136	+ if c +< 58 then true else
	137	+ if c +< 65 then false else
	138	+ if c +< 91 then true else
	139	+ if c +< 94 then false else
	140	+ if c +< 123 then true else
	141	+ if c +< 124 then false else
	142	+ if c = 124 then true else
	143	+ c = 126.
	144	+
	145	+
	146	+ From the grammar, it is clear that atomic entities (called 'tokens' by YACC) are:
	147	+
	148	+ - tokens (in the sens of RFC 2616) some of which have to be recognized as keywords
	149	+ - quoted strings
	150	+ - equal sign
	151	+ - colon
	152	+ - semi-colon
	153	+
	154	+ Hence, the following type:
	155	+
	156	+public type Atom:
	157	+ end_of_input,
	158	+ error,
	159	+ comment,
	160	+ domain,
	161	+ max_age,
	162	+ path,
	163	+ secure,
	164	+ version,
	165	+ token(String),
	166	+ quoted_string(String),
	167	+ equals,
	168	+ colon,
	169	+ semi_colon.
	170	+
	171	+
	172	+variable List(Atom) unput_atoms = [].
	173	+
	174	+define One
	175	+ unput_atom
	176	+ (
	177	+ Atom a
	178	+ ) =
	179	+ unput_atoms <- [a . *unput_atoms].
	180	+
	181	+define Atom
	182	+ recognize_keyword
	183	+ (
	184	+ String s
	185	+ ) =
	186	+ with l = to_lower(s),
	187	+ if l = "comment" then comment else
	188	+ if l = "domain" then domain else
	189	+ if l = "max-age" then max_age else
	190	+ if l = "path" then path else
	191	+ if l = "secure" then secure else
	192	+ if l = "version" then version else
	193	+ token(s).
	194	+
	195	+
	196	+variable String input = "". From which cookies will be read.
	197	+variable Int index = 0. Current position within 'input'.
	198	+
	199	+define Maybe(Word8)
	200	+ next_char
	201	+ =
	202	+ if nth(index,input) is
	203	+ {
	204	+ failure then failure,
	205	+ success(c) then
	206	+ index <- *index+1;
	207	+ success(c)
	208	+ }.
	209	+
	210	+define One
	211	+ unput_char
	212	+ =
	213	+ index <- *index-1.
	214	+
	215	+define Atom
	216	+ read_token
	217	+ (
	218	+ List(Word8) so_far // contains at least 1 character
	219	+ ) =
	220	+ if next_char is
	221	+ {
	222	+ failure then recognize_keyword(implode(reverse(so_far))),
	223	+ success(c) then
	224	+ if is_token_char(c)
	225	+ then read_token([c . so_far])
	226	+ else unput_char; recognize_keyword(implode(reverse(so_far)))
	227	+ }.
	228	+
	229	+define Atom
	230	+ read_quoted_string
	231	+ (
	232	+ List(Word8) so_far
	233	+ ) =
	234	+ if next_char is
	235	+ {
	236	+ failure then quoted_string(implode(reverse(so_far))),
	237	+ success(c) then
	238	+ if c = '\"'
	239	+ then quoted_string(implode(reverse(so_far)))
	240	+ else read_quoted_string([c . so_far])
	241	+ }.
	242	+
	243	+define Bool
	244	+ is_blank
	245	+ (
	246	+ Word8 c
	247	+ ) =
	248	+ c +=< ' '.
	249	+
	250	+ Reading an atom from the input:
	251	+
	252	+define Atom
	253	+ read_atom
	254	+ =
	255	+ if *unput_atoms is
	256	+ {
	257	+ [ ] then
	258	+ if next_char is
	259	+ {
	260	+ failure then end_of_input,
	261	+ success(c) then
	262	+ if is_blank(c) then read_atom else // skip blanks
	263	+ if is_token_char(c) then read_token([c]) else
	264	+ if c = '\"' then read_quoted_string([]) else
	265	+ if c = '=' then equals else
	266	+ if c = ':' then colon else
	267	+ if c = ';' then semi_colon else
	268	+ error
	269	+ },
	270	+ [h . t] then
	271	+ unput_atoms <- t; h
	272	+ }.
	273	+
	274	+
	275	+ Reading an attribute-value pair.
	276	+
	277	+type AttrVal:
	278	+ comment(String),
	279	+ domain(String),
	280	+ max_age(String),
	281	+ path(String),
	282	+ secure,
	283	+ version(String).
	284	+
	285	+define String
	286	+ read_eq_value
	287	+ =
	288	+ with e = read_atom,
	289	+ if e is equals then
	290	+ (
	291	+ with a = read_atom,
	292	+ if a is token(n) then n else
	293	+ if a is quoted_string(s) then s else
	294	+ unput_atom(a); ""
	295	+ )
	296	+ else unput_atom(e); "".
	297	+
	298	+
	299	+define Maybe(AttrVal)
	300	+ read_attr_val
	301	+ =
	302	+ if read_atom is semi_colon then
	303	+ with a = read_atom,
	304	+ if a is
	305	+ {
	306	+ end_of_input then failure,
	307	+ error then failure,
	308	+ comment then success(comment(read_eq_value)),
	309	+ domain then success(domain(read_eq_value)),
	310	+ max_age then success(max_age(read_eq_value)),
	311	+ path then success(path(read_eq_value)),
	312	+ secure then success(secure),
	313	+ version then success(version(read_eq_value)),
	314	+ token(_) then unput_atom(a); failure,
	315	+ quoted_string(_) then unput_atom(a); failure,
	316	+ equals then unput_atom(a); failure,
	317	+ colon then unput_atom(a); failure,
	318	+ semi_colon then unput_atom(a); failure,
	319	+ }
	320	+ else failure.
	321	+
	322	+
	323	+ Getting attributes from a List(AttrVal).
	324	+
	325	+define Maybe(String)
	326	+ get_comment
	327	+ (
	328	+ List(AttrVal) l
	329	+ ) =
	330	+ if l is
	331	+ {
	332	+ [ ] then failure,
	333	+ [h . t] then if h is comment(c)
	334	+ then success(c)
	335	+ else get_comment(t)
	336	+ }.
	337	+
	338	+define Maybe(String)
	339	+ get_domain
	340	+ (
	341	+ List(AttrVal) l
	342	+ ) =
	343	+ if l is
	344	+ {
	345	+ [ ] then failure,
	346	+ [h . t] then if h is domain(s)
	347	+ then success(s)
	348	+ else get_domain(t)
	349	+ }.
	350	+
	351	+define Int
	352	+ get_validity
	353	+ (
	354	+ List(AttrVal) l
	355	+ ) =
	356	+ if l is
	357	+ {
	358	+ [ ] then 0,
	359	+ [h . t] then if h is max_age(a)
	360	+ then if decimal_scan(a) is
	361	+ {
	362	+ failure then 0,
	363	+ success(n) then n+now
	364	+ }
	365	+ else get_validity(t)
	366	+ }.
	367	+
	368	+define Maybe(String)
	369	+ get_path
	370	+ (
	371	+ List(AttrVal) l
	372	+ ) =
	373	+ if l is
	374	+ {
	375	+ [ ] then failure,
	376	+ [h . t] then if h is path(p)
	377	+ then success(p)
	378	+ else get_path(t)
	379	+ }.
	380	+
	381	+define Bool
	382	+ get_secure
	383	+ (
	384	+ List(AttrVal) l
	385	+ ) =
	386	+ if l is
	387	+ {
	388	+ [ ] then false,
	389	+ [h . t] then if h is secure
	390	+ then true
	391	+ else get_secure(t)
	392	+ }.
	393	+
	394	+define Int
	395	+ get_version
	396	+ (
	397	+ List(AttrVal) l
	398	+ ) =
	399	+ if l is
	400	+ {
	401	+ [ ] then 0,
	402	+ [h . t] then if h is version(v)
	403	+ then if decimal_scan(v) is
	404	+ {
	405	+ failure then 0,
	406	+ success(n) then n
	407	+ }
	408	+ else get_version(t)
	409	+ }.
	410	+
	411	+
	412	+ Reading a cookie:
	413	+
	414	+variable String server_name = "".
	415	+
	416	+define Maybe(Cookie)
	417	+ read_cookie_n_e_v
	418	+ (
	419	+ String name,
	420	+ String value,
	421	+ List(AttrVal) so_far
	422	+ ) =
	423	+ if read_attr_val is
	424	+ {
	425	+ failure then success(cookie(
	426	+ *server_name,
	427	+ name,
	428	+ value,
	429	+ get_comment(so_far),
	430	+ get_domain(so_far),
	431	+ get_validity(so_far),
	432	+ get_path(so_far),
	433	+ get_secure(so_far),
	434	+ get_version(so_far)
	435	+ )),
	436	+
	437	+ success(av) then read_cookie_n_e_v(name,value,[av . so_far])
	438	+ }.
	439	+
	440	+define Maybe(Cookie)
	441	+ read_cookie_n_e
	442	+ (
	443	+ String name
	444	+ ) =
	445	+ with a = read_atom,
	446	+ if a is token(value) then read_cookie_n_e_v(name,value,[]) else
	447	+ if a is quoted_string(value) then read_cookie_n_e_v(name,value,[]) else
	448	+ unput_atom(a); failure.
	449	+
	450	+define Maybe(Cookie)
	451	+ read_cookie_n
	452	+ (
	453	+ String name
	454	+ ) =
	455	+ with a = read_atom,
	456	+ if a is equals
	457	+ then read_cookie_n_e(name)
	458	+ else unput_atom(a); failure.
	459	+
	460	+
	461	+define Maybe(Cookie)
	462	+ read_cookie
	463	+ =
	464	+ with a = read_atom,
	465	+ if a is token(name)
	466	+ then read_cookie_n(name)
	467	+ else unput_atom(a); failure.
	468	+
	469	+
	470	+define List(Cookie)
	471	+ read_cookies
	472	+ (
	473	+ List(Cookie) so_far
	474	+ ) =
	475	+ if read_cookie is
	476	+ {
	477	+ failure then so_far,
	478	+ success(c) then read_cookies([c . so_far])
	479	+ }.
	480	+
	481	+
	482	+define List(Cookie)
	483	+ get_cookies
	484	+ (
	485	+ String svn,
	486	+ HTTP_header h
	487	+ ) =
	488	+ if h is http_header(n,v) then
	489	+ if to_lower(n) = "set-cookie"
	490	+ then (
	491	+ unput_atoms <- [];
	492	+ input <- v;
	493	+ index <- 0;
	494	+ server_name <- svn;
	495	+ read_cookies([])
	496	+ )
	497	+ else [].
	498	+
	499	+public define List(Cookie)
	500	+ get_cookies
	501	+ (
	502	+ String server_name,
	503	+ List(HTTP_header) headers
	504	+ ) =
	505	+ if headers is
	506	+ {
	507	+ [ ] then [ ],
	508	+ [h . t] then
	509	+ append(get_cookies(server_name,h),get_cookies(server_name,t))
	510	+ }.
	511	+
	512	+
	513	+public define Maybe(Cookie)
	514	+ find_cookie
	515	+ (
	516	+ String name,
	517	+ List(Cookie) cookies
	518	+ )
	519	+ =
	520	+ if cookies is
	521	+ {
	522	+ [] then failure,
	523	+ [h . t] then
	524	+ if h is cookie(s, n, v, _, _, _, _, _, _) then
	525	+ if name = n then success(h)
	526	+ else find_cookie(name, t)
	527	+ }.
	528	+
	529	+public define String
	530	+ get_cookie_value
	531	+ (
	532	+ String name,
	533	+ List(Cookie) cookies
	534	+ )
	535	+ =
	536	+ if find_cookie(name, cookies) is
	537	+ {
	538	+ failure then "",
	539	+ success(c) then if c is cookie(_, _, v, _, _, _, _, _, _) then v
	540	+ }.
	541	+
	542	+ * Reformating cookies. ************************************************************
	543	+
	544	+ Cookies should be resent reformated according to the following grammar (copy-pasted
	545	+ from RFC 2109):
	546	+
	547	+ cookie = "Cookie:" cookie-version
	548	+ 1*((";" \| ",") cookie-value)
	549	+ cookie-value = NAME "=" VALUE [";" path] [";" domain]
	550	+ cookie-version = "$Version" "=" value
	551	+ NAME = attr
	552	+ VALUE = value
	553	+ path = "$Path" "=" value
	554	+ domain = "$Domain" "=" value
	555	+
	556	+
	557	+define HTTP_header
	558	+ reformat_cookie
	559	+ (
	560	+ Cookie c
	561	+ ) =
	562	+ if c is cookie(sn,n,v,mbc,mbd,vld,mbp,sec,ver) then
	563	+ http_header("Cookie",
	564	+ "$Version=" + to_decimal(ver) +
	565	+ ";" + n + "=\"" + v + "\"" +
	566	+ if mbp is
	567	+ {
	568	+ failure then "",
	569	+ success(p) then ";$Path=\"" + p + "\""
	570	+ } +
	571	+ if mbd is
	572	+ {
	573	+ failure then "",
	574	+ success(d) then ";$Domain=\"" + d + "\""
	575	+ }
	576	+ ).
	577	+
	578	+
	579	+ According to RFC 2109, a cookie may be sent to a server if:
	580	+
	581	+ (1) server name in the cookie is the name of the server,
	582	+ (2) if 'Path' attribute is present, its value must match the URI,
	583	+ (3) the cookie is still valid (validity = 0 means indefinitely valid).
	584	+
	585	+ define Bool
	586	+ path_match
	587	+ (
	588	+ Maybe(String) cookie_path,
	589	+ String uri
	590	+ ) =
	591	+ if cookie_path is
	592	+ {
	593	+ failure then true,
	594	+ success(p) then
	595	+
	596	+ }.
	597	+
	598	+
	599	+ Checking if the path matches:
	600	+
	601	+
	602	+define Bool
	603	+ path_match
	604	+ (
	605	+ Maybe(String) mbp,
	606	+ String uri
	607	+ ) =
	608	+ true.
	609	+
	610	+
	611	+ The next function verifies if a cookie satisfies the rules.
	612	+
	613	+define Bool
	614	+ may_resend_cookie
	615	+ (
	616	+ String server_name,
	617	+ String uri,
	618	+ Cookie c
	619	+ ) =
	620	+ if c is cookie(sn,n,v,mbc,mbd,vld,mbp,sec,ver) then
	621	+ if sn = server_name
	622	+ then (
	623	+ if path_match(mbp,uri)
	624	+ then (
	625	+ if vld = 0 then true else vld > now
	626	+ )
	627	+ else false
	628	+ )
	629	+ else false.
	630	+
	631	+
	632	+ The next function reformat all cookies which satisfy the 'resend' rules.
	633	+
	634	+public define List(HTTP_header)
	635	+ reformat_cookies
	636	+ (
	637	+ String server_name,
	638	+ String uri,
	639	+ List(Cookie) cookies
	640	+ ) =
	641	+ if cookies is
	642	+ {
	643	+ [ ] then [ ],
	644	+ [h . t] then
	645	+ if may_resend_cookie(server_name,uri,h)
	646	+ then [reformat_cookie(h) . reformat_cookies(server_name,uri,t)]
	647	+ else reformat_cookies(server_name,uri,t)
	648	+ }.
	649	+
	650	+
	651	+
	652	+
	653	+
	654	+ See test_cookies.anubis for a test of this program.
	655	+
	656	+
	657	+
	658	+
	659	+
	660	+
	661	+
	662	+
	663	+
...	...

MF_1_1/web/CXM_dojo.anubis 0 → 100644

Wrap text Show/Hide comments View file @9ca943b

	1	+/*
	2	+ * Created by PyramIDE.
	3	+ * User: Steve Marechal
	4	+ * Date: 11/06/2008
	5	+ * Time: 09:54
	6	+ *
	7	+ */
	8	+
	9	+read calexium_lib/web/CXM_making_a_web_site.anubis
	10	+read tools/basis.anubis // required for 'make_directory'
	11	+read locale/L3LanguageInfo.anubis
	12	+
	13	+read mailfountain_constants.anubis
	14	+read mailfountain_types.anubis
	15	+read calexium_lib/web/CXM_common.anubis
	16	+read calexium_lib/web/CXM_making_a_web_site.anubis
	17	+read calexium_lib/web/CXM_multihost_http_server.anubis
	18	+read common/language_management.anubis
	19	+
	20	+read tools/mf_loggers.anubis
	21	+read calexium_lib/net_services_protocols/logger_service.anubis
	22	+read system/logger.anubis
	23	+
	24	+public type Dojo_Grid_Data :
	25	+ grid_data(String).
	26	+
	27	+public define HTML_Off_Form
	28	+ dojo_button
	29	+ (
	30	+ String name,
	31	+ String execute,
	32	+ String id,
	33	+ )
	34	+ =
	35	+ literal("
	36	+ <button dojoType=\"dijit.form.Button\" id=\""+id+"\" onclick=\""+execute+"\">"+name+"</button>")
	37	+.
	38	+
	39	+public define HTML_Off_Form
	40	+ dojo_dialog
	41	+ (
	42	+ String name,
	43	+ String dialog_id,
	44	+ String execute,
	45	+ )
	46	+ =
	47	+ sequence[
	48	+ dojo_button(name,"dijit.byId('"+dialog_id+"').show()", "dialog_id"),
	49	+ div([attr("dojoType", "dijit.Dialog"), id(dialog_id), title(name), attr("execute", execute)],
	50	+ table([],
	51	+ empty,
	52	+ [
	53	+ row([], [cell([], literal("<input dojoType=dijit.form.TextBox type=\"text\" name=\"name\" id=\"name_"+dialog_id+"\" />"))]),
	54	+ row([], [cell([columns(2), h_center], literal("<button dojoType=dijit.form.Button type=\"submit\">OK</button>"))]),
	55	+ ],
	56	+ empty)),
	57	+ literal("<br/>"),
	58	+// literal("
	59	+// <div dojoType=\"dijit.Dialog\" id=\""+id+"\" title=\""+name+"\"
	60	+// execute=\""+execute+"\">
	61	+// <table>
	62	+// <tr>
	63	+// <td><input dojoType=dijit.form.TextBox type=\"text\" name=\"name\" id=\"name_"+id+"\"></td>
	64	+// </tr>
	65	+//
	66	+// <tr>
	67	+// <td colspan=\"2\" align=\"center\">
	68	+// <button dojoType=dijit.form.Button type=\"submit\">OK</button></td>
	69	+// </tr>
	70	+// </table>
	71	+// </div><br />")
	72	+ ]
	73	+.
	74	+
	75	+public define HTML_Off_Form
	76	+ dojo_grid
	77	+ (
	78	+ String id,
	79	+ String colum1,
	80	+ String colum2,
	81	+ String colum3,
	82	+ String colum4,
	83	+ Bool can_edit
	84	+ )
	85	+ =
	86	+ literal("<script type=\"text/javascript\">
	87	+ dojo.addOnLoad(function(){
	88	+ init_dojo_grid(\""+colum1+"\",\""+colum2+"\", \""+colum3+"\", \""+colum4+"\", "+ (if can_edit then "1" else "0")+");
	89	+ }
	90	+ );
	91	+ </script>
	92	+<div id=\"gridContainer\"></div>")
	93	+.
	94	+
	95	+
	96	+public define HTML_Off_Form
	97	+ dojo_message_box
	98	+ (
	99	+ HTML_Off_Form name1,
	100	+ HTML_Off_Form name2,
	101	+ )
	102	+ =
	103	+ sequence([
	104	+ literal("<br/>"),
	105	+ div([class("message_box")],
	106	+ sequence([
	107	+ div([id("node3"), class("box nopad hidden")], name1),
	108	+ div([id("node4"), class("box two nopad")], name2),
	109	+ ])),
	110	+ literal("<br/>"),
	111	+ ]).
	112	+
	113	+
	114	+
	115	+public define HTML_Off_Form
	116	+ dojo_tooltip
	117	+ (
	118	+ String title,
	119	+ String keyword,
	120	+ ) =
	121	+ actioner(same,same, link([id("dojo_tip_" + keyword),class("dojoToolTip")],title, success(title)), "show_address_mailing", [("address_mailing", keyword)], []).
	122	+ //actioner(same, same, push_button([id("dojo_tip_" + keyword), class("in"), event(onclick,"new_search(this)")], keyword), "", [], []).
	123	+
	124	+
...	...

MF_1_1/web/CXM_generic_form.anubis 0 → 100644

Wrap text Show/Hide comments View file @9ca943b

	1	+
	2	+
	3	+
	4	+ Project The Anubis Project
	5	+
	6	+ Title
	7	+
	8	+ Copyright Copyright (c) Alain Prouté 2005.
	9	+
	10	+
	11	+ Author Alain Prouté
	12	+
	13	+
	14	+
	15	+ In this file we rationalize the construction of forms.
	16	+
	17	+
	18	+
	19	+read CXM_making_a_web_site.anubis
	20	+read tools/basis.anubis
	21	+
	22	+
	23	+public type Mandatory: // used to mark fields as mandatory.
	24	+ mandatory,
	25	+ non_mandatory.
	26	+
	27	+public type Width:
	28	+ small,
	29	+ narrow,
	30	+ wide,
	31	+ custom(Int).
	32	+
	33	+public type FormFieldWidth:
	34	+ auto,
	35	+ custom(Int).
	36	+
	37	+
	38	+
	39	+ Sorts of fields that you can put in a form:
	40	+
	41	+public type FormField:
	42	+
	43	+ //--- title field ---------------------------------------------------------------------
	44	+ title (String text),
	45	+ title (Int text_size,
	46	+ String text),
	47	+ title_f (List(Text_Option) -> HTML_In_Form),
	48	+
	49	+ //--- message field -------------------------------------------------------------------
	50	+ message (Result(String,String) msg),
	51	+ message_f (Result(List(Text_Option) -> HTML_In_Form,List(Text_Option) -> HTML_In_Form)),
	52	+
	53	+ //--- text input field ----------------------------------------------------------------
	54	+ input (WebArgName web_arg_name,
	55	+ String tag,
	56	+ Width width,
	57	+ InitialValue init_value,
	58	+ Mandatory mandatory),
	59	+ input (WebArgName web_arg_name,
	60	+ Width width,
	61	+ InitialValue init_value),
	62	+ input_f (WebArgName web_arg_name,
	63	+ List(Text_Option) -> HTML_In_Form tag,
	64	+ Width width,
	65	+ InitialValue init_value,
	66	+ Mandatory mandatory),
	67	+
	68	+ //--- password input field ------------------------------------------------------------
	69	+ password_input (WebArgName web_arg_name,
	70	+ String tag,
	71	+ Mandatory mandatory),
	72	+ password_input_f (WebArgName web_arg_name,
	73	+ List(Text_Option) -> HTML_In_Form tag,
	74	+ Mandatory mandatory),
	75	+
	76	+ //--- explanation field ---------------------------------------------------------------
	77	+ explain (String text),
	78	+ explain (String text,
	79	+ FormFieldWidth width),
	80	+ explain_f (List(Text_Option) -> HTML_In_Form),
	81	+
	82	+ //--- selector field ------------------------------------------------------------------
	83	+ selector (WebArgName web_arg_name,
	84	+ String tag,
	85	+ List(String) items,
	86	+ Maybe(InitialValue) selected,
	87	+ Mandatory mandatory),
	88	+ selector_f (WebArgName web_arg_name,
	89	+ List(Text_Option) -> HTML_In_Form,
	90	+ List(String) items,
	91	+ Maybe(InitialValue) selected,
	92	+ Mandatory mandatory),
	93	+ selector_c (WebArgName web_arg_name,
	94	+ String tag,
	95	+ List((WebArgValue,String)) items,
	96	+ Maybe(InitialValue) selected,
	97	+ Mandatory mandatory),
	98	+
	99	+
	100	+
	101	+ //--- checkbox field ------------------------------------------------------------------
	102	+ checkbox (WebArgName web_arg_name,
	103	+ String tag,
	104	+ Bool checked,
	105	+ Mandatory mandatory),
	106	+ // the same one, but with the tag on the right of the checkbox
	107	+ checkboxr (WebArgName web_arg_name,
	108	+ String tag,
	109	+ Bool checked,
	110	+ Mandatory mandatory),
	111	+ checkbox_f (WebArgName web_arg_name,
	112	+ List(Text_Option) -> HTML_In_Form,
	113	+ Bool checked,
	114	+ Mandatory mandatory),
	115	+
	116	+ //--- radio-button field --------------------------------------------------------------
	117	+ radio_button (WebArgName web_arg_name,
	118	+ WebArgValue web_arg_value,
	119	+ String tag,
	120	+ Bool checked,
	121	+ Mandatory mandatory),
	122	+ // the same one, but with the tag on the right of the radio_button
	123	+ radio_buttonr (WebArgName web_arg_name,
	124	+ WebArgValue web_arg_value,
	125	+ String tag,
	126	+ Bool checked,
	127	+ Mandatory mandatory),
	128	+
	129	+ //--- text area field -----------------------------------------------------------------
	130	+ text_area (WebArgName web_arg_name,
	131	+ InitialValue initial_text),
	132	+ text_area (WebArgName web_arg_name,
	133	+ String tag,
	134	+ InitialValue initial_text),
	135	+ text_area (WebArgName web_arg_name,
	136	+ String tag,
	137	+ InitialValue initial_text,
	138	+ Int width,
	139	+ Int height),
	140	+
	141	+ //--- fields table --------------------------------------------------------------------
	142	+ fields_table (String tag,
	143	+ List(FormField) fields),
	144	+
	145	+ //--- fields line ---------------------------------------------------------------------
	146	+ fields_line (String tag,
	147	+ List(FormField) fields),
	148	+ fields_line (List(FormField) fields),
	149	+
	150	+ //--- preview field -------------------------------------------------------------------
	151	+ preview (String html_text),
	152	+
	153	+ //--- submit button -------------------------------------------------------------------
	154	+ submit (String action_name,
	155	+ Maybe(String) label,
	156	+ String button_text,
	157	+ List((String,String)) extra_operands).
	158	+
	159	+
	160	+ Convenience functions:
	161	+
	162	+public define FormField title(List(Text_Option) -> HTML_In_Form f) = title_f(f).
	163	+public define FormField
	164	+ message(Result(List(Text_Option) -> HTML_In_Form,List(Text_Option) -> HTML_In_Form) f) = message_f(f).
	165	+public define FormField input(WebArgName web_arg_name,
	166	+ List(Text_Option) -> HTML_In_Form tag,
	167	+ Width width,
	168	+ InitialValue init_value,
	169	+ Mandatory mandatory)
	170	+ = input_f(web_arg_name,tag,width,init_value,mandatory).
	171	+public define FormField password_input(WebArgName web_arg_name,
	172	+ List(Text_Option) -> HTML_In_Form tag,
	173	+ Mandatory mandatory)
	174	+ = password_input_f(web_arg_name,tag,mandatory).
	175	+public define FormField explain(List(Text_Option) -> HTML_In_Form f) = explain_f(f).
	176	+public define FormField selector(WebArgName web_arg_name,
	177	+ List(Text_Option) -> HTML_In_Form f,
	178	+ List(String) items,
	179	+ Maybe(InitialValue) selected,
	180	+ Mandatory mandatory)
	181	+ = selector_f(web_arg_name,f,items,selected,mandatory).
	182	+public define FormField checkbox(WebArgName web_arg_name,
	183	+ List(Text_Option) -> HTML_In_Form f,
	184	+ Bool checked,
	185	+ Mandatory mandatory)
	186	+ = checkbox_f(web_arg_name,f,checked,mandatory).
	187	+
	188	+ Make the form itself with:
	189	+
	190	+public define HTML_Off_Form
	191	+ generic_form
	192	+ (
	193	+ String form_name,
	194	+ RGB background_color,
	195	+ Int width,
	196	+ List(FormField) fields
	197	+ ).
	198	+
	199	+
	200	+
	201	+ --- That's all for the public part ! --------------------------------------------------
	202	+
	203	+// TO DO update code of CXM generic form
	204	+define HTML_Row(HTML_In_Form)
	205	+ format_form_field
	206	+ (
	207	+ FormField ff
	208	+ ) =
	209	+ with star = (Mandatory m) \|-> (HTML_In_Form)text([color(rgb(255,0,0)),size(12)],
	210	+ if m is
	211	+ {
	212	+ mandatory then "*",
	213	+ non_mandatory then ""
	214	+ }),
	215	+ row(
	216	+ if ff is
	217	+ {
	218	+ title(t) then (List(HTML_Cell(HTML_In_Form)))
	219	+ [
	220	+ cell([columns(3),h_center],text([size(16),bold,color(rgb(0,0,0))],t))
	221	+ ],
	222	+
	223	+ title(s,t) then (List(HTML_Cell(HTML_In_Form)))
	224	+ [
	225	+ cell([columns(3),h_center],text([size(s),bold,color(rgb(0,0,0))],t))
	226	+ ],
	227	+
	228	+ title_f(t) then (List(HTML_Cell(HTML_In_Form)))
	229	+ [
	230	+ cell([columns(3),h_center],t([size(16),bold,color(rgb(0,0,0))]))
	231	+ ],
	232	+
	233	+ message(r) then (List(HTML_Cell(HTML_In_Form))) if r is
	234	+ {
	235	+ error(msg) then [cell([columns(3),h_center],
	236	+ text([size(10),color(rgb(240,0,0))],msg))]
	237	+ ok(msg) then [cell([columns(3),h_center],
	238	+ text([size(10),color(rgb(0,150,0))],msg))]
	239	+ },
	240	+
	241	+ message_f(r) then (List(HTML_Cell(HTML_In_Form))) if r is
	242	+ {
	243	+ error(msg) then [cell([columns(3),h_center],
	244	+ msg([size(10),color(rgb(240,0,0))]))]
	245	+ ok(msg) then [cell([columns(3),h_center],
	246	+ msg([size(10),color(rgb(0,150,0))]))]
	247	+ },
	248	+
	249	+ input(wan,tag,w,init,mand) then (List(HTML_Cell(HTML_In_Form)))
	250	+ [
	251	+ cell([right ], text([size(10)],tag)),
	252	+ cell([width(7) ], star(mand)),
	253	+ cell([left ], text_input([], "",htmlId(""),wan,init,if w is
	254	+ {
	255	+ small then 10,
	256	+ narrow then 50,
	257	+ wide then 70,
	258	+ custom(n) then n
	259	+ }))
	260	+ ],
	261	+
	262	+ input(wan,w,init) then (List(HTML_Cell(HTML_In_Form)))
	263	+ [
	264	+ cell([left,columns(3) ], text_input([], "", htmlId(""), wan,init,if w is
	265	+ {
	266	+ small then 10,
	267	+ narrow then 30,
	268	+ wide then 70,
	269	+ custom(n) then n
	270	+ }))
	271	+ ],
	272	+
	273	+ input_f(wan,tag,w,init,mand) then (List(HTML_Cell(HTML_In_Form)))
	274	+ [
	275	+ cell([right ], tag([size(10)])),
	276	+ cell([width(7) ], star(mand)),
	277	+ cell([left ], text_input([], "", htmlId(""),wan,init,if w is
	278	+ {
	279	+ small then 15,
	280	+ narrow then 30,
	281	+ wide then 70,
	282	+ custom(n) then n
	283	+ }))
	284	+ ],
	285	+
	286	+ password_input(wan,tag,mand) then (List(HTML_Cell(HTML_In_Form)))
	287	+ [
	288	+ cell([right ], text([size(10)],tag)),
	289	+ cell([width(7) ], star(mand)),
	290	+ cell([left ], password_input([], "",htmlId(""), wan, init(""), 30))
	291	+ ],
	292	+
	293	+ password_input_f(wan,tag,mand) then (List(HTML_Cell(HTML_In_Form)))
	294	+ [
	295	+ cell([right ], tag([size(10)])),
	296	+ cell([width(7) ], star(mand)),
	297	+ cell([left ], password_input([], "",htmlId(""), wan, init(""), 30))
	298	+ ],
	299	+
	300	+ explain(t) then (List(HTML_Cell(HTML_In_Form)))
	301	+ [
	302	+ cell([columns(3),h_center],
	303	+ table([nude],[row(cell([width(500)],
	304	+ paragraph([/justified,/size(10),color(rgb(0,100,0))],literal(t))))]))
	305	+ ],
	306	+
	307	+ explain(t,w) then (List(HTML_Cell(HTML_In_Form)))
	308	+ [
	309	+ cell([columns(3),h_center],
	310	+ table([nude],[row(cell(
	311	+ if w is
	312	+ {
	313	+ auto then [],
	314	+ custom(i) then [width(i)]
	315	+ },
	316	+ paragraph([/justified,/size(10),color(rgb(0,100,0))], literal(t))))]))
	317	+ ],
	318	+
	319	+ explain_f(t) then (List(HTML_Cell(HTML_In_Form)))
	320	+ [
	321	+ cell([columns(3),h_center],
	322	+ table([nude],[row(cell([width(500)],
	323	+ t([/justified,/size(10),color(rgb(0,100,0))])))]))
	324	+ ],
	325	+
	326	+ selector(wan,tag,items,selected,mand) then (List(HTML_Cell(HTML_In_Form)))
	327	+ [
	328	+ cell([right ], text([size(10)],tag)),
	329	+ cell([width(7)], star(mand)),
	330	+ cell([left ], if selected is
	331	+ {
	332	+ failure then selector([], "", htmlId(""), wan,1,items)
	333	+ success(sel) then selector([], "", htmlId(""), wan,1,items, sel)
	334	+ })
	335	+ ],
	336	+
	337	+ selector_f(wan,tag,items,selected,mand) then (List(HTML_Cell(HTML_In_Form)))
	338	+ [
	339	+ cell([right ], tag([size(10)])),
	340	+ cell([width(7)], star(mand)),
	341	+ cell([left ], if selected is
	342	+ {
	343	+ failure then selector([], "", htmlId(""), wan,1,items)
	344	+ success(sel) then selector([], "", htmlId(""), wan,1,items, sel)
	345	+ })
	346	+ ],
	347	+
	348	+ selector_c(wan,tag,items,selected,mand) then (List(HTML_Cell(HTML_In_Form)))
	349	+ [
	350	+ cell([right ], text([size(10)],tag)),
	351	+ cell([width(7)], star(mand)),
	352	+ cell([left ], if selected is
	353	+ {
	354	+ failure then selector_c([], "", htmlId(""), wan,1,items)
	355	+ success(sel) then selector_c([], "", htmlId(""), wan,1,items,sel)
	356	+ })
	357	+ ],
	358	+
	359	+ checkbox(wan,tag,checked,mand) then (List(HTML_Cell(HTML_In_Form)))
	360	+ [
	361	+ cell([right ], text([size(10)],tag)),
	362	+ cell([width(7)], star(mand)),
	363	+ cell([left ], check_box([], "",htmlId(""),wan, wav(wan.name),checked))
	364	+ ],
	365	+
	366	+ checkboxr(wan,tag,checked,mand) then (List(HTML_Cell(HTML_In_Form)))
	367	+ [
	368	+ cell([right ], check_box([], "",htmlId(""),wan, wav(wan.name),checked)),
	369	+ cell([width(7)], star(mand)),
	370	+ cell([left ], text([size(10)],tag))
	371	+ ],
	372	+
	373	+ checkbox_f(wan,tag,checked,mand) then (List(HTML_Cell(HTML_In_Form)))
	374	+ [
	375	+ cell([right ], tag([size(10)])),
	376	+ cell([width(7)], star(mand)),
	377	+ cell([left ], check_box([], "",htmlId(""),wan,wav(wan.name),checked))
	378	+ ],
	379	+
	380	+ radio_button(wan,wav,tag,checked,mand) then (List(HTML_Cell(HTML_In_Form)))
	381	+ [
	382	+ cell([right ], text([size(10)],tag)),
	383	+ cell([width(7)], star(mand)),
	384	+ cell([left ], radio_button([], "", htmlId(""), wan, wav, checked))
	385	+ ],
	386	+
	387	+ radio_buttonr(wan,wav,tag,checked,mand) then (List(HTML_Cell(HTML_In_Form)))
	388	+ [
	389	+ cell([right ], radio_button([], "", htmlId(""), wan, wav, checked)),
	390	+ cell([width(7)], star(mand)),
	391	+ cell([left ], text([size(10)],tag))
	392	+ ],
	393	+
	394	+ text_area(wan,tx) then (List(HTML_Cell(HTML_In_Form)))
	395	+ [
	396	+ cell([h_center,columns(3)],text_area([wrap_lines],wan,tx,75,10))
	397	+ ],
	398	+
	399	+ text_area(wan,tag,tx) then (List(HTML_Cell(HTML_In_Form)))
	400	+ [
	401	+ cell([right,top], text([size(10)],tag)),
	402	+ cell([width(7)], text([],"")),
	403	+ cell([h_center],text_area([wrap_lines],wan,tx,75,10))
	404	+ ],
	405	+
	406	+ text_area(wan,tag,tx,w,h) then (List(HTML_Cell(HTML_In_Form)))
	407	+ [
	408	+ cell([right,top], text([size(10)],tag)),
	409	+ cell([width(7)], text([],"")),
	410	+ cell([h_center],text_area([wrap_lines],wan,tx,w,h))
	411	+ ],
	412	+
	413	+ fields_table(tag,fields) then (List(HTML_Cell(HTML_In_Form)))
	414	+ [
	415	+ cell([right,top], text([size(10)],tag)),
	416	+ cell([width(7)], text([],"")),
	417	+ cell([left,top], table([],map((FormField ff2) \|-> format_form_field(ff2),fields)))
	418	+ ],
	419	+
	420	+ fields_line(tag,fields) then (List(HTML_Cell(HTML_In_Form)))
	421	+ [
	422	+ cell([right,top], text([size(10)],tag)),
	423	+ cell([width(7)], text([],"")),
	424	+ cell([left,top], table([nude],[row([], //border(0,0,3,rgb(0,0,0))
	425	+ map((FormField ff2) \|-> cell([top],table([nude],[format_form_field(ff2)])),fields))]))
	426	+ ],
	427	+
	428	+ fields_line(fields) then (List(HTML_Cell(HTML_In_Form)))
	429	+ [
	430	+ cell([left,top,columns(3)], table([nude],[row([],
	431	+ map((FormField ff2) \|-> cell([top],table([nude],[format_form_field(ff2)])),fields))]))
	432	+ ],
	433	+
	434	+ preview(html_text) then (List(HTML_Cell(HTML_In_Form)))
	435	+ [
	436	+ cell([top,left,columns(3),background_color(rgb(255,255,255))],
	437	+ table([border(0,8,0,rgb(0,0,0))],
	438	+ [row(cell([left,top,height(200)],literal(html_text)))]))
	439	+ ],
	440	+
	441	+ submit(action_name,mb_label,button_text,extra_operands) then (List(HTML_Cell(HTML_In_Form)))
	442	+ [
	443	+ cell([columns(3),right],actioner(same,
	444	+ if mb_label is
	445	+ {
	446	+ failure then same,
	447	+ success(n) then same(n)
	448	+ },
	449	+ submit([], button_text),
	450	+ action_name,
	451	+ extra_operands))
	452	+ ]
	453	+ }).
	454	+
	455	+
	456	+
	457	+// TO DO update code of CXM generic form
	458	+public define HTML_Off_Form
	459	+ generic_form
	460	+ (
	461	+ String form_name,
	462	+ RGB bg_color,
	463	+ Int w,
	464	+ List(FormField) fields
	465	+ ) =
	466	+ table([border(0,0,5,bg_color),percentage_width(100),
	467	+ background_color(bg_color)],[row(cell([h_center],
	468	+ form(form_name,[],table([border(0,2,0,bg_color)],
	469	+ map(format_form_field, fields)))))]).
	470	+
	471	+
...	...

MF_1_1/web/CXM_generic_login.anubis 0 → 100644

Wrap text Show/Hide comments View file @9ca943b

	1	+
	2	+
	3	+
	4	+
	5	+ Rationalisation de la gestion des logins et des mots de passe
	6	+
	7	+read CXM_common.anubis
	8	+read CXM_making_a_web_site.anubis
	9	+read CXM_generic_form.anubis
	10	+
	11	+
	12	+
	13	+
	14	+ *** (1) Connection sur site sécurisée
	15	+
	16	+ ou formulaire de saisie du login et du mot de passe
	17	+
	18	+
	19	+ Le formulaire de saisie du login et du mot de passe pour se connecter à un site https
	20	+ se compose :
	21	+ .1. d'un éventuel message pour alerter que la paire (login,passwd) est erronée,
	22	+ .2. du formulaire proprement dit pour lequel il faut donner :
	23	+ - le titre du formulaire
	24	+ - les textes figurant devant les 2 texts input
	25	+ - le text du bouton submit
	26	+ - le nom de l'action,
	27	+ - la couleur de fond
	28	+
	29	+
	30	+
	31	+public define HTML_Off_Form
	32	+ login_form
	33	+ (
	34	+ String wrong_message,
	35	+ RGB background_color,
	36	+ String title_text,
	37	+ String pseudo_text,
	38	+ String passwd_text,
	39	+ String submit_text,
	40	+ String login_action
	41	+ ).
	42	+
	43	+
	44	+
	45	+
	46	+ *** (2) Vérification de la saisie
	47	+
	48	+
	49	+public define Maybe($User)
	50	+ check_login_passwd
	51	+ (
	52	+ String -> Maybe($User) check_pseudo,
	53	+ $User -> ByteArray get_passwd,
	54	+ List(Web_arg) lwa
	55	+ ).
	56	+
	57	+
	58	+
	59	+ --- That's all for the public part ! --------------------------------------------------
	60	+
	61	+
	62	+
	63	+ *** [1] Connection sur site sécurisée
	64	+
	65	+public define HTML_Off_Form
	66	+ login_form
	67	+ (
	68	+ String wrong_message,
	69	+ RGB background_color,
	70	+ String title_text,
	71	+ String pseudo_text,
	72	+ String passwd_text,
	73	+ String submit_text,
	74	+ String login_action
	75	+ ) =
	76	+ generic_form
	77	+ ("login_form",background_color,700,
	78	+ [
	79	+ title (title_text),
	80	+ explain (wrong_message),
	81	+ input ("pseudo",pseudo_text,narrow,"",mandatory),
	82	+ password_input ("passwd",passwd_text,mandatory),
	83	+ submit (login_action,failure,submit_text,[])
	84	+ ]).
	85	+
	86	+
	87	+
	88	+ *** [2] Vérification de la saisie
	89	+
	90	+public define Maybe($User)
	91	+ check_login_passwd
	92	+ (
	93	+ String -> Maybe($User) check_pseudo,
	94	+ $User -> ByteArray get_passwd,
	95	+ List(Web_arg) lwa
	96	+ ) =
	97	+ if web_arg_value(lwa,"pseudo") is
	98	+ {
	99	+ not_found then failure,
	100	+ found(ps) then
	101	+ if web_arg_value(lwa,"passwd") is
	102	+ {
	103	+ not_found then failure,
	104	+ found(pwd) then
	105	+ if check_pseudo(ps) is
	106	+ {
	107	+ failure then failure,
	108	+ success(user) then
	109	+ if sha1(to_byte_array(pwd))=get_passwd(user)
	110	+ then success(user)
	111	+ else failure
	112	+ }
	113	+ }}.
	114	+
	115	+
	116	+
...	...

MF_1_1/web/CXM_generic_table.anubis 0 → 100644

Wrap text Show/Hide comments View file @9ca943b

	1	+
	2	+ Project The Anubis Project
	3	+
	4	+ Title Generic table page.
	5	+
	6	+ Copyright Copyright (c) Alain Prouté 2004.
	7	+
	8	+
	9	+ Author Alain Prouté
	10	+ Author Olivier Duvernois
	11	+
	12	+
	13	+
	14	+ ----------------------------------------------------------------------------------------
	15	+
	16	+
	17	+
	18	+
	19	+read tools/basis.anubis
	20	+read CXM_common.anubis
	21	+read CXM_making_a_web_site.anubis
	22	+
	23	+
	24	+ The purpose is to print on a html browser a table from a List($Data) using the function
	25	+ 'generic_table()' describe below.
	26	+
	27	+ Note : the explanations are only given for HTML_Item and its components. But they are
	28	+ also available for HTML_Form and HTML_Element and their components.
	29	+
	30	+
	31	+ A table may have the following look :
	32	+
	33	+ +-----+----------+--------+-----------------------+ ...............
	34	+ \| \| \| \| name 3 \|
	35	+ \| num \| name1 \| name2 \|-----------+-----------+ columns_name
	36	+ \| \| \| \| name 31 \| name 32 \|
	37	+ +-----+----------+--------+-----------+-----------+ ...............
	38	+ \| 1 \| data11 \| data12 \| data131 \| data132 \| line 1 with background color a
	39	+ +-----+----------+--------+-----------+-----------+ ...............
	40	+ \| 2 \| data21 \| data22 \| data231 \| data232 \| line 2 with background color b
	41	+ +-----+----------+--------+-----------+-----------+ ...............
	42	+ \| 3 \| data31 \| data32 \| data331 \| data332 \| line 3 with background color a
	43	+ +-----+----------+--------+-----------+-----------+ ...............
	44	+
	45	+ \| n \| datan1 \| datan2 \| datan31 \| datan32 \| line n with background color ?
	46	+ +-----+----------+--------+-----------+-----------+ ...............
	47	+ \|total\| total1 \| \| \| total32 \| total line
	48	+ +-----+----------+--------+-----------+-----------+ ...............
	49	+
	50	+ For the total-line, assuming that datax1 to dataxn and datax32 to datan32 are numbers
	51	+ (Int, Float or Maybe(Float)).
	52	+
	53	+
	54	+ The columns name are just a List(Item_Row).
	55	+
	56	+ The column 'num' is in the case you want to enumerate your data. The existence of this
	57	+ column depends on the line function.
	58	+
	59	+ Lines are given by the function : (RGB color,Int num,$Data d) -> Item_Row
	60	+
	61	+ where : - (RGB)color is the color of the background of the row (the 'a color' or 'b
	62	+ color');
	63	+ - (Int)num the number of the data (to enumerate).
	64	+
	65	+ So, this function must be written something like :
	66	+
	67	+ (RGB color, Int num,$Data d) \|->
	68	+ row([background_color(color)], // and of course possibly other row-options
	69	+ [
	70	+ cell([], (Int -> $HTML)(num) )
	71	+ . ($Data -> List(Cell))d // how data is printed in cells
	72	+ ]).
	73	+
	74	+ But, for the above convenient function with no enumeration, you can only write :
	75	+
	76	+ (RGB color, $Data d) \|->
	77	+ row([background_color(color)], // and of course possibly other row-options
	78	+ ($Data -> List(Cell))d // how data is printed in cells
	79	+ ).
	80	+
	81	+
	82	+ If you want to sum by column your data, use the following type :
	83	+
	84	+public type Total_Line($Data,$Upplet,$Row):
	85	+ no_total,
	86	+ total
	87	+ (
	88	+ ($Upplet,$Data) -> $Upplet sum_functions,
	89	+ $Upplet -> $Row print_total_line,
	90	+ $Upplet initial_value
	91	+ ).
	92	+
	93	+ $Row is for HTML_Row($HTML).
	94	+ $Upplet represents the components of $Data that will be sum.
	95	+
	96	+ Example :
	97	+ with the above sheme table, $Data is something like :
	98	+ type $Data
	99	+ data
	100	+ (
	101	+ Data1 d1,
	102	+ Data2 d2
	103	+ Data3 d3
	104	+ ).
	105	+ and type Data3:
	106	+ data3
	107	+ (
	108	+ Data31 d31,
	109	+ Data32 d32
	110	+ ).
	111	+
	112	+ So $Upplet will be (Data1,Data32) : sums are wanted for those 2 datum
	113	+
	114	+ The function ($Upplet,$Data) -> $Upplet will be written like :
	115	+ ($Upplet u,$Data d) -> if u is (u1,u2) then (u1+d1(d), u2+d32(d3(d)))
	116	+
	117	+ (if of course (Data1 + Data1) and (Data32 + Data32) are defined).
	118	+
	119	+
	120	+
	121	+ - Several columns -
	122	+ -------------------
	123	+
	124	+ If you want to print your data on sevaral columns (i.e. considering the above table
	125	+ scheme as a column), you must specify the number of columns. You will obtain :
	126	+
	127	+ Here is a List($Data) : l = [a,b,c,d,e,f,g,h,i,j,k,l,m];
	128	+ and f : (RGB,Int,$Data) -> Item_Row
	129	+ You want to print this list on 3 columns.
	130	+ The result will be :
	131	+
	132	+
	133	+ +-----------+-----------+-----------+
	134	+ \| col.names \| col.names \| col.names \|
	135	+ +-----------+-----------+-----------+
	136	+ \| f(a) \| f(f) \| f(k) \|
	137	+ +-----------+-----------+-----------+
	138	+ \| f(b) \| f(g) \| f(l) \|
	139	+ +-----------+-----------+-----------+ Each column is a table as defined
	140	+ \| f(c) \| f(h) \| f(m) \| above.
	141	+ +-----------+-----------+-----------+
	142	+ \| f(d) \| f(i) \| \|
	143	+ +-----------+-----------+-----------+
	144	+ \| f(e) \| f(j) \| \|
	145	+ +-----------+-----------+-----------+
	146	+
	147	+
	148	+ If several columns are required, it's also asked for spaces between two colums.
	149	+
	150	+ So use the following type :
	151	+
	152	+public type HowManyColumns:
	153	+ _1,
	154	+ several (Int col_nb,
	155	+ Int spacer).
	156	+
	157	+
	158	+
	159	+
	160	+ - Now the Generic table definition -
	161	+ ------------------------------------
	162	+
	163	+ Here is the most customizable generic table. Below, they are some convenience functions.
	164	+
	165	+public define HTML_Off_Form
	166	+ generic_table
	167	+ (
	168	+ List($Data) data,
	169	+ List(Table_Option) lto,
	170	+ List(HTML_Row(HTML_Off_Form)) columns_name,
	171	+ HowManyColumns number_of_columns,
	172	+ (RGB,Int,$Data) -> HTML_Row(HTML_Off_Form) line_format,
	173	+ RGB a_color,
	174	+ RGB b_color,
	175	+ Total_Line($Data,$Upplet,HTML_Row(HTML_Off_Form)) total_line
	176	+ ).
	177	+
	178	+public define HTML_In_Form
	179	+ generic_table
	180	+ (
	181	+ List($Data) data,
	182	+ List(Table_Option) lto,
	183	+ List(HTML_Row(HTML_In_Form)) columns_name,
	184	+ HowManyColumns number_of_columns,
	185	+ (RGB,Int,$Data) -> HTML_Row(HTML_In_Form) line_format,
	186	+ RGB a_color,
	187	+ RGB b_color,
	188	+ Total_Line($Data,$Upplet,HTML_Row(HTML_In_Form)) total_line
	189	+ ).
	190	+
	191	+
	192	+
	193	+ Note :
	194	+ List(Table_Option) : if you choose 'nude' (i.e. border(0,0,0)), don't forget a
	195	+ horizontal spacer between the cells contain in the 'line_format' row. If you don't put
	196	+ any, each data will be closer to the next one.
	197	+
	198	+
	199	+
	200	+ - Convenience functions -
	201	+ -------------------------
	202	+
	203	+ 1/ Table without multicolumns, enumeration and total-line:
	204	+
	205	+public define HTML_Off_Form
	206	+ generic_table
	207	+ (
	208	+ List($Data) data,
	209	+ List(Table_Option) lto,
	210	+ List(HTML_Row(HTML_Off_Form)) columns_name,
	211	+ (RGB,$Data) -> HTML_Row(HTML_Off_Form) line_format,
	212	+ RGB a_color,
	213	+ RGB b_color
	214	+ ).
	215	+
	216	+public define HTML_In_Form
	217	+ generic_table
	218	+ (
	219	+ List($Data) data,
	220	+ List(Table_Option) lto,
	221	+ List(HTML_Row(HTML_In_Form)) columns_name,
	222	+ (RGB,$Data) -> HTML_Row(HTML_In_Form) line_format,
	223	+ RGB a_color,
	224	+ RGB b_color
	225	+ ).
	226	+
	227	+
	228	+
	229	+ 2/ Table with total-line and without multicolumns, enumeration.
	230	+
	231	+
	232	+public define HTML_Off_Form
	233	+ generic_table
	234	+ (
	235	+ List($Data) data,
	236	+ List(Table_Option) lto,
	237	+ List(HTML_Row(HTML_Off_Form)) columns_name,
	238	+ (RGB,$Data) -> HTML_Row(HTML_Off_Form) line_format,
	239	+ RGB a_color,
	240	+ RGB b_color,
	241	+ Total_Line($Data,$Upplet,HTML_Row(HTML_Off_Form)) total_line
	242	+ ).
	243	+
	244	+public define HTML_In_Form
	245	+ generic_table
	246	+ (
	247	+ List($Data) data,
	248	+ List(Table_Option) lto,
	249	+ List(HTML_Row(HTML_In_Form)) columns_name,
	250	+ (RGB,$Data) -> HTML_Row(HTML_In_Form) line_format,
	251	+ RGB a_color,
	252	+ RGB b_color,
	253	+ Total_Line($Data,$Upplet,HTML_Row(HTML_In_Form)) total_line
	254	+ ).
	255	+
	256	+
	257	+ 3/ Table with multicolumns, enumeration, but without total
	258	+
	259	+public define HTML_Off_Form
	260	+ generic_table
	261	+ (
	262	+ List($Data) data,
	263	+ List(Table_Option) lto,
	264	+ List(HTML_Row(HTML_Off_Form)) columns_name,
	265	+ HowManyColumns number_of_columns,
	266	+ (RGB,Int,$Data) -> HTML_Row(HTML_Off_Form) line_format,
	267	+ RGB a_color,
	268	+ RGB b_color
	269	+ ).
	270	+
	271	+public define HTML_In_Form
	272	+ generic_table
	273	+ (
	274	+ List($Data) data,
	275	+ List(Table_Option) lto,
	276	+ List(HTML_Row(HTML_In_Form)) columns_name,
	277	+ HowManyColumns number_of_columns,
	278	+ (RGB,Int,$Data) -> HTML_Row(HTML_In_Form) line_format,
	279	+ RGB a_color,
	280	+ RGB b_color
	281	+ ).
	282	+
	283	+
	284	+
	285	+ 4/ Table with multicolumns and without enumeration & total
	286	+
	287	+public define HTML_Off_Form
	288	+ generic_table
	289	+ (
	290	+ List($Data) data,
	291	+ List(Table_Option) lto,
	292	+ List(HTML_Row(HTML_Off_Form)) columns_name,
	293	+ HowManyColumns number_of_columns,
	294	+ (RGB,$Data) -> HTML_Row(HTML_Off_Form) line_format,
	295	+ RGB a_color,
	296	+ RGB b_color
	297	+ ).
	298	+
	299	+public define HTML_In_Form
	300	+ generic_table
	301	+ (
	302	+ List($Data) data,
	303	+ List(Table_Option) lto,
	304	+ List(HTML_Row(HTML_In_Form)) columns_name,
	305	+ HowManyColumns number_of_columns,
	306	+ (RGB,$Data) -> HTML_Row(HTML_In_Form) line_format,
	307	+ RGB a_color,
	308	+ RGB b_color
	309	+ ).
	310	+
	311	+
	312	+ --- That's all for public part. -------------------------------------------------------------------------
	313	+
	314	+
	315	+ When the datum $Data must be presented on several columns, the initial list must be
	316	+ re-composed : sot the type Print_Table.
	317	+
	318	+type Print_Table($Data):
	319	+ print_table
	320	+ (
	321	+ $Data data,
	322	+ Int num
	323	+ ).
	324	+
	325	+
	326	+ *** Transform List($Data) into List(Print_Table($Data))
	327	+
	328	+
	329	+define (List(Print_Table($Data)),List($Data))
	330	+ get_n_elements
	331	+ (
	332	+ List($Data) l,
	333	+ List(Print_Table($Data)) result,
	334	+ Int n,
	335	+ Int ct, // counter
	336	+ Int num
	337	+ ) =
	338	+ if l is
	339	+ {
	340	+ [] then (reverse(result),[]),
	341	+ [h . t] then
	342	+ if ct = n
	343	+ then (reverse([print_table(h,num+1) .result]),t)
	344	+ else get_n_elements(t,[print_table(h,num+1) . result],n,ct+1,num+1)
	345	+ }.
	346	+
	347	+
	348	+define List(List(Print_Table($Data)))
	349	+ short_lists
	350	+ (
	351	+ List($Data) l,
	352	+ Int nb, // number of element of short list
	353	+ Int ct // counter for numbering data (initialized at 0)
	354	+ ) =
	355	+ if get_n_elements(l,[],nb,1,ct) is (result,unused)
	356	+ then if unused is
	357	+ {
	358	+ [] then [result],
	359	+ [_ . _] then [result . short_lists(unused,nb,ct+nb)]
	360	+ }.
	361	+
	362	+
	363	+ - Generic row -
	364	+ ---------------
	365	+
	366	+define (List(HTML_Row($HTML)),$Upplet)
	367	+ generic_rows
	368	+ (
	369	+ List(Print_Table($Data)) lpt,
	370	+ (RGB,Int,$Data) -> HTML_Row($HTML) line_format,
	371	+ RGB a_color,
	372	+ RGB b_color,
	373	+ ($Upplet,$Data) -> $Upplet do_sum,
	374	+ List(HTML_Row($HTML)) rows,
	375	+ $Upplet sum
	376	+ ) =
	377	+ if lpt is
	378	+ {
	379	+ [] then (reverse(rows),sum),
	380	+ [h . t] then
	381	+ generic_rows(t,line_format,b_color,a_color,do_sum,
	382	+ [line_format(a_color,num(h),data(h)) . rows],do_sum(sum,data(h)))
	383	+ }.
	384	+
	385	+
	386	+
	387	+ - HTML_In_Form -
	388	+ ----------------
	389	+
	390	+define List(HTML_Cell(HTML_In_Form))
	391	+ generic_cells
	392	+ (
	393	+ List(List(Print_Table($Data))) print_data,
	394	+ List(Table_Option) lto,
	395	+ List(HTML_Row(HTML_In_Form)) names,
	396	+ (RGB,Int,$Data) -> HTML_Row(HTML_In_Form) line_format,
	397	+ RGB a_color,
	398	+ RGB b_color,
	399	+ ($Upplet,$Data) -> $Upplet do_sum,
	400	+ $Upplet -> HTML_Row(HTML_In_Form) total_line,
	401	+ $Upplet value,
	402	+ Int spacer
	403	+ ) =
	404	+ if print_data is
	405	+ {
	406	+ [] then (List(HTML_Cell(HTML_In_Form))) [],
	407	+ [h . t] then
	408	+ if generic_rows(h,line_format,a_color,b_color,do_sum,(List(HTML_Row(HTML_In_Form)))[],value) is
	409	+ (rows,new_value) then
	410	+ if t is []
	411	+ then [cell([top],table(lto,names+rows+[total_line(new_value)]))]
	412	+ else [
	413	+ cell([top],table(lto,append(names,rows)))
	414	+ . if spacer = 0
	415	+ then generic_cells
	416	+ (t,lto,names,line_format,a_color,b_color,do_sum,total_line,new_value,spacer)
	417	+ else [cell([width(spacer)],text([],""))
	418	+ . generic_cells
	419	+ (t,lto,names,line_format,a_color,b_color,do_sum,total_line,new_value,spacer)]
	420	+ ]
	421	+ }.
	422	+
	423	+public define Int
	424	+ Int x (mod Int y)
	425	+ =
	426	+ if x / y is
	427	+ {
	428	+ failure then 0,
	429	+ success(result) then
	430	+ if result is (q, r) then r
	431	+ }.
	432	+
	433	+
	434	+
	435	+public define HTML_In_Form
	436	+ generic_table
	437	+ (
	438	+ List($Data) l,
	439	+ List(Table_Option) lto,
	440	+ List(HTML_Row(HTML_In_Form)) names,
	441	+ HowManyColumns hm_col,
	442	+ (RGB,Int,$Data) -> HTML_Row(HTML_In_Form) line_format,
	443	+ RGB a_color,
	444	+ RGB b_color,
	445	+ Total_Line($Data,$Upplet,HTML_Row(HTML_In_Form)) total_line
	446	+ ) =
	447	+ table([],
	448	+ if l is []
	449	+ then []
	450	+ else
	451	+ with nbl = length(l),
	452	+ [
	453	+ row([],
	454	+ if total_line is
	455	+ {
	456	+ no_total then
	457	+ with col_nb = if hm_col is
	458	+ {
	459	+ _1 then 1,
	460	+ several(n,_) then n
	461	+ },
	462	+ with spacer = if hm_col is
	463	+ {
	464	+ _1 then 0,
	465	+ several(n,sp) then sp
	466	+ },
	467	+ generic_cells
	468	+ (short_lists(l,nbl\col_nb + if (nbl (mod col_nb)) > 0 then 1 else 0,0),
	469	+ lto,names,line_format,a_color,b_color,
	470	+ (One u,$Data d) \|-> unique,(One _) \|-> row([],[]),unique,spacer),
	471	+ total(sum_fct,total_line,init) then
	472	+ with col_nb = if hm_col is
	473	+ {
	474	+ _1 then 1,
	475	+ several(n,_) then n
	476	+ },
	477	+ with spacer = if hm_col is
	478	+ {
	479	+ _1 then 0,
	480	+ several(n,sp) then sp
	481	+ },
	482	+ generic_cells
	483	+ (
	484	+ short_lists(l,nbl\col_nb + if (nbl (mod col_nb)) > 0 then 1 else 0,0),
	485	+ lto,names,line_format,a_color,b_color,
	486	+ sum_fct,total_line,init,spacer
	487	+ )
	488	+ })
	489	+ ]).
	490	+
	491	+
	492	+ - HTML_Off_Form -
	493	+ ----------------
	494	+
	495	+define List(HTML_Cell(HTML_Off_Form))
	496	+ generic_cells
	497	+ (
	498	+ List(List(Print_Table($Data))) print_data,
	499	+ List(Table_Option) lto,
	500	+ List(HTML_Row(HTML_Off_Form)) names,
	501	+ (RGB,Int,$Data) -> HTML_Row(HTML_Off_Form) line_format,
	502	+ RGB a_color,
	503	+ RGB b_color,
	504	+ ($Upplet,$Data) -> $Upplet do_sum,
	505	+ $Upplet -> HTML_Row(HTML_Off_Form) total_line,
	506	+ $Upplet value,
	507	+ Int spacer
	508	+ ) =
	509	+ if print_data is
	510	+ {
	511	+ [] then (List(HTML_Cell(HTML_Off_Form))) [],
	512	+ [h . t] then
	513	+ if generic_rows(h,line_format,a_color,b_color,do_sum,(List(HTML_Row(HTML_Off_Form)))[],value) is
	514	+ (rows,new_value) then
	515	+ if t is []
	516	+ then [cell([top],table(lto,(names+rows+[total_line(new_value)])))]
	517	+ else [
	518	+ cell([top],table(lto,append(names,rows)))
	519	+ . if spacer =0
	520	+ then generic_cells
	521	+ (t,lto,names,line_format,a_color,b_color,do_sum,total_line,new_value,spacer)
	522	+ else [cell([width(spacer)],text([],""))
	523	+ . generic_cells
	524	+ (t,lto,names,line_format,a_color,b_color,do_sum,total_line,new_value,spacer)]
	525	+ ]
	526	+ }.
	527	+
	528	+public define HTML_Off_Form
	529	+ generic_table
	530	+ (
	531	+ List($Data) l,
	532	+ List(Table_Option) lto,
	533	+ List(HTML_Row(HTML_Off_Form)) names,
	534	+ HowManyColumns hm_col,
	535	+ (RGB,Int,$Data) -> HTML_Row(HTML_Off_Form) line_format,
	536	+ RGB a_color,
	537	+ RGB b_color,
	538	+ Total_Line($Data,$Upplet,HTML_Row(HTML_Off_Form)) total_line
	539	+ ) =
	540	+ table([],
	541	+ with nbl = length(l),
	542	+ [
	543	+ row([],
	544	+ if total_line is
	545	+ {
	546	+ no_total then
	547	+ with col_nb = if hm_col is
	548	+ {
	549	+ _1 then 1,
	550	+ several(n,_) then n
	551	+ },
	552	+ with spacer = if hm_col is
	553	+ {
	554	+ _1 then 0,
	555	+ several(n,sp) then sp
	556	+ },
	557	+ generic_cells
	558	+ (
	559	+ short_lists(l,nbl\col_nb + if (nbl (mod col_nb)) > 0 then 1 else 0,0),
	560	+ lto,names,line_format,a_color,b_color,
	561	+ (One u,$Data d) \|-> unique,(One _) \|-> row([],[]),unique,spacer
	562	+ ),
	563	+ total(sum_fct,total_line,init) then
	564	+ with col_nb = if hm_col is
	565	+ {
	566	+ _1 then 1,
	567	+ several(n,_) then n
	568	+ },
	569	+ with spacer = if hm_col is
	570	+ {
	571	+ _1 then 0,
	572	+ several(n,sp) then sp
	573	+ },
	574	+ generic_cells
	575	+ (
	576	+ short_lists(l,nbl\col_nb + if (nbl (mod col_nb)) > 0 then 1 else 0,0),
	577	+ lto,names,line_format,a_color,b_color,
	578	+ sum_fct,total_line,init,spacer
	579	+ )
	580	+ })
	581	+ ]).
	582	+
	583	+
	584	+
	585	+ - Convenience functions :
	586	+
	587	+public define HTML_Off_Form
	588	+ generic_table
	589	+ (
	590	+ List($Data) data,
	591	+ List(Table_Option) lto,
	592	+ List(HTML_Row(HTML_Off_Form)) columns_name,
	593	+ (RGB,$Data) -> HTML_Row(HTML_Off_Form) line_format,
	594	+ RGB a_color,
	595	+ RGB b_color
	596	+ ) =
	597	+ generic_table
	598	+ (
	599	+ (List($Data)) data,
	600	+ (List(Table_Option)) lto,
	601	+ (List(HTML_Row(HTML_Off_Form))) columns_name,
	602	+ (HowManyColumns) _1,
	603	+ ((RGB,Int,$Data) -> HTML_Row(HTML_Off_Form)) (RGB r,Int n,$Data d) \|-> line_format(r,d),
	604	+ (RGB) a_color,
	605	+ (RGB) b_color,
	606	+ (Total_Line($Data,$Data,HTML_Row(HTML_Off_Form))) no_total
	607	+ ).
	608	+
	609	+public define HTML_In_Form
	610	+ generic_table
	611	+ (
	612	+ List($Data) data,
	613	+ List(Table_Option) lto,
	614	+ List(HTML_Row(HTML_In_Form)) columns_name,
	615	+ (RGB,$Data) -> HTML_Row(HTML_In_Form) line_format,
	616	+ RGB a_color,
	617	+ RGB b_color
	618	+ ) =
	619	+ generic_table
	620	+ (
	621	+ (List($Data)) data,
	622	+ (List(Table_Option)) lto,
	623	+ (List(HTML_Row(HTML_In_Form))) columns_name,
	624	+ (HowManyColumns) _1,
	625	+ ((RGB,Int,$Data) -> HTML_Row(HTML_In_Form)) (RGB r,Int n,$Data d) \|-> line_format(r,d),
	626	+ (RGB) a_color,
	627	+ (RGB) b_color,
	628	+ (Total_Line($Data,$Data,HTML_Row(HTML_In_Form))) no_total
	629	+ ).
	630	+
	631	+
	632	+ 2/ Table with total-line and without multicolumns, enumeration.
	633	+
	634	+
	635	+public define HTML_Off_Form
	636	+ generic_table
	637	+ (
	638	+ List($Data) data,
	639	+ List(Table_Option) lto,
	640	+ List(HTML_Row(HTML_Off_Form)) columns_name,
	641	+ (RGB,$Data) -> HTML_Row(HTML_Off_Form) line_format,
	642	+ RGB a_color,
	643	+ RGB b_color,
	644	+ Total_Line($Data,$Upplet,HTML_Row(HTML_Off_Form)) total_line
	645	+ ) =
	646	+ generic_table
	647	+ (
	648	+ (List($Data)) data,
	649	+ (List(Table_Option)) lto,
	650	+ (List(HTML_Row(HTML_Off_Form))) columns_name,
	651	+ (HowManyColumns) _1,
	652	+ ((RGB,Int,$Data) -> HTML_Row(HTML_Off_Form)) (RGB r,Int n,$Data d) \|-> line_format(r,d),
	653	+ (RGB) a_color,
	654	+ (RGB) b_color,
	655	+ (Total_Line($Data,$Upplet,(HTML_Row(HTML_Off_Form)))) total_line
	656	+ ).
	657	+
	658	+public define HTML_In_Form
	659	+ generic_table
	660	+ (
	661	+ List($Data) data,
	662	+ List(Table_Option) lto,
	663	+ List(HTML_Row(HTML_In_Form)) columns_name,
	664	+ (RGB,$Data) -> HTML_Row(HTML_In_Form) line_format,
	665	+ RGB a_color,
	666	+ RGB b_color,
	667	+ Total_Line($Data,$Upplet,HTML_Row(HTML_In_Form)) total_line
	668	+ ) =
	669	+ generic_table
	670	+ (
	671	+ (List($Data)) data,
	672	+ (List(Table_Option)) lto,
	673	+ (List(HTML_Row(HTML_In_Form))) columns_name,
	674	+ (HowManyColumns) _1,
	675	+ ((RGB,Int,$Data) -> HTML_Row(HTML_In_Form)) (RGB r,Int n,$Data d) \|-> line_format(r,d),
	676	+ (RGB) a_color,
	677	+ (RGB) b_color,
	678	+ (Total_Line($Data,$Upplet,(HTML_Row(HTML_In_Form)))) total_line
	679	+ ).
	680	+
	681	+
	682	+
	683	+
	684	+ 3/ Table with multicolumns, enumeration, but without total
	685	+
	686	+public define HTML_Off_Form
	687	+ generic_table
	688	+ (
	689	+ List($Data) data,
	690	+ List(Table_Option) lto,
	691	+ List(HTML_Row(HTML_Off_Form)) columns_name,
	692	+ HowManyColumns number_of_columns,
	693	+ (RGB,Int,$Data) -> HTML_Row(HTML_Off_Form) line_format,
	694	+ RGB a_color,
	695	+ RGB b_color
	696	+ ) =
	697	+ generic_table
	698	+ (
	699	+ (List($Data)) data,
	700	+ (List(Table_Option)) lto,
	701	+ (List(HTML_Row(HTML_Off_Form))) columns_name,
	702	+ (HowManyColumns) number_of_columns,
	703	+ ((RGB,Int,$Data) -> HTML_Row(HTML_Off_Form)) (RGB r,Int n,$Data d) \|-> line_format(r,n,d),
	704	+ (RGB) a_color,
	705	+ (RGB) b_color,
	706	+ (Total_Line($Data,$Data,(HTML_Row(HTML_Off_Form)))) no_total
	707	+ ).
	708	+
	709	+
	710	+public define HTML_In_Form
	711	+ generic_table
	712	+ (
	713	+ List($Data) data,
	714	+ List(Table_Option) lto,
	715	+ List(HTML_Row(HTML_In_Form)) columns_name,
	716	+ HowManyColumns number_of_columns,
	717	+ (RGB,Int,$Data) -> HTML_Row(HTML_In_Form) line_format,
	718	+ RGB a_color,
	719	+ RGB b_color
	720	+ ) =
	721	+ generic_table
	722	+ (
	723	+ (List($Data)) data,
	724	+ (List(Table_Option)) lto,
	725	+ (List(HTML_Row(HTML_In_Form))) columns_name,
	726	+ (HowManyColumns) number_of_columns,
	727	+ ((RGB,Int,$Data) -> HTML_Row(HTML_In_Form)) (RGB r,Int n,$Data d) \|-> line_format(r,n,d),
	728	+ (RGB) a_color,
	729	+ (RGB) b_color,
	730	+ (Total_Line($Data,$Data,(HTML_Row(HTML_In_Form)))) no_total
	731	+ ).
	732	+
	733	+
	734	+
	735	+ 4/ Table with multicolumns and without enumeration & total
	736	+
	737	+public define HTML_Off_Form
	738	+ generic_table
	739	+ (
	740	+ List($Data) data,
	741	+ List(Table_Option) lto,
	742	+ List(HTML_Row(HTML_Off_Form)) columns_name,
	743	+ HowManyColumns number_of_columns,
	744	+ (RGB,$Data) -> HTML_Row(HTML_Off_Form) line_format,
	745	+ RGB a_color,
	746	+ RGB b_color
	747	+ ) =
	748	+ generic_table
	749	+ (
	750	+ (List($Data)) data,
	751	+ (List(Table_Option)) lto,
	752	+ (List(HTML_Row(HTML_Off_Form))) columns_name,
	753	+ (HowManyColumns) number_of_columns,
	754	+ ((RGB,Int,$Data) -> HTML_Row(HTML_Off_Form)) (RGB r,Int n,$Data d) \|-> line_format(r,d),
	755	+ (RGB) a_color,
	756	+ (RGB) b_color,
	757	+ (Total_Line($Data,$Data,(HTML_Row(HTML_Off_Form)))) no_total
	758	+ ).
	759	+
	760	+
	761	+public define HTML_In_Form
	762	+ generic_table
	763	+ (
	764	+ List($Data) data,
	765	+ List(Table_Option) lto,
	766	+ List(HTML_Row(HTML_In_Form)) columns_name,
	767	+ HowManyColumns number_of_columns,
	768	+ (RGB,$Data) -> HTML_Row(HTML_In_Form) line_format,
	769	+ RGB a_color,
	770	+ RGB b_color
	771	+ ) =
	772	+ generic_table
	773	+ (
	774	+ (List($Data)) data,
	775	+ (List(Table_Option)) lto,
	776	+ (List(HTML_Row(HTML_In_Form))) columns_name,
	777	+ (HowManyColumns) number_of_columns,
	778	+ ((RGB,Int,$Data) -> HTML_Row(HTML_In_Form)) (RGB r,Int n,$Data d) \|-> line_format(r,d),
	779	+ (RGB) a_color,
	780	+ (RGB) b_color,
	781	+ (Total_Line($Data,$Data,(HTML_Row(HTML_In_Form)))) no_total
	782	+ ).
	783	+
	784	+
	785	+
	786	+
...	...

MF_1_1/web/CXM_html.anubis 0 → 100644

Wrap text Show/Hide comments View file @9ca943b

	1	+
	2	+ Project The Anubis Project
	3	+ Title Producing HTML/Javascript code.
	4	+
	5	+ Copyright Copyright (c) Alain Prouté 2001.
	6	+
	7	+read tools/basis.anubis
	8	+read system/string.anubis
	9	+
	10	+
	11	+
	12	+ *** Managing Web Arguments.
	13	+
	14	+ When a client submits a form, he sends informations to the server. This information is
	15	+ transformed by the server into a list of data of type 'Web_arg'. This is the reason why
	16	+ a 'web page' operation always has a unique argument of type 'List(Web_arg)'.
	17	+
	18	+ The type 'Web_arg' is defined in 'web/common.anubis' as follows:
	19	+
	20	+ public type Web_arg:
	21	+ web_arg(String name,
	22	+ String value),
	23	+ upload (String name,
	24	+ String value,
	25	+ String temp_file_path).
	26	+
	27	+read CXM_common.anubis
	28	+
	29	+ In other words, a 'web argument' is just a pair made of the name of the argument, and
	30	+ the value of the argument, and both are character strings. 'upload' will be explained
	31	+ later.
	32	+
	33	+
	34	+ The next variable is a multipurpose counter (used to generate unique names).
	35	+
	36	+variable Int web_count = 0.
	37	+
	38	+define Int
	39	+ new_web_count
	40	+ =
	41	+ web_count <- *web_count+1;
	42	+ *web_count.
	43	+
	44	+
	45	+ Names for Web colors.
	46	+
	47	+public type Web_color_name:
	48	+ aliceblue,
	49	+ antiquewhite1,
	50	+ antiquewhite2,
	51	+ antiquewhite3,
	52	+ antiquewhite4,
	53	+ aquamarine1,
	54	+ aquamarine2,
	55	+ aquamarine3,
	56	+ aquamarine4,
	57	+ azure1,
	58	+ azure2,
	59	+ azure3,
	60	+ azure4,
	61	+ yellow.
	62	+
	63	+
	64	+ and so on ... (see below why I did not do more).
	65	+
	66	+
	67	+
	68	+ Web colors.
	69	+
	70	+public type Web_color:
	71	+ rgb(Word8,Word8,Word8), /* give the color by its components */
	72	+ _(Web_color_name). /* or by its name */
	73	+
	74	+
	75	+
	76	+
	77	+ The following produces '<meta>' tags, which are put in the head of the document.
	78	+
	79	+public type WebMeta:
	80	+ keywords(List(String)),
	81	+ refresh(String url, Int delay), // in seconds
	82	+ meta(String name, String content),
	83	+ http_equiv(String name, String content).
	84	+
	85	+
	86	+
	87	+
	88	+
	89	+ *******************************************************
	90	+ * Web items *
	91	+ * (the many kinds of things one may put in a page) *
	92	+ *******************************************************
	93	+
	94	+
	95	+public type Web_item:
	96	+ [ ], /* empty (invisible) item */
	97	+ ... this is a cross recursive type.
	98	+
	99	+
	100	+
	101	+
	102	+ Options for web page body.
	103	+
	104	+public type LayerDisposition:
	105	+ horizontal,
	106	+ vertical.
	107	+
	108	+public type FollowPathCommand: // this type is used by the Web_body_option 'follow_path'.
	109	+ pos(Int x, // x coordinate of position
	110	+ Int y, // y coordinate of position
	111	+ Int image_number, // the image to display at that position
	112	+ Int delay). // wait that milliseconds before leaving this position
	113	+
	114	+public type Web_body_option:
	115	+ background_color(Web_color), /* color for the background */
	116	+ //
	117	+ // 'psychedelic_background' produces a background color which is continuously changing.
	118	+ // 'average' is the average luminosity of the color. 'amplitude' is the maximal variation
	119	+ // the luminosity around the average. 'delay' is the number of milliseconds between two
	120	+ // color changes. For example, you may try 'psychedelic_background(200,50,1000)', which
	121	+ // produces a background whose color changes very slowly (this is not tiring) among rather
	122	+ // light pastel colors.
	123	+ //
	124	+ psychedelic_background(Int average, /* average light (0 to 255) */
	125	+ Int amplitude, /* amplitude of variation of light */
	126	+ Int delay), /* in milliseconds */
	127	+ background_image(String file_name), /* name of image file for the background */
	128	+ //
	129	+ // 'scrolling_layer' produces a layer above the page which is scrolling continuously either
	130	+ // vertically or horizontally. The 'content' is indefinitly repeated.
	131	+ //
	132	+ scrolling_layer(LayerDisposition,
	133	+ Int steps, /* number of pixels of each move */
	134	+ Int margin, /* measured from left or top in pixels */
	135	+ Int delay, /* milliseconds for one move */
	136	+ Web_item content, /* content of layer (will be repeated) */
	137	+ Int period), /* number of pixels between two instances of 'content' */
	138	+ //
	139	+ // 'bounce' shows its content above the page and let it move and bounce on the edges of a rectangle.
	140	+ // The rectangle is determined by the last 4 arguments.
	141	+ //
	142	+ bounce(Web_item content,
	143	+ Int left,
	144	+ Int right,
	145	+ Int top,
	146	+ Int bottom),
	147	+ //
	148	+ // put something over the page in any position you want:
	149	+ //
	150	+ over(Web_item content,
	151	+ Int left,
	152	+ Int top),
	153	+ //
	154	+ // follow_path: let a changing image follow a path on the screen. This gadget shows
	155	+ // an image following a polygonal path on the screen. The image may change at regular
	156	+ // intervals, thus providing extra animation. The images are displayed in the order
	157	+ // they are given in the first argument. When the last image has been displayed, the
	158	+ // first image is displayed again, and so on. The path is a sequence of absolute positions
	159	+ // on screen (actually in the browser's window or frame), which is followed in the
	160	+ // order given in the 'path' argument. If 'loop' is true, the path is followed again and again.
	161	+ // Otherwise, it is followed only once. If you want to make a closed loop, the last
	162	+ // position must be the same as the first one. 'steps' is the number of pixels of distance
	163	+ // between two successive positions of the image, and 'delay' the number of milliseconds
	164	+ // between two successive positions. 'change_every' is the number of steps (a 'step' is
	165	+ // passing from one position to the next one) after which the displayed image is replaced
	166	+ // by the next image.
	167	+ //
	168	+ // Each position 'pos(x,y,i,d)' has 4 parameters. 'x' and 'y' are the coordinates of the
	169	+ // position in the browser's window or frame. 'i' is the number of the image to display
	170	+ // at this position (i.e. the rank of the image in the list 'filename'. The first one has
	171	+ // rank 0). 'd' is the delay in milliseconds to wait before leaving that position.
	172	+ //
	173	+ follow_path(List(String) filenames, /* the changing images which follows the path */
	174	+ Int change_every, /* number of steps betwen two changes */
	175	+ List(FollowPathCommand) path, /* the polygonal path and commands */
	176	+ Bool loop, /* if true do it repeatedly, otherwise only once */
	177	+ Int steps, /* approximative distance (in pixels) between two
	178	+ successive positions */
	179	+ Int delay), /* milliseconds between two successive positions */
	180	+
	181	+ load_image(String name), /* load an image (for next page), which is not displayed */
	182	+ left_margin(Int), /* left margin for document */
	183	+ top_margin(Int), /* top margin for document */
	184	+ margin_width(Int),
	185	+ margin_height(Int),
	186	+ reload_frame(String name, /* name of target frame */
	187	+ String url), /* url to load in this frame */
	188	+ onload(String function_name). /* nom de la fonction javascript (sans les '()') */
	189	+
	190	+public type BodyOnload:
	191	+ reload_frame(String name, String url).
	192	+
	193	+variable List(BodyOnload) body_onloads = [ ].
	194	+
	195	+define One
	196	+ add_body_onload
	197	+ (
	198	+ BodyOnload item
	199	+ ) =
	200	+ body_onloads <- [item . *body_onloads].
	201	+
	202	+define Printable_tree
	203	+ format
	204	+ (
	205	+ BodyOnload item
	206	+ ) =
	207	+ if item is
	208	+ {
	209	+ reload_frame(name,url) then (Printable_tree)
	210	+ [ " window.open('",url,"','",name,"');" ]
	211	+ }.
	212	+
	213	+define Printable_tree
	214	+ format
	215	+ (
	216	+ List(BodyOnload) l
	217	+ ) =
	218	+ if l is
	219	+ {
	220	+ [ ] then (Printable_tree)[ ],
	221	+ [h . t] then (Printable_tree)
	222	+ [format(h) . format(t)]
	223	+ }.
	224	+
	225	+
	226	+---- Body of a web page. --------------------------------------------
	227	+public type Page_body:
	228	+ body(List(Web_body_option), /* list of body options */
	229	+ Web_item content). /* the content of the page */
	230	+
	231	+
	232	+public type VFrame:
	233	+ frame(Int height,
	234	+ Printable_tree url,
	235	+ String name).
	236	+
	237	+---- Web pages. -----------------------------------------------------
	238	+public type Web_page:
	239	+ web_page(String title, /* title appearing on top of browser */
	240	+ List(WebMeta) meta_tags,
	241	+ Printable_tree head_scripts, /* scripts à placer dans la balise head */
	242	+ Page_body body), /* body of page */
	243	+ standard_frameset(String title,
	244	+ List(WebMeta) meta_tags,
	245	+ Int height, /* height of 'top menu' (pixels) */
	246	+ Int width, /* width of 'left menu' (pixels) */
	247	+ Printable_tree main). /* url for main */
	248	+
	249	+ +---------+--------------------------+
	250	+ \| \| ^ \|
	251	+ \|<-width->\| top height \|
	252	+ \| \| v \|
	253	+ \| left +--------------------------+
	254	+ \| \| \|
	255	+ \| \| main \|
	256	+ \| \| \|
	257	+ \| \| \|
	258	+ \| \| \|
	259	+ +---------+--------------------------+
	260	+
	261	+ Note: top and left frames must be loaded through the Web_body_option 'reload_frame'.
	262	+
	263	+
	264	+public define Web_page
	265	+ web_page
	266	+ (
	267	+ String title,
	268	+ Page_body body
	269	+ ) =
	270	+ web_page(title,[],[], body).
	271	+
	272	+public define Web_page
	273	+ web_page
	274	+ (
	275	+ String title,
	276	+ List(WebMeta) meta_tags,
	277	+ Page_body body
	278	+ ) =
	279	+
	280	+ web_page(title, meta_tags, [], body).
	281	+
	282	+ public define Web_page
	283	+web_page
	284	+ (
	285	+ String title,
	286	+ Printable_tree head_scripts,
	287	+ Page_body body
	288	+ ) =
	289	+
	290	+ web_page(title, [], head_scripts, body).
	291	+
	292	+public define Web_page
	293	+standard_frameset
	294	+ (
	295	+ String title,
	296	+ Int height,
	297	+ Int width,
	298	+ Printable_tree main
	299	+ ) =
	300	+
	301	+ standard_frameset(title, [], height, width, main).
	302	+
	303	+
	304	+variable Printable_tree scripts = [].
	305	+
	306	+define One
	307	+ add_script
	308	+ (
	309	+ Printable_tree script
	310	+ ) =
	311	+ scripts <- [*scripts . script].
	312	+
	313	+
	314	+
	315	+ ---- Non empty web items. -------------------------------------------
	316	+
	317	+ We have already seen the empty web item. Together with the following one, it enables to
	318	+ make (pseudo-)lists of web items, which will be presented one after the other (from
	319	+ left to right) in the browser's window.
	320	+
	321	+public type Web_item:
	322	+ [Web_item . Web_item],...
	323	+
	324	+
	325	+ A web item may be a simple string or a simple integer:
	326	+
	327	+public type Web_item:
	328	+ text(String),
	329	+ text_pt(Printable_tree),
	330	+ text_nowrap(String),
	331	+ text_nowrap_pt(Printable_tree),
	332	+ par(String),
	333	+ preformated_text(String text),
	334	+ integer(Int),
	335	+ float(Float,Int),...
	336	+
	337	+
	338	+ You may want to center a web item in a page. Just enclose it into
	339	+ 'center(...)':
	340	+
	341	+public type Web_item:
	342	+ center(Web_item),...
	343	+
	344	+
	345	+ You may want to write characters of a given item with a big font:
	346	+
	347	+public type Web_item:
	348	+ bigger(Int,Web_item),
	349	+ smaller(Int,Web_item),
	350	+ bold(Web_item),
	351	+ italic(Web_item),
	352	+ big(Web_item),
	353	+ very_big(Web_item),...
	354	+
	355	+
	356	+ Most of the previous are subsumed by 'style':
	357	+
	358	+public type WebStyle:
	359	+ background_image(String file_name),
	360	+ background_color(Web_color color),
	361	+ background_transparent,
	362	+ background_repeat_horizontal, // repeat the background image only horizontally
	363	+ background_repeat_vertical,
	364	+ background_no_repeat,
	365	+ color(Web_color color),
	366	+ float_to_left, // the web item will float to the left and text will wrap around
	367	+ float_to_right,
	368	+ font_family(String font_name), // "verdana" "helvetica" "times" etc...
	369	+ font_size(Int size),
	370	+ italic,
	371	+ oblique,
	372	+ small_capitals,
	373	+ bold,
	374	+ bolder,
	375	+ lighter,
	376	+ line_height(Int height),
	377	+ text_center,
	378	+ text_left,
	379	+ text_right,
	380	+ text_justify,
	381	+ text_underline,
	382	+ text_blink,
	383	+ text_line_through,
	384	+ width(Int n).
	385	+
	386	+
	387	+
	388	+public type Web_item:
	389	+ style(List(WebStyle) styles, Web_item content),...
	390	+
	391	+
	392	+public type Web_item:
	393	+ spacer(Int width, Int height),
	394	+ image(String file_name), /* image */
	395	+ image_d(String file_name, String description),
	396	+ image_pt(Printable_tree file_name),
	397	+ on_image(String file_name, Web_item content),
	398	+ turning_images(NonEmptyList(String) filenames, Int millisecs),...
	399	+
	400	+
	401	+
	402	+ A 'rollover' has the same role as a submit button or link, but it is prettier. It is
	403	+ made of two images. The first one 'image_on' determines the aspect of the button when
	404	+ the mouse cursor is on it. The other one 'image_off' determines the aspect of the
	405	+ button when the mouse cursor is anywhere else. The two images should be of the same
	406	+ size, otherwise bad effects may occur. The last operand 'description' is a small text
	407	+ which describes the role of the button. It appears in a bubble in the browser's window.
	408	+
	409	+public type Web_item:
	410	+ rollover(List(String) preload_images, // images to preload before the rollover is effective
	411	+ String url, // URL with possible web arguments
	412	+ String target,
	413	+ String image_on, // file name of 'highlighted' image
	414	+ String image_off, // file name of 'non highlighted' image
	415	+ String description), // short behavior description
	416	+ rollover(List(String) preload_images,
	417	+ String url,
	418	+ String target,
	419	+ String image_on,
	420	+ String image_off,
	421	+ Int width,
	422	+ Int height,
	423	+ String description), ...
	424	+
	425	+
	426	+ Mouse sensitive images are images with predefined zones which are clickable. When
	427	+ clicking in a zone, the specified corresponding URL is loaded by the browser. If two
	428	+ zones overlap, the first one (in the order they are defined) is selected.
	429	+
	430	+ Zones are of 3 sorts: rectangles, circles and polygons. Point's coordinates are
	431	+ specified as pairs of integers (of anonymous agglomeration type (Int,Int)). The
	432	+ first coordinate counts pixels from the left of the image. The second coordinate counts
	433	+ pixels from the top of the image. With polygons, you can construct zones which are
	434	+ almost as complicated as you want. You may also construct a zone as the overlapping of
	435	+ several zones with the same URL.
	436	+
	437	+public type Mouse_Sensitive_Zone:
	438	+ rectangle
	439	+ (
	440	+ (Int,Int) left_top,
	441	+ (Int,Int) right_bottom,
	442	+ String url
	443	+ ),
	444	+ circle
	445	+ (
	446	+ (Int,Int) center,
	447	+ Int radius,
	448	+ String url
	449	+ ),
	450	+ polygon
	451	+ (
	452	+ List((Int,Int)) vertices,
	453	+ String url
	454	+ ).
	455	+
	456	+public type Web_item:
	457	+ mouse_sensitive_image(String image_file_name, // the image itself
	458	+ List(Mouse_Sensitive_Zone) zones),...
	459	+
	460	+
	461	+ In project: mouse sensitive images, whose zones behave like submission buttons (to be
	462	+ used within a form).
	463	+
	464	+
	465	+public type Web_item:
	466	+ background_sound(String sound_file_name,
	467	+ Bool loop),...
	468	+
	469	+
	470	+
	471	+ *************************
	472	+ * FORMS *
	473	+ *************************
	474	+
	475	+
	476	+ Use 'forms' in order to get informations back from the client. The constructor 'form'
	477	+ take 2 arguments:
	478	+
	479	+ - the name of the form, which must be the name of an Anubis web
	480	+ page. Indeed, when the user will submit the form, this page will
	481	+ be sent to him.
	482	+ - the content of the form, which may be any web item, but which
	483	+ normally (amongh other things) contains input fields and a
	484	+ submit button.
	485	+
	486	+public type Web_item:
	487	+ form(Printable_tree name,
	488	+ Web_item content),
	489	+ form_target(Printable_tree name,
	490	+ Web_item content,
	491	+ String target),
	492	+ form(Printable_tree name,
	493	+ String label_name,
	494	+ Web_item content),
	495	+ form_name(String form_name, // option name de form
	496	+ Web_item content),...
	497	+
	498	+ public define Web_item
	499	+form
	500	+ (
	501	+ Printable_tree name,
	502	+ Web_item content
	503	+ ) =
	504	+
	505	+ form("", name, content).
	506	+
	507	+ Within a form, you may put 'text input fields', that the client may
	508	+ edit. The constructor 'text_input' has the following arguments:
	509	+
	510	+ - name of input field. This will be the name of the correponding
	511	+ web argument in the Anubis web page referred to by the form.
	512	+ - size of field (as it appears on client screen),
	513	+ - initial value of field (the text that appears in the field, when
	514	+ the client downloads the page).
	515	+
	516	+
	517	+ public type Text_Input_Option
	518	+
	519	+public type Web_item:
	520	+ text_input(String name, /* text field to be documented by user */
	521	+ Int size,
	522	+ String initial_value),...
	523	+
	524	+ public define Web_item
	525	+ text_input
	526	+ (
	527	+ String name,
	528	+ Int size,
	529	+ String initial_value
	530	+ ) =
	531	+
	532	+
	533	+ text_input( (List(Text_Input_Option)) [], name, size, initial_value).
	534	+
	535	+
	536	+public type Web_item:
	537	+ password_input(String name,
	538	+ Int size),
	539	+ text_area(String name,
	540	+ Int columns,
	541	+ Int rows,
	542	+ String initial_text),
	543	+ upload(String name, Int size),...
	544	+
	545	+
	546	+
	547	+
	548	+public type Web_item:
	549	+ submit(String button_text), /* submit button with text on it */
	550	+ submit_pt(Printable_tree button_text),
	551	+ submit(String name, String text),
	552	+ submit_close(String name, String text),
	553	+ submit_pt2(String name, Printable_tree text),
	554	+ image_submit(String name, String image_file_name),
	555	+ image_submit(String name, String value, String image_file, Web_item content),
	556	+ hl_image_submit(String action_name,
	557	+ String value,
	558	+ String image_name,
	559	+ String image_file,
	560	+ String hl_image_file),
	561	+ text_submit(String name, String value, String text),
	562	+ web_submit(String web_args, Web_item content),
	563	+ button(String name, String text, String on_click_fonction, Int width, Int height),...
	564	+
	565	+
	566	+public type Web_item: /* mark the form with an information */
	567	+ mark(String name, String value),
	568	+ mark_pt(String name, Printable_tree value),...
	569	+
	570	+public type Web_item:
	571	+ close_button, /* button that closes the window */
	572	+ close_button(String image_file_name), ...
	573	+
	574	+
	575	+
	576	+ *********************************
	577	+ * LABELS *
	578	+ *********************************
	579	+
	580	+
	581	+ A 'label' is just a name that you may give to a position in a document. Use the
	582	+ following invisible Web_item 'label' to this end. Now, you can also create links in
	583	+ the same document, which, when clicked by the user, scroll the document, so that the
	584	+ position whose name is the given label is shown just at the top of the browser's
	585	+ window.
	586	+
	587	+public type Web_item:
	588	+ label(String label_name), /* give a name to a position in the page */
	589	+ go_to_label(String label_name, /* a link for jumping to a label */
	590	+ Web_item content),...
	591	+
	592	+
	593	+
	594	+ ********************************
	595	+ * TABLES *
	596	+ ********************************
	597	+
	598	+
	599	+ A web item may be a table. A table is produced by the constructor
	600	+ 'table' from the type 'Web_item'. This constructor takes 2
	601	+ arguments:
	602	+
	603	+ - a list of 'table options',
	604	+ - a list of 'table rows'.
	605	+
	606	+ Of course, you use as many options as you want, including
	607	+ none (if you do not want any option, put the empty list '[ ]' as
	608	+ this argument). Some options have precedence over others. For example
	609	+ a background image will hide the background color.
	610	+
	611	+ Table options are defined below:
	612	+
	613	+public type Table_option:
	614	+
	615	+ /* use a color as a background for the table, if you want it to
	616	+ be different from the background of the page */
	617	+ background_color(Web_color),
	618	+
	619	+ /* or use an image as the background of the table */
	620	+ background_image(String file_name),
	621	+
	622	+ /* draw a border line around the table (and around each cell in
	623	+ the table). You may also specify a geometry (in pixels) for the
	624	+ border. This makes the 'in relief' part of the border appear
	625	+ more or less wide. You may also specify a color for the border. */
	626	+ border,
	627	+ nude, /* equivalent to 'border(0,0,0)' (below) */
	628	+ border(Int, /* width of exterior (pixels) */
	629	+ Int, /* width of top */
	630	+ Int), /* width of interior */
	631	+ border_color(Web_color),
	632	+ absolute_width(Int).
	633	+
	634	+
	635	+
	636	+ A 'table row' is made of a list of 'row options', and a list of
	637	+ 'cells'. A 'cell' itself has a list of 'cell options', and a web item,
	638	+ which is its content. We begin by the description of options.
	639	+
	640	+
	641	+public type Row_option:
	642	+ /* following concerns the horizontal positions of items within the
	643	+ cells of the row */
	644	+ left,
	645	+ h_center,
	646	+ right,
	647	+ /* the following concerns the vertical positions of items, within
	648	+ the cells of the row */
	649	+ top,
	650	+ v_center,
	651	+ bottom,
	652	+ absolute_height(Int),
	653	+ base_line,
	654	+ /* set the background color of all cells in the row */
	655	+ background_color(Web_color).
	656	+
	657	+
	658	+
	659	+public type Cell_option:
	660	+ /* all row options are available for individual cells, and apply
	661	+ here only to one cell. */
	662	+ left,
	663	+ h_center,
	664	+ right,
	665	+ top,
	666	+ v_center,
	667	+ bottom,
	668	+ base_line,
	669	+ background_color(Web_color),
	670	+ /* you can set the width of the cell either absolutely (in pixels)
	671	+ or as a percentage of the width of the table. */
	672	+ background_image(String file_name),
	673	+ absolute_width(Int),
	674	+ relative_width(Int),
	675	+ absolute_height(Int),
	676	+ relative_height(Int),
	677	+ /* a cell may span over several columns or rows in the table */
	678	+ columns(Int),
	679	+ rows(Int),
	680	+ nowrap.
	681	+
	682	+
	683	+public type Cell:
	684	+ cell(List(Cell_option),
	685	+ Web_item).
	686	+
	687	+public type Table_row:
	688	+ row(List(Row_option),
	689	+ List(Cell)).
	690	+
	691	+public define Table_row row(Web_item i) = row([],[cell([],i)]).
	692	+public define Table_row row(Cell c) = row([],[c]).
	693	+public define Table_row row(List(Cell) l) = row([],l).
	694	+
	695	+
	696	+public type Web_item:
	697	+ table(List(Table_option),
	698	+ List(Table_row)),...
	699	+
	700	+public type Web_item:
	701	+ list(List(Web_item)),...
	702	+
	703	+public type Web_item:
	704	+ link(String name, Web_item),
	705	+ link(String name, String target, Web_item),...
	706	+
	707	+public type Web_item:
	708	+ link_for_download(String filename, Web_item),... // the filename is relative to the public directory
	709	+
	710	+public type Web_item:
	711	+ mail_to(String addr, Web_item),...
	712	+
	713	+
	714	+public type Web_item:
	715	+ select(String name,
	716	+ Int size,
	717	+ List(String) choices),
	718	+ select(String name,
	719	+ Int size,
	720	+ List(String) choices,
	721	+ String selected),
	722	+ immediate_select(String name, // selection will immediately submit the form
	723	+ Int size,
	724	+ List(String) choices),...
	725	+
	726	+
	727	+public type Web_item:
	728	+ radio_button (Printable_tree name, String value),
	729	+ checked_radio_button (Printable_tree name, String value),
	730	+ check_box (Printable_tree name, String value),
	731	+ checked_box (Printable_tree name, String value),...
	732	+
	733	+
	734	+public type Web_item:
	735	+ link_to_window(Printable_tree name, Web_item),
	736	+ link_to_window(Printable_tree name, String window_name, Web_item),
	737	+ link_to_window_with_ticket(String name,
	738	+ String web_args,
	739	+ String window_name,
	740	+ Web_item content,
	741	+ Int width,
	742	+ Int height),
	743	+ link_to_window_with_ticket_and_scroll
	744	+ (String name,
	745	+ String web_args,
	746	+ String window_name,
	747	+ Web_item content,
	748	+ Int width,
	749	+ Int height),
	750	+ link_to_window_with_ticket_and_scroll
	751	+ (String name,
	752	+ String label_name,
	753	+ String web_args,
	754	+ String window_name,
	755	+ Web_item content,
	756	+ Int width,
	757	+ Int height),
	758	+ link_to_frame (Printable_tree name, String frame_name, Web_item).
	759	+
	760	+
	761	+
	762	+---- Formating operations (Anubis --> HTML/Javascript) ---------------------------
	763	+
	764	+ Stupid operation formating a web color name.
	765	+
	766	+public define String
	767	+ format
	768	+ (
	769	+ Web_color_name n
	770	+ ) =
	771	+ if n is
	772	+ {
	773	+ aliceblue then "aliceblue",
	774	+ antiquewhite1 then "antiquewhite1",
	775	+ antiquewhite2 then "antiquewhite2",
	776	+ antiquewhite3 then "antiquewhite3",
	777	+ antiquewhite4 then "antiquewhite4",
	778	+ aquamarine1 then "aquamarine1",
	779	+ aquamarine2 then "aquamarine2",
	780	+ aquamarine3 then "aquamarine3",
	781	+ aquamarine4 then "aquamarine4",
	782	+ azure1 then "azure1",
	783	+ azure2 then "azure2",
	784	+ azure3 then "azure3",
	785	+ azure4 then "azure4",
	786	+ yellow then "yellow",
	787	+ }.
	788	+
	789	+ Anubis really needs some system of 'macros' to avoid this...
	790	+
	791	+
	792	+ Formating a web color.
	793	+
	794	+public define String
	795	+ format
	796	+ (
	797	+ Web_color wc
	798	+ ) =
	799	+ if wc is
	800	+ {
	801	+ rgb(r,g,b) then "\"#" + to_hexa(r) + to_hexa(g) + to_hexa(b) + "\"",
	802	+ _(c) then format(c)
	803	+ }.
	804	+
	805	+public define String
	806	+ format_without_quotes
	807	+ (
	808	+ Web_color wc
	809	+ ) =
	810	+ if wc is
	811	+ {
	812	+ rgb(r,g,b) then "#" + to_hexa(r) + to_hexa(g) + to_hexa(b) + "",
	813	+ _(c) then format(c)
	814	+ }.
	815	+
	816	+define Printable_tree
	817	+ format
	818	+ (
	819	+ Web_color c
	820	+ ) = [(String)format(c)].
	821	+
	822	+public define String
	823	+ format_without_sharp
	824	+ (
	825	+ Web_color wc
	826	+ ) =
	827	+ if wc is
	828	+ {
	829	+ rgb(r,g,b) then "" + to_hexa(r) + to_hexa(g) + to_hexa(b) + "",
	830	+ _(c) then format(c)
	831	+ }.
	832	+
	833	+define Printable_tree
	834	+ format_without_sharp
	835	+ (
	836	+ Web_color c
	837	+ ) = [(String)format_without_sharp(c)].
	838	+
	839	+
	840	+define Printable_tree
	841	+ [Word32 x . Printable_tree t]
	842	+ =
	843	+ [to_Int(x) . t].
	844	+
	845	+define Printable_tree
	846	+ psychedelic_bg
	847	+ (
	848	+ Int average,
	849	+ Int amplitude,
	850	+ Int delay
	851	+ ) =
	852	+ with ampl = if amplitude >= 120 then 120 else
	853	+ if amplitude =< 1 then 1 else amplitude,
	854	+ with aver = if average+ampl >= 254 then 254-ampl
	855	+ else if average-ampl =< 1 then 1+ampl else average,
	856	+ [ "<script>",
	857	+ " var psy_t = 0;",
	858	+ " function do_psy_bg() { psy_t += 0.05;",
	859	+ " document.bgColor = '#' + ",
	860	+ " (Math.round(",aver,"+",ampl,"*Math.cos(psy_t))).toString(16) + ",
	861	+ " (Math.round(",aver,"+",ampl,"*Math.sin(psy_t))).toString(16) + ",
	862	+ " (Math.round(",aver,"-",ampl,"Math.cos(2psy_t))).toString(16); ",
	863	+ " setTimeout(\"do_psy_bg()\",",delay,"); }",
	864	+ " setTimeout(\"do_psy_bg()\",1000);",
	865	+ "</script>"].
	866	+
	867	+
	868	+define List(Web_body_option)
	869	+ replace_background_init
	870	+ (
	871	+ List(Web_body_option) l,
	872	+ Int average,
	873	+ Int amplitude,
	874	+ Int delay
	875	+ ) =
	876	+ if l is
	877	+ {
	878	+ [ ] then [ ],
	879	+ [h . t] then
	880	+ if h is background_color(_)
	881	+ then [background_color(rgb(truncate_to_Word8(average+amplitude),
	882	+ truncate_to_Word8(average),
	883	+ truncate_to_Word8(average-amplitude)))
	884	+ . replace_background_init(t,average,amplitude,delay)]
	885	+ else [h . replace_background_init(t,average,amplitude,delay)]
	886	+ }.
	887	+
	888	+define Maybe((Int,Int,Int))
	889	+ get_psy
	890	+ (
	891	+ List(Web_body_option) l
	892	+ ) =
	893	+ if l is
	894	+ {
	895	+ [ ] then failure,
	896	+ [h . t] then
	897	+ if h is psychedelic_background(a,f,d)
	898	+ then success((a,f,d))
	899	+ else get_psy(t)
	900	+ }.
	901	+
	902	+define List(Web_body_option)
	903	+ prepare
	904	+ (
	905	+ List(Web_body_option) l
	906	+ ) =
	907	+ if get_psy(l) is
	908	+ {
	909	+ failure then l,
	910	+ success(op) then if op is (a,f,d) then
	911	+ replace_background_init(l,a,f,d)
	912	+ }.
	913	+
	914	+
	915	+public define Printable_tree
	916	+ format
	917	+ (
	918	+ String c_ticket,
	919	+ String s_ticket,
	920	+ Web_item i
	921	+ ).
	922	+
	923	+define Printable_tree
	924	+ move_layer_command
	925	+ (
	926	+ String property,
	927	+ Int n,
	928	+ Int num,
	929	+ Int i,
	930	+ Int period
	931	+ ) =
	932	+ if i >= num then [ ] else
	933	+ [" if (document.layers)",
	934	+ " { document.nslay",n,"_",i,".",property,"=layp",n,"+(",((i-1)),"); } ",
	935	+ " else ",
	936	+ " { ielay",n,"_",i,".style.",property,"=layp",n,"+(",(i-1)*period,"); } "
	937	+ . move_layer_command(property,n,num,i+1,period)].
	938	+
	939	+define Printable_tree
	940	+ format_layers
	941	+ (
	942	+ LayerDisposition disp,
	943	+ Int margin,
	944	+ Web_item content,
	945	+ Int n,
	946	+ Int num,
	947	+ Int i,
	948	+ Int period
	949	+ ) =
	950	+ if i >= num then [ ] else
	951	+ ["<layer name=\"nslay",n,"_",i,"\" top=0",
	952	+ " left=0", ">",
	953	+ "<div id=ielay",n,"_",i," style=\"position:absolute;top:",
	954	+ if disp is vertical then (i-1)*period else margin,
	955	+ "px;left:",
	956	+ if disp is vertical then margin else (i-1)*period,
	957	+ "px\">",
	958	+ format("","",content),
	959	+ "</div></layer>" . format_layers(disp,margin,content,n,num,i+1,period)].
	960	+
	961	+define Printable_tree
	962	+ s_layer
	963	+ (
	964	+ LayerDisposition disp,
	965	+ Int steps,
	966	+ Int margin,
	967	+ Int delay,
	968	+ Web_item content,
	969	+ Int period,
	970	+ Int num
	971	+ ) =
	972	+ with n = new_web_count,
	973	+ [ "<script>",
	974	+ " var layp",n," = 0;",
	975	+ " function scroll_layer",n,"() {",
	976	+ " layp",n,"+=(",steps,"); if (layp",n," ",if steps > 0 then ">" else "<",
	977	+ "= ",if steps > 0 then period else 0,
	978	+ ") layp",n," = ",if steps > 0 then 0 else period,";",
	979	+ move_layer_command(if disp is vertical then "top" else "left",n,num,0,period),
	980	+ " setTimeout(\"scroll_layer",n,"()\",",delay,");",
	981	+ " }",
	982	+ " setTimeout(\"scroll_layer",n,"()\",1000);",
	983	+ "</script>",
	984	+ format_layers(disp,margin,content,n,num,0,period),
	985	+ ].
	986	+
	987	+
	988	+define Printable_tree
	989	+ over
	990	+ (
	991	+ Web_item i,
	992	+ Int left,
	993	+ Int top
	994	+ ) =
	995	+ with n = new_web_count,
	996	+ [ "<layer name=\"nslay",n,"\" top=",top," left=",left,">",
	997	+ " <div id=\"ielay",n,"\" style=\"position:absolute;top=",top,"px;left=",left,"px\">",
	998	+ format("","",i),
	999	+ "</div></layer>"
	1000	+ ].
	1001	+
	1002	+define Printable_tree
	1003	+ bnce
	1004	+ (
	1005	+ Web_item i,
	1006	+ Int left,
	1007	+ Int right,
	1008	+ Int top,
	1009	+ Int bottom
	1010	+ ) =
	1011	+ with n = new_web_count,
	1012	+ [ "<script>",
	1013	+ " var bncx",n," = ",left,"; var bncy",n," = ",top,"; var bncdx",n," = 1; var bncdy",n," = 1;",
	1014	+ " function do_bnc",n,"() {",
	1015	+ " if (bncx",n," >= (",right,") \|\| bncx",n," < ",left,") bncdx",n," = -bncdx",n,";",
	1016	+ " if (bncy",n," >= (",bottom,") \|\| bncy",n," < ",top,") bncdy",n," = -bncdy",n,";",
	1017	+ " bncx",n," += bncdx",n,"; bncy",n," += bncdy",n,";",
	1018	+ " if (document.layers)",
	1019	+ " { document.nslay",n,".left = bncx",n,"; document.nslay",n,".top = bncy",n,"; } else",
	1020	+ " { ielay",n,".style.left = bncx",n,"; ielay",n,".style.top = bncy",n,"; }",
	1021	+ " setTimeout(\"do_bnc",n,"()\",40); }",
	1022	+ " setTimeout(\"do_bnc",n,"()\",1000);",
	1023	+ "</script>",
	1024	+ "<layer name=\"nslay",n,"\" top=",top," left=",left,">",
	1025	+ " <div id=\"ielay",n,"\" style=\"position:absolute;top=",top,"px;left=",left,"px\">",
	1026	+ format("","",i),
	1027	+ "</div></layer>"
	1028	+ ].
	1029	+
	1030	+
	1031	+define Printable_tree
	1032	+ folp_switch
	1033	+ (
	1034	+ Int n,
	1035	+ Int i,
	1036	+ List(FollowPathCommand) path,
	1037	+ Bool loop,
	1038	+ Int steps
	1039	+ ) =
	1040	+ if path is
	1041	+ {
	1042	+ [ ] then [ ],
	1043	+ [p0 . t0] then if p0 is pos(x0,y0,i0,d0) then
	1044	+ if t0 is
	1045	+ {
	1046	+ [ ] then if loop
	1047	+ then [" default: ",
	1048	+ " folpx",n,"=",x0,"; folpy",n,"=",y0,"; ",
	1049	+ " folpseg",n,"=0; ",
	1050	+ " folpwait",n,"=",d0,";",
	1051	+ " if(document.layers)",
	1052	+ " document.nslay",n,".document.folpim",n,".src=folpimages",n,"[",i0,"].src;",
	1053	+ " else document.folpim",n,".src=folpimages",n,"[",i0,"].src;",
	1054	+ " folpstpmax",n," = 0;",
	1055	+ " folpstp",n,"=0;",
	1056	+ " folpdx",n,"=0; ",
	1057	+ " folpdy",n,"=0; ",
	1058	+ " break;"]
	1059	+ else [" default: folpend",n,"=1; break; "],
	1060	+ [p1 . t1] then if p1 is pos(x1,y1,i1,d1) then
	1061	+ [ " case ",i,": ",
	1062	+ " folpx",n,"=",x0,"; folpy",n,"=",y0,"; ",
	1063	+ " folpseg",n,"=",i+1,"; ",
	1064	+ " folpwait",n,"=",d0,";",
	1065	+ " if(document.layers)",
	1066	+ " document.nslay",n,".document.folpim",n,".src=folpimages",n,"[",i0,"].src;",
	1067	+ " else document.folpim",n,".src=folpimages",n,"[",i0,"].src;",
	1068	+ " folpstpmax",n," = ",
	1069	+ "Math.round(Math.sqrt(Math.pow(",x1,"-",x0,",2)+Math.pow(",y1,"-",y0,",2))/",steps,");",
	1070	+ " folpstp",n,"=0;",
	1071	+ " folpdx",n,"=((",x1,"-",x0,")/folpstpmax",n,"); ",
	1072	+ " folpdy",n,"=((",y1,"-",y0,")/folpstpmax",n,"); ",
	1073	+ " break; "
	1074	+ . folp_switch(n,i+1,t0,loop,steps) ]
	1075	+ }}.
	1076	+
	1077	+define Printable_tree
	1078	+ set_folpimages
	1079	+ (
	1080	+ Int n,
	1081	+ List(String) filenames,
	1082	+ Int i,
	1083	+ ) =
	1084	+ if filenames is
	1085	+ {
	1086	+ [ ] then [ ],
	1087	+ [h . t] then
	1088	+ [ " folpimages",n,"[",i,"].src=\"",h,"\";"
	1089	+ . set_folpimages(n,t,i+1)]
	1090	+ }.
	1091	+
	1092	+define Printable_tree
	1093	+ follow_path
	1094	+ (
	1095	+ List(String) filenames,
	1096	+ Int change_every,
	1097	+ List(FollowPathCommand) path,
	1098	+ Bool loop,
	1099	+ Int steps,
	1100	+ Int delay
	1101	+ ) =
	1102	+ if filenames is
	1103	+ {
	1104	+ [ ] then (print("Error in usage of 'follow_path': 'filenames' must be non empty."); []),
	1105	+ [im1 . other_ims] then
	1106	+ if steps < 1 then (print("Error in usage of 'follow_path': 'step' must be >= 1."); [ ]) else
	1107	+ if path is
	1108	+ {
	1109	+ [ ] then [ ],
	1110	+ [p0 . t0] then if p0 is pos(x0,y0,i0,d0) then
	1111	+ if t0 is
	1112	+ {
	1113	+ [ ] then
	1114	+ (print("Error in usage of 'follow_path': 'path' must have at least 2 positions."); []),
	1115	+ [p1 . t1] then if p1 is pos(x1,y1,i1,d1) then
	1116	+ with n = new_web_count,
	1117	+ [
	1118	+ "<layer name=\"nslay",n,"\" top=",y0," left=",x0,">",
	1119	+ "<div id=\"ielay",n,"\" style=\"position:absolute;top=",y0,"px;left=",x0,"px\">",
	1120	+ "<img src=\"",im1,"\" name=\"folpim",n,"\" border=0>",
	1121	+ "</div></layer>",
	1122	+ "<script>",
	1123	+ " var folpimages",n,"=new Array(",length(filenames),");",
	1124	+ " var folpcurim",n,"=0;",
	1125	+ " var folpx",n," = ",x0,";",
	1126	+ " var folpy",n," = ",y0,";",
	1127	+ " var folpseg",n," = 1;",
	1128	+ " var folpstpmax",n," = ",
	1129	+ "Math.round(Math.sqrt(Math.pow(",x1,"-",x0,",2)+Math.pow(",y1,"-",y0,",2))/",steps,");",
	1130	+ " var folpdx",n,"=((",x1,"-",x0,")/folpstpmax",n,"); ",
	1131	+ " var folpdy",n,"=((",y1,"-",y0,")/folpstpmax",n,"); ",
	1132	+ " var folpstp",n," = 0;",
	1133	+ " var folpchgcnt",n," = 0;",
	1134	+ " var folpwait",n,"=",d0,";",
	1135	+ " var folpend",n,"=0;",
	1136	+ " for(var i = 0; i<",length(filenames),"; i++) {",
	1137	+ " folpimages",n,"[i]=new Image(); }",
	1138	+ set_folpimages(n,filenames,0),
	1139	+ " function dofolp",n,"() {",
	1140	+ " if (folpstp",n," >= folpstpmax",n,")",
	1141	+ " { switch(folpseg",n,") {",
	1142	+ folp_switch(n,0,path,loop,steps),
	1143	+ " }} else { folpstp",n,"++; folpx",n," += folpdx",n,"; folpy",n," += folpdy",n,"; };",
	1144	+ " if (document.layers)",
	1145	+ " { document.nslay",n,".left=folpx",n,"; document.nslay",n,".top=folpy",n,"; } else",
	1146	+ " { ielay",n,".style.left=folpx",n,"; ielay",n,".style.top=folpy",n,"; };",
	1147	+
	1148	+ //--- change image if needed:
	1149	+ if change_every = 0 then [ ] else
	1150	+ if length(filenames) =< 1 then [ ] else
	1151	+ [" if (folpchgcnt",n,"==",change_every,") ",
	1152	+ " { ",
	1153	+ " folpchgcnt",n,"=0;",
	1154	+ " folpcurim",n,"++;",
	1155	+ " if (folpcurim",n,"==",length(filenames),") folpcurim",n,"=0;",
	1156	+ " if (document.layers) ",
	1157	+ " document.nslay",n,".document.folpim",n,".src=folpimages",n,"[folpcurim",n,"].src;",
	1158	+ " else document.folpim",n,".src=folpimages",n,"[folpcurim",n,"].src;",
	1159	+ " }",
	1160	+ " else { folpchgcnt",n,"++; };"],
	1161	+
	1162	+ " if (!folpend",n,")",
	1163	+ " if (folpstp",n,") setTimeout(\"dofolp",n,"()\",",delay,"); ",
	1164	+ " else setTimeout(\"dofolp",n,"()\",",delay,"+folpwait",n,"); ",
	1165	+ " }",
	1166	+ " setTimeout(\"dofolp",n,"()\",1000);",
	1167	+ "</script>",
	1168	+ ]
	1169	+ }}}.
	1170	+
	1171	+
	1172	+public type ImageToLoad:
	1173	+ simple(String image_name),
	1174	+ with_rollover(String image_name,
	1175	+ String rollover_name).
	1176	+
	1177	+variable List(ImageToLoad) images_to_load = [].
	1178	+
	1179	+public define Printable_tree
	1180	+ format
	1181	+ (
	1182	+ Web_body_option o
	1183	+ ) =
	1184	+ if o is
	1185	+ {
	1186	+ background_color(c) then [" bgcolor=" , (String)format(c)],
	1187	+ psychedelic_background(a,f,d) then add_script(psychedelic_bg(a,f,d)); [ ],
	1188	+ background_image(n) then [" background=", n],
	1189	+ scrolling_layer(disp,st,m,t,c,p) then add_script(s_layer(disp,st,m,t,c,p,2000\p)); [ ],
	1190	+ bounce(i,l,r,t,b) then add_script(bnce(i,l,r,t,b)); [ ],
	1191	+ over(i,l,t) then add_script(over(i,l,t)); [ ],
	1192	+ follow_path(li,ns,p,l,s,d) then add_script(follow_path(li,ns,p,l,s,d)); [ ],
	1193	+ load_image(n) then images_to_load <- [simple(n) . *images_to_load]; [ ],
	1194	+ left_margin(n) then [" leftmargin=", n],
	1195	+ top_margin(n) then [" topmargin=", n],
	1196	+ margin_width(n) then [" marginwidth=", n],
	1197	+ margin_height(n) then [" marginheight=", n],
	1198	+ reload_frame(n,url) then add_body_onload(reload_frame(n,url)); [ ],
	1199	+ onload(n) then [" onLoad=\"", n, "()\""]
	1200	+ }.
	1201	+
	1202	+define Printable_tree
	1203	+ preload_list
	1204	+ (
	1205	+ List(ImageToLoad) images,
	1206	+ Int n,
	1207	+ ) =
	1208	+ if images is
	1209	+ {
	1210	+ [ ] then [ ],
	1211	+ [h . t] then
	1212	+ [" preloaded_images[",n,"].src = '",image_name(h),"';",
	1213	+ if h is
	1214	+ {
	1215	+ simple(_) then [],
	1216	+ with_rollover(n1,r) then
	1217	+ [" preloaded_images[",n1,"].onload = 'allow_rollover(\"",r,"\")';"]
	1218	+ }
	1219	+ . preload_list(t,n-1)]
	1220	+ }.
	1221	+
	1222	+define Printable_tree
	1223	+ load_image_script
	1224	+ (
	1225	+ List(ImageToLoad) images
	1226	+ ) =
	1227	+ if images is
	1228	+ {
	1229	+ [ ] then [ ],
	1230	+ [_ . _] then
	1231	+ [
	1232	+ "<script>",
	1233	+ " var preloaded_images = new Array(",length(images),");",
	1234	+ " var pi_i = 0;",
	1235	+ " for(pi_i = 0; pi_i < ",length(images),"; pi_i++) {",
	1236	+ " preloaded_images[pi_i] = new Image(); }",
	1237	+ " function preload_images() {",
	1238	+ preload_list(images,length(images)-1),
	1239	+ " }</script>"
	1240	+ ]
	1241	+ }.
	1242	+
	1243	+
	1244	+public define Printable_tree format(String c_ticket,
	1245	+ String s_ticket,
	1246	+ Web_item i).
	1247	+
	1248	+
	1249	+public define Printable_tree
	1250	+ format(List(Table_option) l) =
	1251	+ if l is
	1252	+ {
	1253	+ [ ] then [ ],
	1254	+ [h . t] then [if h is
	1255	+ {
	1256	+ background_color(c) then [" bgcolor=", (String)format(c)],
	1257	+ background_image(f) then [" background=",f],
	1258	+ border then [" border"],
	1259	+ nude then [" border=\"0\" cellspacing=\"0\" cellpadding=\"0\""],
	1260	+ border(e,top,i) then [" border=",e," cellspacing=",top," cellpadding=",i],
	1261	+ border_color(c) then [" bordercolor=", (String)format(c)],
	1262	+ absolute_width(n) then [" width=",n]
	1263	+ }, format(t)]
	1264	+ }.
	1265	+
	1266	+
	1267	+
	1268	+public define Printable_tree
	1269	+ format(List(Row_option) l) =
	1270	+ if l is
	1271	+ {
	1272	+ [ ] then [ ],
	1273	+ [first . others] then [if first is
	1274	+ {
	1275	+ left then [" align=left"],
	1276	+ h_center then [" align=center"],
	1277	+ right then [" align=right"],
	1278	+ top then [" valign=top"],
	1279	+ v_center then [" valign=center"],
	1280	+ bottom then [" valign=bottom"],
	1281	+ absolute_height(n) then [" height=\"",n,"\""],
	1282	+ base_line then [" valign=baseline"],
	1283	+ background_color(c) then [" bgcolor=",(String)format(c)]
	1284	+ },
	1285	+ format(others)]
	1286	+ }.
	1287	+
	1288	+
	1289	+
	1290	+
	1291	+public define Int
	1292	+ percentage(Int n) =
	1293	+ if n < 0 then 0
	1294	+ else if n > 100 then 100
	1295	+ else n.
	1296	+
	1297	+ public define Int percentage(Int n) = n.
	1298	+
	1299	+
	1300	+
	1301	+
	1302	+public define Printable_tree
	1303	+ format
	1304	+ (
	1305	+ List(Web_body_option) l
	1306	+ ) =
	1307	+ if l is
	1308	+ {
	1309	+ [ ] then [ ],
	1310	+ [h . t] then [format(h) . format(t)]
	1311	+ }.
	1312	+
	1313	+
	1314	+
	1315	+
	1316	+public define Printable_tree
	1317	+ format(List(Cell_option) l) =
	1318	+ if l is
	1319	+ {
	1320	+ [ ] then [ ],
	1321	+ [first . others] then
	1322	+ [if first is
	1323	+ {
	1324	+ left then (Printable_tree)[" align=left"],
	1325	+ h_center then (Printable_tree)[" align=center"],
	1326	+ right then (Printable_tree)[" align=right"],
	1327	+ top then (Printable_tree)[" valign=top"],
	1328	+ v_center then (Printable_tree)[" valign=center"],
	1329	+ bottom then (Printable_tree)[" valign=bottom"],
	1330	+ base_line then (Printable_tree)[" valign=baseline"],
	1331	+ background_color(c) then (Printable_tree)[" bgcolor=",(String)format(c)],
	1332	+ background_image(n) then (Printable_tree)[" style=\"background: url(",n,")\""],
	1333	+ absolute_width(w) then (Printable_tree)[" width=",w],
	1334	+ relative_width(r) then (Printable_tree)[" width=",percentage(r),""],
	1335	+ absolute_height(h) then (Printable_tree)[" height=",h],
	1336	+ relative_height(r) then (Printable_tree)[" height=",percentage(r),""],
	1337	+ columns(n) then (Printable_tree)[" colspan=",n],
	1338	+ rows(n) then (Printable_tree)[" rowspan=",n],
	1339	+ nowrap then (Printable_tree)[" nowrap"]
	1340	+ }
	1341	+ . format(others)]
	1342	+ }.
	1343	+
	1344	+
	1345	+
	1346	+public define Printable_tree
	1347	+ format
	1348	+ (
	1349	+ String c_ticket,
	1350	+ String s_ticket,
	1351	+ List(Cell) l
	1352	+ ) =
	1353	+ if l is
	1354	+ {
	1355	+ [ ] then [ ],
	1356	+ [first . others] then
	1357	+ [if first is cell(options,item) then
	1358	+ ["<td",format(options),">",
	1359	+ format(c_ticket,s_ticket,item),"</td>"],
	1360	+ format(c_ticket,s_ticket,others)]
	1361	+ }.
	1362	+
	1363	+
	1364	+public define Printable_tree
	1365	+ format
	1366	+ (
	1367	+ String c_ticket,
	1368	+ String s_ticket,
	1369	+ List(Table_row) l
	1370	+ ) =
	1371	+ if l is
	1372	+ {
	1373	+ [ ] then [ ],
	1374	+ [first_row . other_rows]
	1375	+ then [if first_row is
	1376	+ {
	1377	+ row(options,cells) then
	1378	+ [ "<tr",format(options),">",
	1379	+ format(c_ticket,s_ticket,cells),"</tr>"]
	1380	+ },
	1381	+ format(c_ticket,s_ticket,other_rows)]
	1382	+ }.
	1383	+
	1384	+
	1385	+public define Printable_tree
	1386	+ format_choices
	1387	+ (
	1388	+ List(String) l
	1389	+ ) =
	1390	+ if l is
	1391	+ {
	1392	+ [ ] then [ ],
	1393	+ [h . t] then ["<option>",h . format_choices(t)]
	1394	+ }.
	1395	+
	1396	+
	1397	+public define Printable_tree
	1398	+ format_choices
	1399	+ (
	1400	+ List(String) l,
	1401	+ String selected
	1402	+ ) =
	1403	+ if l is
	1404	+ {
	1405	+ [ ] then [ ],
	1406	+ [h . t] then if h = selected
	1407	+ then ["<option selected>",h . format_choices(t)]
	1408	+ else ["<option>",h . format_choices(t,selected)]
	1409	+ }.
	1410	+
	1411	+
	1412	+public define Printable_tree
	1413	+ format_list
	1414	+ (
	1415	+ String c_ticket,
	1416	+ String s_ticket,
	1417	+ List(Web_item) l
	1418	+ ) =
	1419	+ if l is
	1420	+ {
	1421	+ [ ] then [ ],
	1422	+ [h . t] then ["<li>",format(c_ticket,s_ticket,h),
	1423	+ format_list(c_ticket,s_ticket,t)]
	1424	+ }.
	1425	+
	1426	+
	1427	+public define String
	1428	+ format
	1429	+ (
	1430	+ WebStyle ws
	1431	+ ) =
	1432	+ if ws is
	1433	+ {
	1434	+ background_image(fn) then "background: url("+fn+")",
	1435	+ background_color(c) then "background: "+format(c),
	1436	+ background_transparent then "background: transparent",
	1437	+ background_repeat_horizontal then "background: repeat-x",
	1438	+ background_repeat_vertical then "background: repeat-y",
	1439	+ background_no_repeat then "background: no-repeat",
	1440	+ color(wc) then if wc is
	1441	+ {
	1442	+ rgb(r,g,b) then "color: rgb("+r+","+g+","+b+")",
	1443	+ _(c) then "color: "+format(c)
	1444	+ },
	1445	+ float_to_left then "float: left",
	1446	+ float_to_right then "float: right",
	1447	+ font_family(n) then "font-family: "+n,
	1448	+ font_size(n) then "font-size: "+to_decimal(n)+"pt",
	1449	+ italic then "font-style: italic",
	1450	+ oblique then "font-style: oblique",
	1451	+ small_capitals then "font-variant: small-caps",
	1452	+ bold then "font-weight: bold",
	1453	+ bolder then "font-weight: bolder",
	1454	+ lighter then "font-weight: lighter",
	1455	+ line_height(h) then "line-height: "+to_decimal(h),
	1456	+ text_center then "text-align: center",
	1457	+ text_left then "text-align: left",
	1458	+ text_right then "text-align: right",
	1459	+ text_justify then "text-align: justify",
	1460	+ text_underline then "text-decoration: underline",
	1461	+ text_blink then "text-decoration: blink",
	1462	+ text_line_through then "text-decoration: line-through",
	1463	+ width(n) then "width: "+to_decimal(n),
	1464	+ }.
	1465	+
	1466	+
	1467	+public define Printable_tree
	1468	+ format
	1469	+ (
	1470	+ List(WebStyle) l
	1471	+ ) =
	1472	+ if l is
	1473	+ {
	1474	+ [ ] then [ ],
	1475	+ [h . t] then
	1476	+ if t is
	1477	+ {
	1478	+ [ ] then [format(h)],
	1479	+ [_ . _] then [format(h), "; " . format(t)]
	1480	+ }
	1481	+ }.
	1482	+
	1483	+
	1484	+define Printable_tree
	1485	+ format_polygon_coordinates
	1486	+ (
	1487	+ List((Int,Int)) vertices
	1488	+ ) =
	1489	+ if vertices is
	1490	+ {
	1491	+ [ ] then [ ],
	1492	+ [h . t] then
	1493	+ if h is (x,y) then
	1494	+ if t is []
	1495	+ then [ x,",",y ]
	1496	+ else [ x,",",y,"," . format_polygon_coordinates(t)]
	1497	+ }.
	1498	+
	1499	+ define Printable_tree
	1500	+ format
	1501	+ (
	1502	+ List(Mouse_Sensitive_Zone) zones
	1503	+ ) =
	1504	+ if zones is
	1505	+ {
	1506	+ [ ] then [ ],
	1507	+ [h . t] then
	1508	+ [
	1509	+ if h is
	1510	+ {
	1511	+ rectangle(lt,rb,url) then
	1512	+ if lt is (left,top) then
	1513	+ if rb is (right,bottom) then
	1514	+ [ "<area shape=rect coords=\"",left,",",top,",",right,",",bottom,
	1515	+ "\" href=\"",url,"\">" ],
	1516	+ circle(c,r,url) then
	1517	+ if c is (x,y) then
	1518	+ [ "<area shape=circle coords=\"",x,",",y,",",r,
	1519	+ "\" href=\"",url,"\">" ],
	1520	+ polygon(vs,url) then
	1521	+ [ "<area shape=poly coords=\"",format_polygon_coordinates(vs),
	1522	+ "\" href=\"",url,"\">" ]
	1523	+ }
	1524	+ . format(t)]
	1525	+ }.
	1526	+
	1527	+define Printable_tree
	1528	+ format
	1529	+ (
	1530	+ List(Mouse_Sensitive_Zone) zones,
	1531	+ String c_ticket,
	1532	+ String s_ticket,
	1533	+ ) =
	1534	+ if zones is
	1535	+ {
	1536	+ [ ] then [ ],
	1537	+ [h . t] then
	1538	+ [
	1539	+ if h is
	1540	+ {
	1541	+ rectangle(lt,rb,url) then
	1542	+ if lt is (left,top) then
	1543	+ if rb is (right,bottom) then
	1544	+ [ "<area shape=rect coords=\"",left,",",top,",",right,",",bottom,
	1545	+ "\" href=\"", url + "&c_ticket=" + c_ticket + "&s_ticket=" + s_ticket,"\">" ],
	1546	+ circle(c,r,url) then
	1547	+ if c is (x,y) then
	1548	+ [ "<area shape=circle coords=\"",x,",",y,",",r,
	1549	+ "\" href=\"", url + "&c_ticket=" + c_ticket + "&s_ticket=" + s_ticket,"\">" ],
	1550	+ polygon(vs,url) then
	1551	+ [ "<area shape=poly coords=\"",format_polygon_coordinates(vs),
	1552	+ "\" href=\"", url + "&c_ticket=" + c_ticket + "&s_ticket=" + s_ticket,"\">" ]
	1553	+ }
	1554	+ . format(t, c_ticket, s_ticket)]
	1555	+ }.
	1556	+
	1557	+variable Int map_number = 0.
	1558	+
	1559	+define Printable_tree
	1560	+ format_mouse_sensitive_image
	1561	+ (
	1562	+ String image_file_name,
	1563	+ List(Mouse_Sensitive_Zone) zones,
	1564	+ String c_ticket,
	1565	+ String s_ticket,
	1566	+ ) =
	1567	+ map_number <- (*map_number)+1;
	1568	+ [
	1569	+ "<img src=\"",image_file_name,"\" usemap=\"#imsensmap",*map_number,"\" border=0>",
	1570	+ "<map name=\"imsensmap",*map_number,"\">",
	1571	+ format(zones, c_ticket, s_ticket),
	1572	+ "</map>"
	1573	+ ].
	1574	+
	1575	+
	1576	+ Find an 'upload' in a web item.
	1577	+
	1578	+define Bool
	1579	+ find_upload
	1580	+ (
	1581	+ Web_item i
	1582	+ ).
	1583	+
	1584	+define Bool
	1585	+ find_upload
	1586	+ (
	1587	+ List(Web_item) li
	1588	+ ) =
	1589	+ if li is
	1590	+ {
	1591	+ [ ] then false,
	1592	+ [h . t] then if find_upload(h) then true else find_upload(t)
	1593	+ }.
	1594	+
	1595	+define Bool
	1596	+ find_upload
	1597	+ (
	1598	+ Cell c
	1599	+ ) =
	1600	+ if c is cell(lo,wi) then find_upload(wi).
	1601	+
	1602	+define Bool
	1603	+ find_upload
	1604	+ (
	1605	+ List(Cell) lc
	1606	+ ) =
	1607	+ if lc is
	1608	+ {
	1609	+ [ ] then false,
	1610	+ [h . t] then if find_upload(h) then true else find_upload(t)
	1611	+ }.
	1612	+
	1613	+
	1614	+
	1615	+define Bool
	1616	+ find_upload
	1617	+ (
	1618	+ Table_row tr
	1619	+ ) =
	1620	+ if tr is
	1621	+ {
	1622	+ row(lo,lc) then find_upload(lc)
	1623	+ }.
	1624	+
	1625	+define Bool
	1626	+ find_upload
	1627	+ (
	1628	+ List(Table_row) l
	1629	+ ) =
	1630	+ if l is
	1631	+ {
	1632	+ [ ] then false,
	1633	+ [h . t] then
	1634	+ if find_upload(h) then true else find_upload(t)
	1635	+ }.
	1636	+
	1637	+define Bool
	1638	+ find_upload
	1639	+ (
	1640	+ Web_item wi
	1641	+ ) =
	1642	+ if wi is
	1643	+ {
	1644	+ [ ] then (Bool)false,
	1645	+ [a . b] then (Bool)if find_upload(a) then true else find_upload(b),
	1646	+ text(_) then (Bool)false,
	1647	+ text_pt(_) then (Bool)false,
	1648	+ text_nowrap(_) then (Bool)false,
	1649	+ text_nowrap_pt(_) then (Bool)false,
	1650	+ par(_) then (Bool)false,
	1651	+ preformated_text(_) then (Bool)false,
	1652	+ integer(_) then (Bool)false,
	1653	+ float(_,_) then (Bool)false,
	1654	+ center(i) then (Bool)find_upload(i),
	1655	+ bigger(n,i) then (Bool)find_upload(i),
	1656	+ smaller(n,i) then (Bool)find_upload(i),
	1657	+ bold(i) then (Bool)find_upload(i),
	1658	+ italic(i) then (Bool)find_upload(i),
	1659	+ big(i) then (Bool)find_upload(i),
	1660	+ very_big(i) then (Bool)find_upload(i),
	1661	+ style(_,i) then (Bool)find_upload(i),
	1662	+ spacer(_,_) then (Bool)false,
	1663	+ image(_) then (Bool)false,
	1664	+ image_d(_,_) then (Bool)false,
	1665	+ image_pt(_) then (Bool)false,
	1666	+ on_image(_,_) then (Bool)false,
	1667	+ turning_images(_,_) then (Bool)false,
	1668	+ rollover(_,_,_,_,_,_) then (Bool)false,
	1669	+ rollover(_,_,_,_,_,_,_,_) then (Bool)false,
	1670	+ mouse_sensitive_image(_,_) then (Bool)false,
	1671	+ background_sound(_,_) then (Bool)false,
	1672	+ form(_,c) then (Bool)find_upload(c),
	1673	+ form_target(_,c,_) then (Bool)find_upload(c),
	1674	+ form(_,_,c) then (Bool)find_upload(c),
	1675	+ form_name(_,c) then (Bool)find_upload(c),
	1676	+ text_input(_,_,_) then (Bool)false,
	1677	+ password_input(_,_) then (Bool)false,
	1678	+ text_area(_,_,_,_) then (Bool)false,
	1679	+ upload(_,_) then (Bool)true,
	1680	+ submit(_) then (Bool)false,
	1681	+ submit_pt(_) then (Bool)false,
	1682	+ submit(_,_) then (Bool)false,
	1683	+ submit_close(_,_) then (Bool)false,
	1684	+ submit_pt2(_,_) then (Bool)false,
	1685	+ image_submit(_,_) then (Bool)false,
	1686	+ image_submit(_,_,_,_) then (Bool)false,
	1687	+ hl_image_submit(_,_,_,_,_) then (Bool)false,
	1688	+ text_submit(_,_,_) then (Bool)false,
	1689	+ web_submit(_,c) then (Bool)find_upload(c),
	1690	+ button(_,_,_,_,_) then (Bool)false,
	1691	+ mark(_,_) then (Bool)false,
	1692	+ mark_pt(_,_) then (Bool)false,
	1693	+ close_button then (Bool)false,
	1694	+ close_button(_) then (Bool)false,
	1695	+ label(_) then (Bool)false,
	1696	+ go_to_label(_,i) then (Bool)find_upload(i),
	1697	+ table(_,rows) then (Bool)find_upload(rows),
	1698	+ list(l) then (Bool)find_upload(l),
	1699	+ link(_,i) then (Bool)find_upload(i),
	1700	+ link(_,_,i) then (Bool)find_upload(i),
	1701	+ link_for_download(n,i) then (Bool)find_upload(i),
	1702	+ mail_to(_,i) then (Bool)find_upload(i),
	1703	+ select(_,_,_) then (Bool)false,
	1704	+ select(_,_,_,_) then (Bool)false,
	1705	+ immediate_select(_,_,_) then (Bool)false,
	1706	+ radio_button(_,_) then (Bool)false,
	1707	+ checked_radio_button(_,_) then (Bool)false,
	1708	+ check_box(_,_) then (Bool)false,
	1709	+ checked_box(_,_) then (Bool)false,
	1710	+ link_to_window(_,i) then (Bool)find_upload(i),
	1711	+ link_to_window(_,_,i) then (Bool)find_upload(i),
	1712	+ link_to_window_with_ticket(_,_,_,i,_,_) then (Bool)find_upload(i),
	1713	+ link_to_window_with_ticket_and_scroll(_,_,_,i,_,_) then (Bool)find_upload(i),
	1714	+ link_to_window_with_ticket_and_scroll(_,_,_,_,i,_,_) then (Bool)find_upload(i),
	1715	+ link_to_frame(_,_,i) then (Bool)find_upload(i),
	1716	+ }.
	1717	+
	1718	+
	1719	+ The next function generates "enctype=multipart/form-data" or "", depending on the presence of
	1720	+ an 'upload' in form-content.
	1721	+
	1722	+define String
	1723	+ enctype
	1724	+ (
	1725	+ Web_item form_content
	1726	+ ) =
	1727	+ if find_upload(form_content)
	1728	+ then "enctype=multipart/form-data"
	1729	+ else "".
	1730	+
	1731	+define Printable_tree
	1732	+ set_turning_images_sources
	1733	+ (
	1734	+ Int i,
	1735	+ String name,
	1736	+ List(String) filenames
	1737	+ ) =
	1738	+ if filenames is
	1739	+ {
	1740	+ [ ] then [ ],
	1741	+ [h . t] then
	1742	+ [" i",name,"[",i,"].src=\"",h,"\";"
	1743	+ . set_turning_images_sources(i+1,name,t)]
	1744	+ }.
	1745	+
	1746	+define Bool
	1747	+ member
	1748	+ (
	1749	+ Word8 x,
	1750	+ Printable_tree t
	1751	+ ) =
	1752	+ if t is
	1753	+ {
	1754	+ [] then false,
	1755	+ str_pt(String _0,Printable_tree _1) then (member(x,_0) \| member(x,_1)),
	1756	+ ba_pt(ByteArray _0,Printable_tree _1) then (member(x,to_string(_0)) \| member(x,_1)),
	1757	+ int_pt(Int _0,Printable_tree _1) then (member(x,to_decimal(_0)) \| member(x,_1)),
	1758	+ pt_pt(Printable_tree _0,Printable_tree _1) then (member(x,_0) \| member(x,_1))
	1759	+ }.
	1760	+
	1761	+public define Printable_tree
	1762	+ format
	1763	+ (
	1764	+ String c_ticket,
	1765	+ String s_ticket,
	1766	+ Web_item wi
	1767	+ ) =
	1768	+ if wi is
	1769	+ {
	1770	+ [ ] then (Printable_tree)[ ],
	1771	+
	1772	+ [a . b] then (Printable_tree)[format(c_ticket,s_ticket,a), " ",
	1773	+ format(c_ticket,s_ticket,b)],
	1774	+
	1775	+ text(String s) then (Printable_tree)[s],
	1776	+
	1777	+ text_pt(Printable_tree s) then (Printable_tree)s,
	1778	+
	1779	+ text_nowrap(String s) then (Printable_tree)["<table><tr><td nowrap=\"nowrap>",s,"</td></tr></table>"],
	1780	+
	1781	+ text_nowrap_pt(Printable_tree s) then
	1782	+ (Printable_tree)["<table><tr><td \"nowrap\">",s,"</td></tr></table>"],
	1783	+
	1784	+ par(s) then (Printable_tree)
	1785	+ [ "<p align=\"justify\">", s, " </p>"],
	1786	+
	1787	+ preformated_text(t) then (Printable_tree) ["<pre>",t,"</pre>"],
	1788	+
	1789	+ integer(n) then (Printable_tree)[n],
	1790	+
	1791	+ float(f,p) then (Printable_tree)[float_to_string(f,p)],
	1792	+
	1793	+ center(item) then (Printable_tree)["<center>", format(c_ticket,s_ticket,item),"</center>"],
	1794	+
	1795	+ bigger(n,item) then (Printable_tree)["<font size=\"+",n,"\">",format(c_ticket,s_ticket,item),"</font>"],
	1796	+
	1797	+ smaller(n,item) then (Printable_tree)["<font size=\"-",n,"\">",format(c_ticket,s_ticket,item),"</font>"],
	1798	+
	1799	+ bold(item) then
	1800	+ (Printable_tree)["<font style=\"font-weight: bold\">",format(c_ticket,s_ticket,item),"</font>"],
	1801	+
	1802	+ italic(item) then
	1803	+ (Printable_tree)["<font style=\"font-style: italic\">",format(c_ticket,s_ticket,item),"</font>"],
	1804	+
	1805	+ big(item) then (Printable_tree)["<font size=\"+1\">",format(c_ticket,s_ticket,item),"</font>"],
	1806	+
	1807	+ very_big(item) then (Printable_tree)["<h1>",format(c_ticket,s_ticket,item),"</h1>"],
	1808	+
	1809	+ style(l,i) then
	1810	+ (Printable_tree)["<span style=\"", format(l), "\">", format(c_ticket,s_ticket,i), "</span>"],
	1811	+
	1812	+ spacer(w,h) then (Printable_tree)
	1813	+ ["<img src=\"spacer.gif\" width=\"",w,"\" height=\"",h,"\" border=\"0\">"],
	1814	+
	1815	+ image(String f) then (Printable_tree)["<img src=\"", f,"\" border=\"0\">"],
	1816	+
	1817	+ image_d(fn,desc) then (Printable_tree)["<img src=\"", fn,"\" alt=\"",desc,"\" border=\"0\">"],
	1818	+
	1819	+ image_pt(Printable_tree l) then (Printable_tree)["<img src=\"", l,"\" border=\"0\">"],
	1820	+
	1821	+ on_image(fn,x) then (Printable_tree)
	1822	+ ["<span style=\"background: url(",fn,")\">",format(c_ticket,s_ticket,x),"</span>"],
	1823	+
	1824	+ turning_images(fns,msec) then if fns is [im0 . imo] then
	1825	+ with name = "trni"+to_decimal(new_web_count), n = 1+length(imo), (Printable_tree)
	1826	+ ["<script>",
	1827	+ "var i",name,"=new Array(",n,");",
	1828	+ "var n",name,"=0;",
	1829	+ "for(var i=0; i<",n,"; i++) {",
	1830	+ " i",name,"[i]=new Image(); }",
	1831	+ set_turning_images_sources(0,name,(List(String))[im0 . imo]),
	1832	+
	1833	+ "function a",name,"() {",
	1834	+ "if (i",name,"[(n",name,"+1)%",n,"].complete)",
	1835	+ "{n",name,"=(n",name,"+1)%",n,";",
	1836	+ "document.",name,".src=i",name,"[n",name,"].src; }",
	1837	+ "setTimeout(\"a",name,"()\",",msec,"); }",
	1838	+
	1839	+ "setTimeout(\"a",name,"()\",",msec,");",
	1840	+ "</script>",
	1841	+ "<img src=\"",im0,"\" name=\"",name,"\" border=\"0\">"],
	1842	+
	1843	+ rollover(prlim,url,target,ion,ioff,descr) then (Printable_tree)
	1844	+ (images_to_load <- [simple(ion) . *images_to_load];
	1845	+ with name = "ron_"+to_decimal(new_web_count),
	1846	+ ["<a target=\"",target,"\" href=\"",url,
	1847	+ (if (c_ticket = "" & s_ticket = "") then "" else (if member('?',url) then "&" else "?")),
	1848	+ (if c_ticket = "" then [ ] else ["c_ticket=",c_ticket]),
	1849	+ (if s_ticket = "" then [ ] else ["&s_ticket=",s_ticket]),
	1850	+ "\" onmouseout=\"",name,".src='",ioff,
	1851	+ "';\" onmouseover=\"",name,".src='",ion,"';\"><img src=\"",ioff,
	1852	+ "\" name=\"",name,"\" alt=\"",descr,"\" border=\"0\"></a>"]),
	1853	+
	1854	+ rollover(prlim,url,target,ion,ioff,w,h,descr) then (Printable_tree)
	1855	+ (images_to_load <- [simple(ion) . *images_to_load];
	1856	+ with name = "ron_"+to_decimal(new_web_count),
	1857	+ ["<a target=\"",target,"\" href=\"",url,
	1858	+ (if (c_ticket = "" & s_ticket = "") then "" else (if member('?',url) then "&" else "?")),
	1859	+ (if c_ticket = "" then [ ] else ["c_ticket=",c_ticket]),
	1860	+ (if s_ticket = "" then [ ] else ["&s_ticket=",s_ticket]),
	1861	+ "\" onmouseout=\"",name,".src='",ioff,
	1862	+ "';\" onmouseover=\"",name,".src='",ion,"';\"><img src=\"",ioff,
	1863	+ "\" name=\"",name,"\" width=\"",w,"\" height=\"",h,"\" alt=\"",descr,"\" border=\"0\"></a>"]),
	1864	+
	1865	+ mouse_sensitive_image(fn,lz) then (Printable_tree)
	1866	+ format_mouse_sensitive_image(fn,lz, c_ticket, s_ticket),
	1867	+
	1868	+ background_sound(sfn,loop) then (Printable_tree)
	1869	+ ["<embed src=\"", sfn, "\" autostart=\"true\" loop=\"", if loop then "true\">" else "false\">"],
	1870	+
	1871	+ form(n,c) then (Printable_tree)
	1872	+ ["<form ",enctype(c)," method=\"post\" action=\"", n, "\">",
	1873	+ "<input type=\"hidden\" name=\"s_ticket\" value=\"",s_ticket,"\" />",
	1874	+ "<input type=\"hidden\" name=\"c_ticket\" value=\"",c_ticket,"\" />",
	1875	+ format(c_ticket,s_ticket,c),"</form>"],
	1876	+
	1877	+ form_target(n,c,t) then (Printable_tree)
	1878	+ ["<form ",enctype(c)," method=\"post\" action=\"", n, "\" target=\"", t, "\">",
	1879	+ "<input type=\"hidden\" name=\"s_ticket\" value=\"",s_ticket,"\" />",
	1880	+ "<input type=\"hidden\" name=\"c_ticket\" value=\"",c_ticket,"\" />",
	1881	+ format(c_ticket,s_ticket,c),"</form>"],
	1882	+
	1883	+ form(n,l,c) then (Printable_tree)
	1884	+ ["<form ",enctype(c)," method=\"post\" action=\"", n,"#", l, "\">",
	1885	+ "<input type=\"hidden\" name=\"s_ticket\" value=\"",s_ticket,"\" />",
	1886	+ "<input type=\"hidden\" name=\"c_ticket\" value=\"",c_ticket,"\" />",
	1887	+ format(c_ticket,s_ticket,c),"</form>"],
	1888	+
	1889	+ form_name(fn,c) then (Printable_tree)
	1890	+ [
	1891	+ // "<form ",enctype(c), "\" name=\"", fn, "\">",
	1892	+ "<form name=\"", fn, "\">",
	1893	+ "<input type=\"hidden\" name=\"s_ticket\" value=\"",s_ticket,"\" />",
	1894	+ "<input type=\"hidden\" name=\"c_ticket\" value=\"",c_ticket,"\" />",
	1895	+ format(c_ticket,s_ticket,c),"</form>"],
	1896	+
	1897	+ text_input(n,s,v) then (Printable_tree)
	1898	+ ["  <input type=\"text\" name=\"", n, "\" size=\"", s, "\" value=\"", v,"\" />"],
	1899	+
	1900	+ password_input(n,s) then (Printable_tree)
	1901	+ ["  <input type=\"password\" name=\"", n, "\" size=\"", s,"\" />"],
	1902	+
	1903	+ text_area(name,c,r,i) then (Printable_tree)
	1904	+ ["<textarea name=\"",name,"\" cols=\"",c,"\" rows=\"",r,"\" wrap=\"physical\">",i,"</textarea>"],
	1905	+
	1906	+ upload(n,size) then (Printable_tree)
	1907	+ ["<input type=\"file\" size=\"",size,"\" multiple=\"multiple\" name=\"",n,"\" />"],
	1908	+
	1909	+ submit(String t) then (Printable_tree)["<input type=\"submit\" value=\"",t,"\" />"],
	1910	+
	1911	+ submit_pt(Printable_tree t) then (Printable_tree)["<input type=\"submit\" value=\"",t,"\" />"],
	1912	+
	1913	+ submit(n, String t) then (Printable_tree)
	1914	+ ["<input type=\"submit\" name=\"",n,"\" value=\"",t,"\">"],
	1915	+
	1916	+ submit_close(n, String t) then (Printable_tree)
	1917	+ ["<input type=\"submit\" name=\"",n,"\" value=\"",t,"\" onclick=\"window.top.close();\" />"],
	1918	+
	1919	+ submit_pt2(n, Printable_tree t) then (Printable_tree)
	1920	+ ["<input type=\"submit\" name=\"",n,"\" value=\"",t,"\" />"],
	1921	+
	1922	+ image_submit(n,ifn) then (Printable_tree)
	1923	+ ["<input type=\"image\" name=\"",n,"\" src=\"",ifn,"\" border=\"0\" />"],
	1924	+
	1925	+ image_submit(n,v,ifn,c) then (Printable_tree)
	1926	+ ["<img src=\"",ifn,"\" onmousedown=\"document.forms[0].action='",
	1927	+ n,"=",v,"'; document.forms[0].submit();\" />"],
	1928	+
	1929	+ hl_image_submit(n,v,in,ifn,hlifn) then (Printable_tree)
	1930	+ ["<img src=\"",ifn,"\"",
	1931	+ //" name=\"",in,"\"",
	1932	+ " onmouseover=\"this.src='",hlifn,"'\"",
	1933	+ " onmouseout=\"this.src='",ifn,"'\"",
	1934	+ " onmousedown=\"document.forms[0].action='",
	1935	+ n,"=",v,"'; document.forms[0].submit();\" />"],
	1936	+
	1937	+ text_submit(n,v,t) then (Printable_tree)
	1938	+ ["<a href=\"",n,
	1939	+ (if (s_ticket = "" & c_ticket = "" & v = "") then "" else "?"),
	1940	+ (if s_ticket = "" then [ ] else ["s_ticket=",s_ticket,"&"]),
	1941	+ (if c_ticket = "" then [ ] else ["c_ticket=",c_ticket]),
	1942	+ v,"\">",t,"</a>"],
	1943	+
	1944	+
	1945	+ web_submit(wa,i) then (Printable_tree)
	1946	+ ["<a href=\"javascript:document.forms[0].action='",
	1947	+ wa,"'; document.forms[0].submit();\">",format(c_ticket,s_ticket,i),"</a>"],
	1948	+
	1949	+ button(n, String t, String o, Int w, Int h) then (Printable_tree)
	1950	+ ["<input type=button name=",n," value=\"",t,
	1951	+ "\"style=\"width=",w, ";height=", h, "\" ", "\" onclick=\"", o, "\";\" />"],
	1952	+
	1953	+ mark(n, String v) then (Printable_tree)
	1954	+ ["<input type=\"hidden\" name=\"",n,"\" value=\"",v,"\" />"],
	1955	+
	1956	+ mark_pt(n, Printable_tree v) then (Printable_tree)
	1957	+ ["<input type=\"hidden\" name=\"",n,"\" value=\"",v,"\" />"],
	1958	+
	1959	+ close_button then (Printable_tree)
	1960	+ ["<form><input type=\"button\" value=\" Fermer \" onclick=\"window.top.close();\"></form>"],
	1961	+
	1962	+ close_button(ifn) then (Printable_tree)
	1963	+ ["<form><input type=\"image\" name=\"close\" src=\"", ifn,
	1964	+ "\" onclick=\"window.top.close();\" /></form>"],
	1965	+
	1966	+/*
	1967	+ close_button(ifn) then (Printable_tree)
	1968	+ ["<form><input type=\"button\" name=\"close\" src=\"", ifn,
	1969	+ "\" onclick=\"window.top.close();\"></form>"],
	1970	+*/
	1971	+ label(name) then (Printable_tree)["<a name=\"",name,"\" />"],
	1972	+
	1973	+ go_to_label(name,content) then (Printable_tree)["<a href=#",name,">",
	1974	+ format(c_ticket,s_ticket,content),"</a>"],
	1975	+
	1976	+ table(ops,rows) then (Printable_tree)["<table ",
	1977	+ format(ops), ">",format(c_ticket,s_ticket,rows),"</table>"],
	1978	+
	1979	+ list(l) then (Printable_tree)["<ul>",format_list(c_ticket,s_ticket,l),"</ul>"],
	1980	+
	1981	+ link(name,i) then (Printable_tree)["<a href=\"",name,
	1982	+ (if (c_ticket = "" & s_ticket = "") then "" else (if member('?',name) then "&" else "?")),
	1983	+ (if c_ticket = "" then [ ] else ["c_ticket=",c_ticket]),
	1984	+ (if s_ticket = "" then [ ] else [if c_ticket = "" then "" else "&","s_ticket=",s_ticket]),
	1985	+ "\">",format(c_ticket,s_ticket,i),"</a>"],
	1986	+
	1987	+ link(name,target,i) then (Printable_tree)["<a target=\"",target,"\" href=\"",name,
	1988	+ (if (c_ticket = "" & s_ticket = "") then "" else (if member('?',name) then "&" else "?")),
	1989	+ (if c_ticket = "" then [ ] else ["c_ticket=",c_ticket]),
	1990	+ (if s_ticket = "" then [ ] else ["&s_ticket=",s_ticket]),
	1991	+ "\">",format(c_ticket,s_ticket,i),"</a>"],
	1992	+
	1993	+ link_for_download(fname,i) then (Printable_tree)
	1994	+ ["<a href=\"",fname,"?download\">",format(c_ticket,s_ticket,i),"</a>"],
	1995	+
	1996	+ mail_to(addr,i) then (Printable_tree)["<a href=\"mailto:",addr,"\">",
	1997	+ format(c_ticket,s_ticket,i),"</a>"],
	1998	+
	1999	+ select(name,size,choices) then (Printable_tree)
	2000	+ ["<select name=\"",name,"\" size=\"",size,"\">",format_choices(choices),"</select>" ],
	2001	+
	2002	+ select(name,size,choices,selected) then (Printable_tree)
	2003	+ ["<select name=\"",name,"\" size=\"",size,"\">",format_choices(choices,selected),"</select>" ],
	2004	+
	2005	+ immediate_select(name,size,choices) then (Printable_tree)
	2006	+ ["<select name=\"",name,"\" size=\"",size,"\" onchange=\"submit();\">",
	2007	+ format_choices(choices),"</select>" ],
	2008	+
	2009	+ radio_button(n,v) then (Printable_tree)
	2010	+ ["<input type=\"radio\" name=\"", n, "\" value=\"", v, "\" />"],
	2011	+
	2012	+ checked_radio_button(n,v) then (Printable_tree)
	2013	+ ["<input type=\"radio\" checked=\"checked\" name=\"", n, "\" value=\"", v, "\" />"],
	2014	+
	2015	+ check_box(n,v) then (Printable_tree)
	2016	+ ["<input type=\"checkbox\" name=\"", n, "\" value=\"", v, "\" />"],
	2017	+
	2018	+ checked_box(n,v) then (Printable_tree)
	2019	+ ["<input type=\"checkbox\" checked=\"checked\" name=\"", n, "\" value=\"", v, "\" />"],
	2020	+
	2021	+ link_to_window(n,i) then (Printable_tree)
	2022	+ ["<a href=\"javascript:void window.open('",n,"','default','resizable,scrollbars');\">",
	2023	+ format(c_ticket,s_ticket,i),"</a>"],
	2024	+
	2025	+ link_to_window(n,wn,i) then (Printable_tree)
	2026	+ ["<a href=\"javascript:void window.open('",n,"','",wn,"','resizable,scrollbars');\" />",
	2027	+ format(c_ticket,s_ticket,i),"</a>"],
	2028	+
	2029	+ link_to_window_with_ticket(n,args,wn,i,w,h) then (Printable_tree)
	2030	+ ["<a href=\"javascript:void window.open('",n,"?c_ticket=",c_ticket,
	2031	+ (if s_ticket = "" then [ ] else ["&s_ticket=",s_ticket]),
	2032	+ "&target=",wn,
	2033	+ if args="" then "" else "&",
	2034	+ args,"','",
	2035	+ wn,"','width=",w,",height=",h,"');\">",
	2036	+ format(c_ticket,s_ticket,i),"</a>"],
	2037	+
	2038	+ link_to_window_with_ticket_and_scroll(n,args,wn,i,w,h) then (Printable_tree)
	2039	+ ["<a href=\"javascript:void window.open('",n,"?c_ticket=",c_ticket,
	2040	+ (if s_ticket = "" then [ ] else ["&s_ticket=",s_ticket]),
	2041	+ "&target=",wn,
	2042	+ if args="" then "" else "&",
	2043	+ args,"','",
	2044	+ wn,"','width=",w,",height=",h,", resizable,scrollbars');\">",
	2045	+ format(c_ticket,s_ticket,i),"</a>"],
	2046	+
	2047	+ link_to_window_with_ticket_and_scroll(n,lab,args,wn,i,w,h) then (Printable_tree)
	2048	+ ["<a href=\"javascript:void window.open('",n,"?c_ticket=",c_ticket,
	2049	+ (if s_ticket = "" then [ ] else ["&s_ticket=",s_ticket]),
	2050	+ "&target=",wn,
	2051	+ if args="" then "" else "&",
	2052	+ args,"&#",lab, "','",
	2053	+ wn,"','width=",w,",height=",h,", resizable,scrollbars');\">",
	2054	+ format(c_ticket,s_ticket,i),"</a>"],
	2055	+
	2056	+ link_to_frame(n,fn,i) then ["<a href=\"",n,
	2057	+ (if member('?',n) then "&" else "?"),
	2058	+ (if c_ticket = "" then [ ] else ["c_ticket=",c_ticket]),
	2059	+ (if s_ticket = "" then [ ] else ["&s_ticket=",s_ticket]),
	2060	+ "\" target=\"",fn,"\">",
	2061	+ format(c_ticket,s_ticket,i),"</a>"]
	2062	+
	2063	+ }.
	2064	+
	2065	+
	2066	+
	2067	+define Printable_tree
	2068	+ add_tickets
	2069	+ (
	2070	+ String c_ticket,
	2071	+ String s_ticket,
	2072	+ String url
	2073	+ ) =
	2074	+ if member('?',url)
	2075	+ then [url , "&c_ticket=", c_ticket, "&s_ticket=", s_ticket ]
	2076	+ else [url , "?c_ticket=", c_ticket, "&s_ticket=", s_ticket ].
	2077	+
	2078	+define Printable_tree
	2079	+ add_tickets
	2080	+ (
	2081	+ String c_ticket,
	2082	+ String s_ticket,
	2083	+ Printable_tree url
	2084	+ ) =
	2085	+ if member('?',url)
	2086	+ then [url , "&c_ticket=", c_ticket, "&s_ticket=", s_ticket ]
	2087	+ else [url , "?c_ticket=", c_ticket, "&s_ticket=", s_ticket ].
	2088	+
	2089	+
	2090	+define Printable_tree
	2091	+ format
	2092	+ (
	2093	+ List(VFrame) frames,
	2094	+ String c_ticket,
	2095	+ String s_ticket
	2096	+ ) =
	2097	+ if frames is
	2098	+ {
	2099	+ [ ] then [ ],
	2100	+ [h . t] then
	2101	+ if h is frame(height,url,name) then
	2102	+ [
	2103	+ "<frame src=\"",add_tickets(c_ticket,s_ticket,url), "\" name=\"",name,"\" frameborder=\"no\" />"
	2104	+ . format(t,c_ticket,s_ticket)]
	2105	+ }.
	2106	+
	2107	+
	2108	+define String
	2109	+ frame_size
	2110	+ (
	2111	+ Int s
	2112	+ ) =
	2113	+ if s =< 0 then "*" else to_decimal(s).
	2114	+
	2115	+define String
	2116	+ frame_stack_rows
	2117	+ (
	2118	+ List(VFrame) frames
	2119	+ ) =
	2120	+ if frames is
	2121	+ {
	2122	+ [ ] then "",
	2123	+ [h . t] then if h is frame (height,url,name) then
	2124	+ frame_size(height)+
	2125	+ if t is
	2126	+ {
	2127	+ [ ] then "",
	2128	+ [_ . _] then ","
	2129	+ }+frame_stack_rows(t)
	2130	+ }.
	2131	+
	2132	+
	2133	+
	2134	+ 'crlf' is defined in 'basis.anubis'.
	2135	+
	2136	+
	2137	+
	2138	+define Printable_tree
	2139	+ standard_headers
	2140	+ (
	2141	+ Int size
	2142	+ ) =
	2143	+ [
	2144	+ "HTTP/1.0 200 OK" + crlf +
	2145	+ "Server: Anubis" + crlf +
	2146	+ "Content-Type: text/html" + crlf +
	2147	+ "Content-Length: "+to_decimal(size)+crlf+
	2148	+ crlf
	2149	+ ].
	2150	+
	2151	+ define Printable_tree
	2152	+ download_headers
	2153	+ =
	2154	+ [
	2155	+ "HTTP/1.0 200 OK" + crlf +
	2156	+ "Content-Type: application/octet-stream" + crlf +
	2157	+ crlf
	2158	+ ].
	2159	+
	2160	+define Printable_tree
	2161	+ apache_headers
	2162	+ =
	2163	+ [
	2164	+ "Content-type: text/html" + crlf +
	2165	+ crlf
	2166	+ ].
	2167	+
	2168	+
	2169	+define String
	2170	+ empty_javascript_source
	2171	+ =
	2172	+ "javascript:'<html><head></head><body></body></html>';".
	2173	+
	2174	+public type HeaderSort:
	2175	+ empty,
	2176	+ anubis,
	2177	+ apache.
	2178	+
	2179	+
	2180	+define Printable_tree
	2181	+ format_keywords
	2182	+ (
	2183	+ List(String) l
	2184	+ ) =
	2185	+ if l is
	2186	+ {
	2187	+ [ ] then [ ],
	2188	+ [h . t] then if t is [ ]
	2189	+ then [h]
	2190	+ else [h , ", " . format_keywords(t)]
	2191	+ }.
	2192	+
	2193	+define Printable_tree
	2194	+ format
	2195	+ (
	2196	+ WebMeta m
	2197	+ ) =
	2198	+ if m is
	2199	+ {
	2200	+ keywords(l) then ["<meta name=\"keywords\" content=\"",format_keywords(l),"\">"],
	2201	+ refresh(url,delay) then ["<meta http-equiv=\"Refresh\" content=\"",delay,"; URL=",url,"\">"],
	2202	+ meta(n,c) then ["<meta name=\"",n,"\" content=\"",c,"\">"],
	2203	+ http_equiv(n,c) then ["<meta http-equiv=\"",n,"\" content=\"",c,"\">"]
	2204	+ }.
	2205	+
	2206	+define Printable_tree
	2207	+ format
	2208	+ (
	2209	+ List(WebMeta) metas
	2210	+ ) =
	2211	+ if metas is
	2212	+ {
	2213	+ [ ] then [ ],
	2214	+ [h . t] then [format(h) . format(t)]
	2215	+ }.
	2216	+
	2217	+
	2218	+
	2219	+
	2220	+
	2221	+
	2222	+public define Printable_tree
	2223	+ format
	2224	+ (
	2225	+ HeaderSort hs,
	2226	+ String c_ticket,
	2227	+ String s_ticket,
	2228	+ Web_page p
	2229	+ ) =
	2230	+ if p is
	2231	+ {
	2232	+ web_page(title,metas,head_scripts,body) then
	2233	+ with fullpage =
	2234	+ [
	2235	+ "<html>",
	2236	+ "<head>",
	2237	+ "<title>", title, "</title>",
	2238	+ format(metas),
	2239	+ head_scripts,
	2240	+ "</head>",
	2241	+ "<body ",
	2242	+ if body is body(options,item) then
	2243	+ with b_options = format(prepare(options)),
	2244	+ [b_options, " onload='body_onloads();",
	2245	+ if *images_to_load is [] then "" else " preload_images();",
	2246	+ "'>",
	2247	+ load_image_script(*images_to_load),
	2248	+ reverse(*scripts),
	2249	+ "<script>",
	2250	+ " function body_onloads() {",
	2251	+ format(*body_onloads),
	2252	+ "}</script>",
	2253	+ format(c_ticket,s_ticket,item)
	2254	+ ],
	2255	+ "</body>",
	2256	+ "</html>"
	2257	+ ],
	2258	+ [
	2259	+ if hs is
	2260	+ {
	2261	+ empty then [ ],
	2262	+ anubis then standard_headers(length(fullpage)),
	2263	+ apache then apache_headers
	2264	+ }
	2265	+ . fullpage
	2266	+ ],
	2267	+ standard_frameset(title,metas,height,width,main) then
	2268	+ with body =
	2269	+ [
	2270	+ "<html>",
	2271	+ "<head>",
	2272	+ "<title>", title, "</title>",
	2273	+ format(metas),
	2274	+ "</head>",
	2275	+ "<frameset frameborder=\"no\" border=\"0\" framespacing=\"0\"",
	2276	+ " marginwidth=\"0\" marginheight=\"0\" cols=\"",width,",\" rows=\"\">",
	2277	+ " <frame src=\"",empty_javascript_source,"\" name=\"left\" frameborder=\"no\"",
	2278	+ " marginwidth=\"0\" marginheight=\"0\" scrolling=\"no\">",
	2279	+ " <frameset frameborder=\"no\" border=\"0\" framespacing=\"0\" rows=\"",height,",\" cols=\"\">",
	2280	+ " <frame src=\"",empty_javascript_source,"\" name=\"top\"",
	2281	+ " marginwidth=\"0\" marginheight=\"0\" frameborder=\"no\" scrolling=\"no\">",
	2282	+ " <frame src =\"", add_tickets(c_ticket,s_ticket,main),
	2283	+ "\" name=\"main\" marginwidth=\"0\" marginheight=\"0\" frameborder=\"no\">",
	2284	+ " </frameset>",
	2285	+ "</frameset>",
	2286	+ "</html>"
	2287	+ ],
	2288	+ [
	2289	+ if hs is
	2290	+ {
	2291	+ empty then [ ],
	2292	+ anubis then standard_headers(length(body)),
	2293	+ apache then apache_headers
	2294	+ }
	2295	+ . body
	2296	+ ]
	2297	+ }.
	2298	+
	2299	+
	2300	+public define Bool
	2301	+ print
	2302	+ (
	2303	+ String c_ticket,
	2304	+ String s_ticket,
	2305	+ Web_page p
	2306	+ ) =
	2307	+ print(format(anubis,c_ticket,s_ticket,p)).
	2308	+
	2309	+public define Bool
	2310	+ print_with_headers
	2311	+ (
	2312	+ HeaderSort hs,
	2313	+ String c_ticket,
	2314	+ String s_ticket,
	2315	+ Web_page p
	2316	+ ) =
	2317	+ print(format(hs,c_ticket,s_ticket,p)).
	2318	+
	2319	+public define Bool
	2320	+ print
	2321	+ (
	2322	+ Web_page p
	2323	+ ) =
	2324	+ print(format(anubis,"","",p)).
	2325	+
	2326	+
	2327	+
	2328	+
	2329	+public define Bool
	2330	+ print_with_headers
	2331	+ (
	2332	+ HeaderSort hs,
	2333	+ Web_page p
	2334	+ ) =
	2335	+ print(format(hs,"","",p)).
	2336	+
	2337	+
	2338	+public define Cell
	2339	+ h_spacer
	2340	+ (
	2341	+ Int n
	2342	+ ) =
	2343	+ cell([absolute_width(n)],text(" ")).
	2344	+
	2345	+public define Cell
	2346	+ v_spacer
	2347	+ (
	2348	+ Int n
	2349	+ ) =
	2350	+ cell([absolute_height(n)],text(" ")).
	2351	+
	2352	+public define Cell
	2353	+ empty = cell([],text(" ")).
	2354	+
	2355	+
	2356	+
	2357	+ *** Below is a simple gadget for counting visitors. It increments a counter (in a file)
	2358	+ at each call. The argument is the name of the file (relative to the directory of the
	2359	+ server), and the file is created automatically. It returns the number of the visitor.
	2360	+
	2361	+public define Int
	2362	+ get_visitor_number
	2363	+ (
	2364	+ String counter_file_name,
	2365	+ ) =
	2366	+ protect
	2367	+ if (RetrieveResult(Int))retrieve(counter_file_name) is
	2368	+ {
	2369	+ cannot_find_file then
	2370	+ //
	2371	+ // It's time to create the file.
	2372	+ //
	2373	+ if save((Int)1,counter_file_name) is
	2374	+ {
	2375	+ cannot_open_file then 0,
	2376	+ write_error then 0,
	2377	+ ok then 1
	2378	+ },
	2379	+ read_error then 0,
	2380	+ type_error then 0,
	2381	+ ok(n) then
	2382	+ //
	2383	+ // Increment the counter
	2384	+ //
	2385	+ if save(n+1,counter_file_name) is
	2386	+ {
	2387	+ cannot_open_file then n,
	2388	+ write_error then n,
	2389	+ ok then n+1
	2390	+ }
	2391	+ }.
	2392	+
	2393	+
	2394	+
	2395	+
...	...

MF_1_1/web/CXM_http_get_common.anubis 0 → 100644

Wrap text Show/Hide comments View file @9ca943b

	1	+
	2	+ Project The Anubis Project
	3	+
	4	+ Title Getting a document from the Web.
	5	+
	6	+ Copyright Copyright (c) Alain Prouté 2001.
	7	+
	8	+
	9	+ Author Alain Prouté
	10	+
	11	+
	12	+
	13	+ This file contains the types and functions which are common to 'http_get' and
	14	+ 'https_get'.
	15	+
	16	+read tools/basis.anubis
	17	+read tools/findstring.anubis
	18	+read system/string.anubis
	19	+read CXM_common.anubis
	20	+ read web/html.anubis
	21	+
	22	+
	23	+
	24	+ Body of HTTP requests may also contain name-value pairs. We call them HTTP arguments:
	25	+
	26	+public type HTTP_argument:
	27	+ http_argument(String name, String value).
	28	+
	29	+
	30	+
	31	+ We begin by several simple tools.
	32	+
	33	+ 'crlf' and 'crlfcrlf' are defined in 'basis.anubis'.
	34	+
	35	+public define Maybe(Int)
	36	+ has_double_crlf
	37	+ (
	38	+ String s,
	39	+ ) =
	40	+ find(crlfcrlf,s,0).
	41	+
	42	+
	43	+
	44	+
	45	+ Formatting a list of HTTP arguments.
	46	+
	47	+public define String
	48	+ format_http_args
	49	+ (
	50	+ List(HTTP_argument) l
	51	+ ) =
	52	+ if l is
	53	+ {
	54	+ [ ] then "",
	55	+ [h . t] then
	56	+ if t is
	57	+ {
	58	+ [ ] then if h is http_argument(n,v) then n + "=" + v,
	59	+ [_._] then if h is http_argument(n,v) then n + "=" + v + "&" + format_http_args(t)
	60	+ }
	61	+ }.
	62	+
	63	+
	64	+
	65	+ Formatting the headers.
	66	+
	67	+public define String
	68	+ format_headers
	69	+ (
	70	+ List(HTTP_header) headers
	71	+ ) =
	72	+ if headers is
	73	+ {
	74	+ [ ] then "",
	75	+ [h . t] then if h is http_header(n,v) then
	76	+ n + ": " + v + crlf + format_headers(t)
	77	+ }.
	78	+
	79	+
	80	+
	81	+
	82	+
	83	+public define String
	84	+ format
	85	+ (
	86	+ DNS_Result r
	87	+ ) =
	88	+ if r is
	89	+ {
	90	+ host_not_found then "host not found",
	91	+ no_address_found then "no address found for this host",
	92	+ try_again then "DNS server is busy, try again later",
	93	+ non_recoverable_error then "non recoverable DNS error",
	94	+ ok(n) then alert // should never happen
	95	+ }.
	96	+
	97	+
	98	+public define String
	99	+ format
	100	+ (
	101	+ NetworkConnectError e
	102	+ ) =
	103	+ if e is
	104	+ {
	105	+ cannot_create_the_socket then "cannot create the socket",
	106	+ address_port_not_available then "address:port not available",
	107	+ connection_refused then "connection refused",
	108	+ network_unreachable then "network is unreachable",
	109	+ address_port_already_in_use then "address:port already in use",
	110	+ out_of_time then "out of time"
	111	+ }.
	112	+
	113	+public define String
	114	+ format
	115	+ (
	116	+ SSLConnectError e
	117	+ ) =
	118	+ if e is
	119	+ {
	120	+ tcp_error(nce) then format(nce),
	121	+ cannot_create_SSL_object then "cannot create SSL object",
	122	+ cannot_connect_under_SSL then "cannot connect under SSL",
	123	+ cannot_trust_server_certificate then "cannot trust server certificate"
	124	+ }.
	125	+
	126	+
	127	+
	128	+ The next function empties the standard input (the keybord normally).
	129	+
	130	+define One
	131	+ empty_stdin
	132	+ (
	133	+ One dummy
	134	+ ) =
	135	+ if *stdin is
	136	+ {
	137	+ failure then unique,
	138	+ success(c) then
	139	+ if c = 10
	140	+ then unique
	141	+ else empty_stdin(dummy)
	142	+ }.
	143	+
	144	+
	145	+ The next function returns true if the user answers Y or y.
	146	+
	147	+public define Bool
	148	+ yes
	149	+ =
	150	+ if *stdin is
	151	+ {
	152	+ failure then alert, // this can never happen, because stdin is never closed
	153	+ success(c) then
	154	+ empty_stdin(unique);
	155	+ (c = 'Y' \| c = 'y')
	156	+ }.
	157	+
	158	+
	159	+
	160	+ Separating the server name from the port.
	161	+
	162	+public define (String,Word32)
	163	+ separate_name_port
	164	+ (
	165	+ String server_name,
	166	+ Word32 default_port
	167	+ ) =
	168	+ if find(":",server_name,0) is
	169	+ {
	170	+ failure then (server_name,default_port),
	171	+ success(n) then
	172	+ (substr(server_name,0,n),
	173	+ if decimal_scan(substr(server_name,n+1,length(server_name)-n-1)) is
	174	+ {
	175	+ failure then default_port,
	176	+ success(p) then truncate_to_Word32(p)
	177	+ })
	178	+ }.
	179	+
	180	+
	181	+
	182	+
	183	+
	184	+ Separating the headers. The headers are comming in the form of a unique string. They
	185	+ should be put in the form of a list of pairs of strings (one list element per header).
	186	+
	187	+ We do that in two steps. (1) separate the headers into a list of strings (one per
	188	+ header), and (2) separate each string into a pair of strings (name,value).
	189	+
	190	+
	191	+define HTTP_header
	192	+ separate_header
	193	+ (
	194	+ String header,
	195	+ Int i
	196	+ ) =
	197	+ if nth(i,header) is
	198	+ {
	199	+ failure then http_header(header,""),
	200	+ success(c) then
	201	+ if c = ':' // separator
	202	+ then http_header(substr(header,0,i),substr(header,i+1,length(header)-i-1))
	203	+ else separate_header(header,i+1)
	204	+ }.
	205	+
	206	+
	207	+ Headers are separated from each other by CRLF not followed by a blank character.
	208	+
	209	+define List(HTTP_header)
	210	+ separate_headers
	211	+ (
	212	+ String headers,
	213	+ Int start,
	214	+ ) =
	215	+ if find("\r\n",headers,start) is
	216	+ {
	217	+ failure then [separate_header(substr(headers,start,length(headers)-start),0)],
	218	+ success(end) then
	219	+ [separate_header(substr(headers,start,end-start),0) . separate_headers(headers,end+2)]
	220	+ }.
	221	+
	222	+public define List(HTTP_header)
	223	+ separate_headers
	224	+ (
	225	+ String headers,
	226	+ ) =
	227	+ separate_headers(headers,0).
	228	+
	229	+
	230	+public define One
	231	+ print_headers
	232	+ (
	233	+ List(HTTP_header) headers
	234	+ ) =
	235	+ if headers is
	236	+ {
	237	+ [ ] then unique,
	238	+ [h . t] then
	239	+ if h is http_header(l,r) then
	240	+ print(" "); print(l); print(": "); print(r); print("\n"); print_headers(t)
	241	+ }.
	242	+
	243	+
	244	+public define Word8
	245	+ force_nth
	246	+ (
	247	+ Int n,
	248	+ String s
	249	+ ) =
	250	+ if nth(n,s) is
	251	+ {
	252	+ failure then 0,
	253	+ success(c) then c
	254	+ }.
	255	+
	256	+
	257	+public define List(HTTP_header)
	258	+ get_headers
	259	+ (
	260	+ List(String) args
	261	+ ) =
	262	+ if args is
	263	+ {
	264	+ [ ] then [ ],
	265	+ [h . t] then if nth(0,h) is
	266	+ {
	267	+ failure then alert,
	268	+ success(c) then if c = '='
	269	+ then if t is
	270	+ {
	271	+ [ ] then [http_header(substr(h,1,length(h)-1),"")],
	272	+ [u . v] then [http_header(substr(h,1,length(h)-1),u) . get_headers(v)]
	273	+ }
	274	+ else get_headers(t)
	275	+ }
	276	+ }.
	277	+
	278	+public define List(HTTP_argument)
	279	+ get_arguments
	280	+ (
	281	+ List(String) args
	282	+ ) =
	283	+ if args is
	284	+ {
	285	+ [ ] then [ ],
	286	+ [h . t] then if nth(0,h) is
	287	+ {
	288	+ failure then alert,
	289	+ success(c) then if c = '='
	290	+ then if t is
	291	+ {
	292	+ [ ] then [ ],
	293	+ [u . v] then get_arguments(v)
	294	+ }
	295	+ else if c = '-'
	296	+ then get_arguments(t)
	297	+ else if t is
	298	+ {
	299	+ [ ] then [http_argument(h,"")],
	300	+ [u . v] then [http_argument(h,u) . get_arguments(v)]
	301	+ }
	302	+ }
	303	+ }.
	304	+
	305	+
...	...

MF_1_1/web/CXM_making_a_web_site.anubis 0 → 100644

Wrap text Show/Hide comments View file @9ca943b

	1	+
	2	+
	3	+ Project Anubis
	4	+
	5	+ Title Making interactive Web sites.
	6	+
	7	+ Copyright Copyright (c) Alain Prouté 2004-2005.
	8	+ Copyright (c) Calexium 2007.
	9	+
	10	+
	11	+ Authors Alain Prouté
	12	+ David René
	13	+
	14	+ Revised May 2007
	15	+
	16	+
	17	+ Overview
	18	+
	19	+ In this file we propose simple tools for making well structured interactive and secured
	20	+ web sites.
	21	+
	22	+
	23	+ ----------------------------------- Table of Contents ---------------------------------
	24	+
	25	+ * (1) Structure of a web site.
	26	+ ** (1.1) Three sorts of data.
	27	+ ** (1.2) How requests are handled.
	28	+ ** (1.3) What web pages are made of.
	29	+ ** (1.4) Actions.
	30	+ ** (1.5) States.
	31	+
	32	+ * (2) Carrying on.
	33	+ ** (2.1) Describing your web sites.
	34	+ ** (2.2) Directories on the server's disk.
	35	+ ** (2.3) Starting your web sites.
	36	+
	37	+ * (3) The HTML interface.
	38	+ ** (3.1) Types used by the HTML interface.
	39	+ ** (3.2) ``in form'' versus ``off form''.
	40	+ ** (3.3) Defining your own style.
	41	+ ** (3.4) Actioners and forms.
	42	+ ** (3.5) Local popup.
	43	+
	44	+ ---------------------------------------------------------------------------------------
	45	+
	46	+
	47	+read tools/basis.anubis
	48	+read system/string.anubis
	49	+read system/logger.anubis
	50	+read CXM_common.anubis
	51	+read CXM_multihost_http_server.anubis
	52	+read CXM_mime.anubis
	53	+
	54	+
	55	+
	56	+ * (1) Structure of a web site.
	57	+
	58	+ First of all we need to explain what a web site should be made of. Ideally, the
	59	+ visitor (also called the 'client') should see the web site working as any other
	60	+ interactive computer software. So, it should be clear that a 'session' (i.e. a visit
	61	+ to the web site, including the consultation of several pages) is some kind of
	62	+ conversation between the visitor and the web site, and that the web site should
	63	+ maintain a 'current state' of this conversation. At each new request (click) from the
	64	+ visitor, this state must be updated. This whole conversation is called a 'session' and
	65	+ should not be confused with a single request.
	66	+
	67	+
	68	+
	69	+ ** (1.1) Three sorts of data.
	70	+
	71	+ All the data needed for putting a web site at work may be dispatched into three
	72	+ categories:
	73	+
	74	+ 1. Constant data (data that never change). These data may be hard coded into the
	75	+ Anubis source files of the web site.
	76	+
	77	+ 2. Permanent data (data which always exist independantly of the users connected to
	78	+ the web site). These data are normally recorded into data bases.
	79	+
	80	+ 3. Session data (data which depend on a particular visitor and which exist only
	81	+ during the time he visits the web site). These data are stored into so-called
	82	+ 'states'.
	83	+
	84	+
	85	+ It is important to determine which data belongs to which category. This is part of your
	86	+ design decisions.
	87	+
	88	+
	89	+
	90	+ ** (1.2) How requests are handled.
	91	+
	92	+ We want to separate the following two functionalities (which are used at each request
	93	+ (click) during a single session):
	94	+
	95	+ - computing the new state from the previous state and from the client request, and
	96	+ updating the data base,
	97	+
	98	+ - computing the page to be sent to the client from the new current state and from
	99	+ the informations in the data base.
	100	+
	101	+
	102	+ The next picture shows the structure we have in mind:
	103	+
	104	+
	105	+ request +---------+ HTML page (with a hidden state name)
	106	+ .-------------------\| client \|<--------------.
	107	+ \| .-----------------\| \| \|
	108	+ \| \| previous state +---------+ \|
	109	+ \| \| name (if any) \|
	110	+ \| \| \| client side
	111	+ ............................................................................
	112	+ \| \| \| server side
	113	+ \| \| \|
	114	+ \| \| .-------------------. \|
	115	+ \| \| \| previous state \| \|
	116	+ V V V \| \|
	117	+ +---------------+ +---------------+ +--------------+
	118	+ \| compute state \| \| server's disk \| \| compute page \|
	119	+ +---------------+ +---------------+ +--------------+
	120	+ ^ \| \| ^ ^ ^ ^ ^
	121	+ \| \| \| \| \| \| \| \|
	122	+ \| \| `--------------------+--------------------' \| \|
	123	+ \| \| new state \| \| \|
	124	+ read \| `------------------------+--------------------' \|
	125	+ write \| new state name \|
	126	+ update V \|
	127	+ +-----------+ \|
	128	+ \| data base \|--------------------------------------------'
	129	+ +-----------+ read only
	130	+
	131	+
	132	+ When the client begins a session, there is no previous state. In this case, a default
	133	+ 'initial state' is used instead.
	134	+
	135	+ The data base may be updated by 'compute state' box, but should not be update by the
	136	+ 'compute page' box. The 'compute page' box should be allowed only to read the data
	137	+ base.
	138	+
	139	+ In this file, all the above stuff is defined, except the 'compute state' and 'compute
	140	+ page' boxes. You just have to provide the function for computing a new state (compute
	141	+ state) and the function for computing the page (compute page) from the new state. You
	142	+ don't have to worry about state names, saving and retrieving states and the like.
	143	+
	144	+
	145	+
	146	+
	147	+
	148	+ ** (1.3) What web pages are made of.
	149	+
	150	+ What the client can see in his browser's window may be called a 'page'. Within a page,
	151	+ we have several sorts of components:
	152	+
	153	+ - 'local' components, i.e. all components which do not open a connection, like
	154	+ texts, images, etc... possibly using JavaScript programmation,
	155	+
	156	+ - 'actioners', which, when clicked upon, open a connection with our web site; they
	157	+ may appear as links or buttons, etc...
	158	+
	159	+ - 'foreign links', which when clicked upon, open a connection with another web site
	160	+ (or ours eventually).
	161	+
	162	+ Of course, what an actioner does is just ask our web site to perform an action. To that
	163	+ end, the actioner essentially sends the name of the action to be performed. However, it
	164	+ may be necessary to provide additional informations which may be seen as 'operands' of
	165	+ the action. In order to attach operands to an action, HTML provides the notion of
	166	+ 'form'. Indeed, a form contains essentially a set of input fields into which the client
	167	+ may put values for the required operands of the action, and a submit button, which is
	168	+ the actioner itself. Notice that a single form may contain several submit buttons,
	169	+ which simply means that there are several distincts actions taking the same set of
	170	+ operands.
	171	+
	172	+ Restrictions must be put on the use of all theses gadgets. Indeed, for example,
	173	+ putting a form within another form is officially meaningless in HTML, and the client's
	174	+ browser may be seriously disturbed by this. In this file, we propose an interface to
	175	+ the HTML language, which forbids such meaningless things, simply by imposing a strict
	176	+ typing of HTML concepts.
	177	+
	178	+ Each web site may be accessible through two communication channels:
	179	+
	180	+ - a non secured channel (HTTP),
	181	+ - a secured channel (HTTPS).
	182	+
	183	+ Nevertheless, the whole thing should be considered as a single web site. For example,
	184	+ you may have a secured page, obtained through HTTPS, containing public images obtained
	185	+ through HTTP. An actioner in a non secured page may open a secured connection, and
	186	+ conversely.
	187	+
	188	+ Summarizing, a web page is made of local elements, foreign links and actioners.
	189	+ Actioners receive operands from forms, and they also choose to communicate through the
	190	+ non secured or through the secured channel.
	191	+
	192	+
	193	+
	194	+ +-------------------+
	195	+ \| page \|
	196	+ \| \| +---------------+
	197	+ \| +--------------+ \| \| next page \|
	198	+ \| \| form \| \| \| (non secured) \|
	199	+ \| \| +----------+ \| \| HTTP \| \|
	200	+ \| \| \| actioner \|---------------------------->\| \|
	201	+ \| \| +----------+ \| \| +---------------+
	202	+ \| \| \| \|
	203	+ \| \| +----------+ \| \| +---------------+
	204	+ \| \| \| actioner \|---------------------------->\| next page \|
	205	+ \| \| +----------+ \| \| HTTPS \| (secured) \|
	206	+ \| \| \| \| \| \|
	207	+ \| +--------------+ \| \| \|
	208	+ \| \| +---------------+
	209	+ \| \|
	210	+ +-------------------+
	211	+
	212	+
	213	+ Notice that actioners need no be necessarily put into forms. In that case, they work as
	214	+ ordinary links, but they still may receive operands as we shall see.
	215	+
	216	+
	217	+
	218	+
	219	+ ** (1.4) Actions.
	220	+
	221	+ The client opens a new connection with our web site whenever he clicks on an
	222	+ actioner. The result is that a request is sent, essentially made of a list of 'web
	223	+ arguments'. Each web argument is a pair (name,value). One of these web arguments, the
	224	+ 'action' web argument (whose name is "a"), determines the action to be performed. The
	225	+ other web arguments (not including "s", used to identify the state) are the operands
	226	+ for this action.
	227	+
	228	+ Hence, the 'compute state' box in the picture above, splits naturally into as many
	229	+ sub-boxes as there are actions. For this reason, we define the following type for
	230	+ representing actions (where '$State' is the type representing session informations):
	231	+
	232	+public type Web_Action($SessionTicket, $State):
	233	+ http_action (String name, // name of action
	234	+ (Maybe($State)) -> Bool allow, // true if action allowed
	235	+ (HTTP_Info http_info,
	236	+ List(Web_arg) web_args, // actually only 'operands' web arguments
	237	+ Maybe($State) state) -> (Maybe($SessionTicket), Maybe($State), List(HTTP_header)) do_it),
	238	+ https_action (String name, // name of action
	239	+ (Maybe($State)) -> Bool allow, // true if action allowed
	240	+ (HTTP_Info http_info,
	241	+ List(Web_arg) web_args, // actually only 'operands' web arguments
	242	+ Maybe($State) state) -> (Maybe($SessionTicket), Maybe($State), List(HTTP_header)) do_it),
	243	+ http_https_action (String name,
	244	+ (Maybe($State)) -> Bool allow, // true if action allowed
	245	+ (HTTP_Info http_info,
	246	+ List(Web_arg) web_args,
	247	+ Maybe($State) state) -> (Maybe($SessionTicket), Maybe($State), List(HTTP_header)) do_it).
	248	+
	249	+ 'http_action's are executed only under HTTP, and 'https_action's are executed only
	250	+ under HTTPS. 'http_https_action's may be executed under both types of connections.
	251	+
	252	+ Each action has a name, which is used to identify the action. Each action also has a
	253	+ function 'allow' whose job is to verify that the action is allowed in the current
	254	+ state, and a function 'do_it' for performing the action. The function 'do_it' receives
	255	+ a lot of informations:
	256	+
	257	+ - 'HTTP informations':
	258	+ - the IP address of the client,
	259	+ - the URI requested by the client (after redirection),
	260	+ - the list of HTTP headers generated by the client's browser,
	261	+ - the list of web arguments sent by the client (except "s" and "a"),
	262	+ - the previous state (or the 'initial' or 'ticket expired' state if no previous
	263	+ state can be found).
	264	+
	265	+ In most cases, HTTP informations are not used. This is the reason why they are gathered
	266	+ for simplicity into a unique datum of type 'HTTP_Info'.
	267	+
	268	+// For your convenience, we introduce the following simpler variants:
	269	+//
	270	+//public define Web_Action($State)
	271	+// http_action
	272	+// (
	273	+// String name,
	274	+// $State -> Bool allow,
	275	+// (List(Web_arg),$State) -> $State do_it
	276	+// ) =
	277	+// http_action(name,
	278	+// (Maybe($State) ms) \|-> if ms is
	279	+// {
	280	+// failure then true,
	281	+// success(s) then allow(s)
	282	+// },
	283	+// (HTTP_Info h, List(Web_arg) l, Maybe($State) s) \|-> if s is
	284	+// {
	285	+// failure then (failure, []),
	286	+// success(s2) then (success(do_it(l,s2)), [])
	287	+// }).
	288	+//
	289	+//public define Web_Action($State)
	290	+// https_action
	291	+// (
	292	+// String name,
	293	+// $State -> Bool allow,
	294	+// (List(Web_arg),$State) -> $State do_it
	295	+// ) =
	296	+// https_action(name,
	297	+// (Maybe($State) ms) \|-> if ms is
	298	+// {
	299	+// failure then true,
	300	+// success(s) then allow(s)
	301	+// },
	302	+// (HTTP_Info h, List(Web_arg) l, Maybe($State) s) \|-> if s is
	303	+// {
	304	+// failure then (failure, []),
	305	+// success(s2) then (success(do_it(l,s2)), [])
	306	+// }).
	307	+//
	308	+//public define Web_Action($State)
	309	+// http_https_action
	310	+// (
	311	+// String name,
	312	+// $State -> Bool allow,
	313	+// (List(Web_arg),$State) -> $State do_it
	314	+// ) =
	315	+// http_https_action(name,
	316	+// (Maybe($State) ms) \|-> if ms is
	317	+// {
	318	+// failure then true,
	319	+// success(s) then allow(s)
	320	+// },
	321	+// (HTTP_Info h, List(Web_arg) l, Maybe($State) s) \|-> if s is
	322	+// {
	323	+// failure then (failure, []),
	324	+// success(s2) then (success(do_it(l,s2)), [])
	325	+// }).
	326	+
	327	+
	328	+
	329	+ When you define your web site, you must provide the list of all the actions of the
	330	+ site. When a new state has been computed, a graphical representation of this state
	331	+ must be sent to the client. To that end, you must provide a function (named below
	332	+ 'compute_page') of type:
	333	+
	334	+ $State -> HTTP_Answer
	335	+
	336	+ where the type 'HTTP_Answer' (defined below in this file) abstractly represents HTML
	337	+ pages.
	338	+
	339	+public type HTTP_Answer:...
	340	+
	341	+ It should be clear that states and pages are deeply linked together. Indeed, we really
	342	+ understand the page shown to the client as a representation of the current state of the
	343	+ conversation between the client and the web site, but also containing informations
	344	+ taken from the data bases.
	345	+
	346	+
	347	+
	348	+
	349	+
	350	+ ** (1.5) States.
	351	+
	352	+ Now, we explain how you can define the type (say 'State') to be used as an instance of
	353	+ the type parameter '$State'. The following is just a suggestion.
	354	+
	355	+ Each state determines a page (since 'compute_page' computes a page from a
	356	+ state). However, some components of the state may be independant of the page. It may be
	357	+ the case for example for the indication of the natural language used by the
	358	+ client. Hence, a state should be made of (at least) two parts:
	359	+
	360	+ - informations which are the same for all pages,
	361	+ - informations which are particular to each page.
	362	+
	363	+ For example, you could define:
	364	+
	365	+ type Page: // one alternative per page, with particular informations
	366	+ login(...), // in the components
	367	+ main_page(...),
	368	+ ...etc...
	369	+
	370	+ Now, the type 'State' could be defined as follows:
	371	+
	372	+ type State:
	373	+ state(Language, // informations valid for all pages
	374	+ ...,
	375	+ Page). // informations particular to a page
	376	+
	377	+ However, if you are making a secured web site within which clients should be identified
	378	+ (by id and password), it may be a good idea to have two sorts of states, one for non
	379	+ identified clients and one for identified clients. In this case, define the type
	380	+ 'State' as follows (this is just a suggestion):
	381	+
	382	+ type State:
	383	+ non_identified(Language),
	384	+ identified(String id,
	385	+ Language,
	386	+ Page).
	387	+
	388	+ When a request arrives, check if the previous state is 'identified(...)' or
	389	+ 'non_identified(...)', and don't provide access to certain pages to non identified
	390	+ clients. This is required for security.
	391	+
	392	+ Some more words on security. If your site needs to identify clients, define the
	393	+ initial state as 'non_identified(...)'. Construct a 'login' page, and check the id and
	394	+ password of the client. If the id and password are correct, then change the state of
	395	+ the client to 'identified(...)'. No other action should be able to do that. Now, be
	396	+ confident that clients cannot forge states. The only information they have is the name
	397	+ of a state, not the state itself which is never sent over the network, but only stored
	398	+ on the server's disk. The name of the state is constructed using strong cryptographical
	399	+ methods (sha1). If everything (since the 'login' page) is performed under HTTPS, even
	400	+ state names cannot be seen by a third party. So, if the system retrieves a previous
	401	+ state of the form 'identified(...)', you can be confident that your client is well
	402	+ identified, and you can send him confidential informations.
	403	+
	404	+ States have a limited life time. It may happen that a client clicks on a button at a
	405	+ time its state is out of date. In this case, this system considers that the new state
	406	+ is a special state named 'ticket expired'. You must provide a function producing this
	407	+ state when you describe your web site. The page corresponding to this state must just
	408	+ inform the client that he/she waited a too long time before clicking on a button, and
	409	+ has to restart (a new conversation) from the begining.
	410	+
	411	+
	412	+
	413	+ * (2) Carrying on.
	414	+
	415	+ ** (2.1) Describing your web sites.
	416	+
	417	+ Before you may start your web site, you must describe it, i.e. produce a datum of the
	418	+ opaque type 'Web_Site'.
	419	+
	420	+public type Web_Site:...
	421	+
	422	+ Producing such a datum may be performed by:
	423	+
	424	+public define Web_Site
	425	+ make_web_site_description
	426	+ (
	427	+ List(String) common_names, // for example: ["www.our-business.com",
	428	+ // "192.168.0.1"]
	429	+ // the second one is just for testing
	430	+ String site_directory, // where 'public' and other directories are
	431	+ // located (should NOT end with '/')
	432	+ One -> One init,
	433	+ (HTTP_Info) -> (Maybe($SessionTicket), Maybe($State), List(HTTP_header)) initial_state,
	434	+ ($State expired,
	435	+ HTTP_Info,
	436	+ List(Web_arg),
	437	+ Bool is_https) -> (Maybe($SessionTicket), Maybe($State), List(HTTP_header)) ticket_expired_state,
	438	+ (HTTP_Info,
	439	+ List(Web_arg),
	440	+ Bool is_https) -> (Maybe($SessionTicket), Maybe($State), List(HTTP_header)) ticket_lost_state,
	441	+ List(Web_Action($SessionTicket, $State)) actions,
	442	+ (Maybe($SessionTicket), Maybe($State), List(Web_arg) lwa) -> HTTP_Answer compute_page,
	443	+ Int timeout, // seconds (todo: minutes)
	444	+ List(Redirection) redirections,
	445	+ String charset,
	446	+ List(String) journal_extensions,
	447	+ List(String) journal_headers,
	448	+ String authorization_secret,
	449	+ List(MIME) known_mime_types,
	450	+ (String action_name,
	451	+ List(Web_arg) args)-> One before_send_file
	452	+ ).
	453	+
	454	+
	455	+ Explanations:
	456	+
	457	+ 'common_names' is the list of names of the site (the name the browser must send as the
	458	+ value of the 'Host' HTTP header in order to access the site must be in that list). Such
	459	+ a name generally looks like this:
	460	+
	461	+ www.somewhere.com
	462	+
	463	+ If you are using HTTPS, you also have an 'X.509 SSL server certificate'. The name of
	464	+ the site must be exactly the same as the name on the certificate (which is precisely
	465	+ called the 'common name' in the X.509 jargon). If the two names do not match, the site
	466	+ will still work, but the transaction will not be transparent to the client. His browser
	467	+ will complain that the name of the certificate does not match the name of the site, and
	468	+ he will have to accept the certificate manually.
	469	+
	470	+ 'site_directory' is the absolute path to the directory where the files needed by the
	471	+ site are located. Usually this directory looks like:
	472	+
	473	+ my_anubis/web_sites/www.somewhere.com
	474	+
	475	+ However, this information is not computed from 'common_name', so that you can change
	476	+ the common name (for example temporarily, for networking reasons) without loosing
	477	+ access to the files.
	478	+
	479	+ 'ticket_expired_state(expired_state,http_info,lwa,is_https)' must produce the state
	480	+ whose graphical representation is a page explaining to the user that its 'ticket' (or
	481	+ 'session information') has expired, and that he/she must close all popup windows and
	482	+ start a new session. The arguments of the function contain the previous (expired)
	483	+ state and all current informations concerning the user. This arguments may be useful
	484	+ for example for producing the expiration message in the language chosen by the user.
	485	+ You can also (and this may be much smarter) send a 'ticket prolongation page'
	486	+ (including a new login for example), and resume the same conversation, since you have
	487	+ all the pertinent informations at hand. In the case the ticket is definitely lost, the
	488	+ second fonction 'ticket_lost_state' is used.
	489	+
	490	+ Notice that despite the fact that the parameter $State is involved in the arguments of
	491	+ the above function, the type 'Web_Site' does not depend on this parameter. This allows
	492	+ to produce lists of web site descriptions, where each description may be constructed
	493	+ with a different instance of $State. This is required because distinct sites must have
	494	+ distinct types of session informations. This is made possible by the fact that the
	495	+ type is obscure, and the constructor replaced by a function which assembles
	496	+ 'ticket_expired_state', ticket_lost_state', 'actions' and 'compute_page' into a single
	497	+ entity not depending on $State. You should have a look to the private part of this file
	498	+ if you want more precisions about this programming technique.
	499	+
	500	+ 'charset' is a string which will determine the character encoding to be used by the
	501	+ browser. Typically, this string is one of: "UTF-8", "ISO-8859-1", "Windows-1252",
	502	+ etc...
	503	+
	504	+ 'before_send_file' is a function which is executed just before the HTTP server sends a
	505	+ file. It gets an action name and the web arguments received with the request for that
	506	+ file. Notice that this action name and these web arguments may be put into a
	507	+ 'private_download' element, and will come back to the server at the time of the
	508	+ download.
	509	+
	510	+
	511	+
	512	+ ** (2.2) Directories on the server's disk.
	513	+
	514	+ The description of you site contains the name of the directory within which the
	515	+ required files are located. This may be for example:
	516	+
	517	+ my_anubis/web_sites/www.our-business.com/
	518	+
	519	+ This is called the 'site directory' (for the given site). Within the site directory,
	520	+ the following directories are created by this program:
	521	+
	522	+ states
	523	+ public
	524	+ journal
	525	+ private_download
	526	+ upload_temporary
	527	+
	528	+ The directory 'states' is used for storing states (session informations). Out of date
	529	+ states are automatically removed after some time.
	530	+
	531	+ The tree rooted at 'public' contains files that the server is allowed to send to the
	532	+ clients. For security reasons, the server never sends a file which is not within the
	533	+ tree whose root is this 'public' directory (except for the 'private download' mecanism;
	534	+ see 'web/multihost_http_server.anubis'). Also, the MIME type (see 'web/mime.anubis')
	535	+ must have been recognized before the file may be sent.
	536	+
	537	+ The directory 'journal' contains the jounal files. The roles of the remaining
	538	+ directories 'private_download' and 'upload_temporary' is explained in
	539	+ 'multihost_http_server.anubis', where you will also find further informations on
	540	+ 'public' and 'journal'.
	541	+
	542	+
	543	+
	544	+
	545	+ ** (2.3) Web servers parameters.
	546	+
	547	+ The web servers have several parameters useful for administration. They are described
	548	+ as follows:
	549	+
	550	+ public type WebServersParameters:
	551	+ wsparms(Var(Bool) shutdown_required,
	552	+
	553	+
	554	+
	555	+
	556	+ ** (2.4) Starting your web sites.
	557	+
	558	+ When you have described all your web sites (you may want to have several web sites, and
	559	+ they are distinguished by their 'common name'), you may start them all together using
	560	+ 'start_web_sites' below. This function returns a result of the following type:
	561	+
	562	+public type Start_Web_Sites_Result:
	563	+ cannot_bind_to_port(Word32),
	564	+ cannot_bind_to_port(Word32,Word32),
	565	+ ok(Server http_server,
	566	+ Server https_server).
	567	+
	568	+ Indeed, it may happen that the system cannot bind (begin to listen) to one of the two
	569	+ ports (or to both). The main reason is that another server is already listening on that
	570	+ port. Another reason may be that 'anbexec' has not been correctly installed, i.e. that
	571	+ the 's' bit has not been set for 'user' and 'group' (there is not such problem under
	572	+ Windows). Also notice that the Linux kernel may need a rather long time (up to several
	573	+ minutes) before liberating a listening port. Now, if the system can bind to the two
	574	+ ports, the pair of the two servers is returned. Two tools are useful for manipulating
	575	+ servers:
	576	+
	577	+ shutdown of type Server -> One
	578	+ is_down of type Server -> Bool
	579	+
	580	+ They are defined in 'predefined.anubis' (together with the type 'Server').
	581	+
	582	+
	583	+public define Start_Web_Sites_Result
	584	+ start_web_sites
	585	+ (
	586	+ Word32 ip_address, // the IP address shared by the web sites
	587	+ Word32 http_port, // usually: 80
	588	+ Word32 https_port, // usually: 443
	589	+ String ssl_certificate_common_name,
	590	+ List(Web_Site) web_sites, // web sites to be started
	591	+ Var(Bool) shutdown_required
	592	+ ).
	593	+
	594	+ 'ip_address' is the IP address on which the two servers listen. If you put 0, the
	595	+ servers listen on all the IP addresses of the machine. This may be useful if the
	596	+ machine has several network interfaces.
	597	+
	598	+ 'ssl_certificate_common_name' is the common name of the SSL certificate that 'anbexec'
	599	+ loads when it starts. One instance of 'anbexec' cannot handle more than one SSL server
	600	+ certificate. This is due to a problem of conception of SSL itself. See the book 'SSL
	601	+ and TLS' by Eric Rescorla (at Addison Wesley) for more explanations.
	602	+
	603	+ Notice that the number of servers is always 2, regardless of the number of web sites
	604	+ you are starting.
	605	+
	606	+ The dynamic variable 'shutdown_required' may be used to control the shutdown of the two
	607	+ servers from within the web site (typically the administration part). The servers will
	608	+ shutdown as soon as this variable contains 'true'. So you must provide a variable
	609	+ containing 'false' otherwise your servers will not run. You may also use the primitive
	610	+ 'must_restart' (see 'predefined.anubis') to control the restarting of your servers.
	611	+
	612	+
	613	+
	614	+
	615	+
	616	+
	617	+ * (3) The HTML interface.
	618	+
	619	+ We propose an interface to dynamic HTML. Dynamic HTML includes HTML, and a combination
	620	+ of CSS (Cascading Style Sheet) and JavaScript techniques for making HTML elements more
	621	+ reactive and attractive on the client side.
	622	+
	623	+
	624	+ ** (3.1) Types used by the HTML interface.
	625	+
	626	+ For easy reference, we gather below the definitions of all the types used by the HTML
	627	+ interface, and we comment them immediately.
	628	+
	629	+
	630	+public type HTML_Size:
	631	+ absolute(Int), // in pixels
	632	+ percentage(Int).
	633	+
	634	+
	635	+public type Text_Option:
	636	+ size(Int), // size of character font to use
	637	+ font(String), // name of character font to use (such as "helvetica",...)
	638	+ color(RGB), // color to be used for characters
	639	+ italic,
	640	+ oblique,
	641	+ small_capitals,
	642	+ bold,
	643	+ underlined,
	644	+ left_justified,
	645	+ right_justified,
	646	+ justified, // justified on both sides
	647	+ line_through,
	648	+ nowrap,
	649	+ class(String), //CSS class
	650	+ id(String),
	651	+ style(String),
	652	+ title(String).
	653	+
	654	+public define Text_Option
	655	+ tooltip(String s) = title(s).
	656	+
	657	+ A list of 'Text_Option' must be given with each text you want to put in your page.
	658	+
	659	+ This indicate the way of reading text.
	660	+public type Reading_Way:
	661	+ ltr, //the text is readable from "Left To Right" like english
	662	+ rtl. //the text is readable from "Right To Left" like arabic
	663	+
	664	+
	665	+// Following types are define to prohib any arguments order error
	666	+
	667	+/**
	668	+ * String value for 'id' attribut
	669	+ */
	670	+public type HtmlId:
	671	+ htmlId(String id).
	672	+
	673	+/**
	674	+ * String value for 'class' attribut
	675	+ */
	676	+public type HtmlClass:
	677	+ htmlClass(String class).
	678	+
	679	+/**
	680	+ * Name used in arguments list when form is submitted.
	681	+ */
	682	+public type WebArgName:
	683	+ wan(String name).
	684	+
	685	+/**
	686	+ * Value passed to arguments list when form is submitted (for RadioButton and CheckBox).
	687	+ */
	688	+public type WebArgValue:
	689	+ wav(String value).
	690	+
	691	+/**
	692	+ * Initial value of an input field.
	693	+ */
	694	+public type InitialValue:
	695	+ init(String value).
	696	+
	697	+public define Printable_tree [HtmlId x . Printable_tree y] = str_pt(x.id, y).
	698	+public define Printable_tree [HtmlClass x . Printable_tree y] = str_pt(x.class, y).
	699	+public define Printable_tree [WebArgName x . Printable_tree y] = str_pt(x.name, y).
	700	+public define Printable_tree [WebArgValue x . Printable_tree y] = str_pt(x.value, y).
	701	+public define Printable_tree [InitialValue x . Printable_tree y] = str_pt(x.value, y).
	702	+
	703	+
	704	+public type HtmlEvents:
	705	+ // Form element events
	706	+ onchange,
	707	+ onsubmit,
	708	+ onreset,
	709	+ onselect,
	710	+ onblur,
	711	+ onfocus,
	712	+ // Keyboard events (Not valid in base, bdo, br, frame, frameset, head, html, iframe, meta, param, script, style, and title elements.)
	713	+ onkeydown,
	714	+ onkeypress,
	715	+ onkeyup,
	716	+ // Mouse events (Not valid in base, bdo, br, frame, frameset, head, html, iframe, meta, param, script, style, and title elements.)
	717	+ onclick,
	718	+ ondblclick,
	719	+ onmousedown,
	720	+ onmousemove,
	721	+ onmouseout,
	722	+ onmouseover,
	723	+ onmouseup.
	724	+
	725	+public type CoreAttrs:
	726	+ id (String),
	727	+ class (String),
	728	+ style (String),
	729	+ title (String),
	730	+ lang (String),
	731	+ dir (Reading_Way),
	732	+ accesskey (Word8),
	733	+ tabindex (Int),
	734	+ attr (String, String),
	735	+ event (HtmlEvents, String).
	736	+
	737	+public type InputAttrs:
	738	+ class (String),
	739	+ style (String),
	740	+ title (String),
	741	+ lang (String),
	742	+ dir (Reading_Way),
	743	+ accesskey (Word8),
	744	+ tabindex (Int),
	745	+ attr (String, String),
	746	+ event (HtmlEvents, String).
	747	+
	748	+public define CoreAttrs
	749	+ tooltip(String s) = title(s).
	750	+public define InputAttrs
	751	+ tooltip(String s) = title(s).
	752	+
	753	+public type I18n:
	754	+ lang (String),
	755	+ dir (Reading_Way).
	756	+
	757	+//public type DIV_Option:
	758	+// id (String),
	759	+// class (String),
	760	+// style (String),
	761	+// tooltip (String),
	762	+// lang (String),
	763	+// dir (Reading_Way),
	764	+// attr (String, String),
	765	+// event (HtmlEvents, String).
	766	+//
	767	+
	768	+ A list of 'DIV_Option' must be given with each DIV you want to put in your page.
	769	+
	770	+define String event_name
	771	+ (
	772	+ HtmlEvents e
	773	+ ) =
	774	+ if e is
	775	+ {
	776	+ // Form element events
	777	+ onchange then "onchange",
	778	+ onsubmit then "onsubmit",
	779	+ onreset then "onreset",
	780	+ onselect then "onselect",
	781	+ onblur then "onblur",
	782	+ onfocus then "onfocus",
	783	+ // Keyboard events
	784	+ onkeydown then "onkeydown",
	785	+ onkeypress then "onkeypress",
	786	+ onkeyup then "onkeyup",
	787	+ // Mouse events
	788	+ onclick then "onclick",
	789	+ ondblclick then "ondblclick",
	790	+ onmousedown then "onmousedown",
	791	+ onmousemove then "onmousemove",
	792	+ onmouseout then "onmouseout",
	793	+ onmouseover then "onmouseover",
	794	+ onmouseup then "onmouseup"
	795	+ }.
	796	+
	797	+public type Table_Option:
	798	+ background_color(RGB), // applied to all cells in the table
	799	+ background_image(String url),
	800	+ border(Int width_of_outer_edge, // if not present, all values are 0
	801	+ Int width_of_top_of_relief,
	802	+ Int width_of_inner_edge,
	803	+ RGB border_color),
	804	+ width(Int), // sets a minimal width for the table
	805	+ percentage_width(Int).
	806	+
	807	+
	808	+public define Table_Option nude = border(0,0,0,rgb(0,0,0)).
	809	+
	810	+
	811	+ A list of 'Table_Option' must be given with each table.
	812	+
	813	+
	814	+public type BackgroundOption:
	815	+ repeat, // repeat the background in both directions
	816	+ repeat_horizontal, // repeat the background only horizontally
	817	+ repeat_vertical, // repeat the background only verticall
	818	+ no_repeat, // don't repeat the background
	819	+ center.
	820	+
	821	+
	822	+public type Cell_Option:
	823	+ core_attrs(List(CoreAttrs)),
	824	+ left, // put the content of the cell on the left
	825	+ h_center, // center the content of the cell horizontally
	826	+ right, // put the content of the cell on the right
	827	+ top, // put the content of the cell upwards
	828	+ v_center, // center the content of tye cell vertically,
	829	+ bottom, // put the content of the cell downwards
	830	+ base_line, // align the content vertically according to base lines
	831	+ background_color(RGB),
	832	+ background_image(String url, BackgroundOption),
	833	+ width(Int), // sets a minimal width for the cell
	834	+ percentage_width(Int),
	835	+ height(Int), // sets a minimal height for the cell
	836	+ columns(Int), // lets the cell span over several columns
	837	+ rows(Int), // lets the cell span over several rows
	838	+ nowrap. // do not allow text wrapping within the cell
	839	+
	840	+ A list of 'Cell_Option' must be given with each cell and each row in a table. Options
	841	+ given with a row apply to all the cells in the row, but are superseded by options given
	842	+ with cells, which apply only to the cell they are given with.
	843	+
	844	+
	845	+public type HTML_Cell($T):
	846	+ cell(List(Cell_Option) options, $T content).
	847	+
	848	+public type HTML_Header_Cell($T):
	849	+ header_cell(List(Cell_Option) options, $T content).
	850	+
	851	+ The parameter $T is later instantiated either to 'HTML_In_Form' or to 'HTML_Off_Form',
	852	+ depending on where you put your table (within a form or not within a form). For your
	853	+ convenience, we define the following particular case:
	854	+
	855	+public define HTML_Cell($T)
	856	+ cell
	857	+ (
	858	+ $T content
	859	+ ) =
	860	+ cell([],content).
	861	+
	862	+public define HTML_Header_Cell($T)
	863	+ header_cell
	864	+ (
	865	+ $T content
	866	+ ) =
	867	+ header_cell([],content).
	868	+
	869	+
	870	+public type HTML_Row($T):
	871	+ row(List(Cell_Option) options, List(HTML_Cell($T)) cells).
	872	+
	873	+public type HTML_Header_Row($T):
	874	+ empty,
	875	+ header_row(List(Cell_Option) options, List(HTML_Header_Cell($T)) cells).
	876	+
	877	+public type HTML_Footer_Row($T):
	878	+ empty,
	879	+ footer_row(List(Cell_Option) options, List(HTML_Cell($T)) cells).
	880	+
	881	+ Same remark as for 'HTML_Cell($T)'. We define several convenience functions:
	882	+
	883	+public define HTML_Row($T)
	884	+ row
	885	+ (
	886	+ List(HTML_Cell($T)) cells
	887	+ ) =
	888	+ row([],cells).
	889	+
	890	+public define HTML_Row($T)
	891	+ row
	892	+ (
	893	+ HTML_Cell($T) cell
	894	+ ) =
	895	+ row([],[cell]).
	896	+
	897	+public define HTML_Header_Row($T)
	898	+ header_row
	899	+ (
	900	+ List(HTML_Header_Cell($T)) cells
	901	+ ) =
	902	+ header_row([],cells).
	903	+
	904	+public define HTML_Header_Row($T)
	905	+ header_row
	906	+ (
	907	+ HTML_Header_Cell($T) cell
	908	+ ) =
	909	+ header_row([],[cell]).
	910	+
	911	+public type Actioner_Connection:
	912	+ same, // use same type of connection as current page
	913	+ http, // use non secured connection
	914	+ https. // use secured connection
	915	+
	916	+public type Other_Window_Option:
	917	+ resizable, // the new window may be resized by the client
	918	+ scrollbars, // the new window has scrollbars
	919	+ width(Int), // the new window has the specified width
	920	+ height(Int). // the new window has the specified height
	921	+
	922	+public type Actioner_Target:
	923	+ same,
	924	+ same (String label),
	925	+ other(String window_name, List(Other_Window_Option)).
	926	+
	927	+public type Actioner_Aspect:
	928	+ link (List(Text_Option), String text, Maybe(String) name),// hypertext link
	929	+ img_link (String img_url, String alt_text),
	930	+ push_button (List(CoreAttrs),String text),
	931	+ button (String url_off, String url_on), // rollover button
	932	+ button (String url_off, String url_on, Int w, Int h), // idem with size
	933	+ submit (List(CoreAttrs),String text),
	934	+ immediate_selector (List(CoreAttrs),WebArgName name, Int size, List((WebArgValue,String)) choices),
	935	+ immediate_selector (List(CoreAttrs),WebArgName name, Int size, List((WebArgValue,String)) choices, InitialValue selected).
	936	+
	937	+
	938	+
	939	+public type Actioner_Local_Action:
	940	+ close_window.
	941	+
	942	+
	943	+public define Actioner_Aspect
	944	+ link
	945	+ (
	946	+ List(Text_Option) options,
	947	+ String text
	948	+ ) =
	949	+ link(options, text, failure).
	950	+
	951	+public define Actioner_Aspect
	952	+ link
	953	+ (
	954	+ String text
	955	+ ) =
	956	+ link([], text, failure).
	957	+
	958	+
	959	+public define Actioner_Aspect
	960	+ link
	961	+ (
	962	+ List(Text_Option) options,
	963	+ Int i
	964	+ ) =
	965	+ link(options,to_decimal(i), failure).
	966	+
	967	+public define Actioner_Aspect
	968	+ link
	969	+ (
	970	+ Int i
	971	+ ) =
	972	+ link([], i).
	973	+
	974	+public define Actioner_Aspect
	975	+ button
	976	+ (
	977	+ String url_img
	978	+ ) =
	979	+ button(url_img,url_img).
	980	+
	981	+ Actioners are explained in details below.
	982	+
	983	+
	984	+public type TextAreaOption:
	985	+ input_attrs(List(InputAttrs)),
	986	+ disabled,
	987	+ read_only,
	988	+ wrap_lines.
	989	+
	990	+public type HTML_In_Form:
	991	+ literal_pt (Printable_tree),
	992	+ literal (String),
	993	+ sequence (List(HTML_In_Form) items),
	994	+ text (List(Text_Option), String the_text),
	995	+ preformated (List(Text_Option), String),
	996	+ paragraph (List(Text_Option), HTML_In_Form content),
	997	+ image (List(CoreAttrs), String url, String alternate),
	998	+ image (List(CoreAttrs), String url, String alternate, Int width, Int height),
	999	+ table (List(Table_Option), HTML_Header_Row(HTML_In_Form), List(HTML_Row(HTML_In_Form)), HTML_Footer_Row(HTML_In_Form)),
	1000	+ center (HTML_In_Form),
	1001	+ mail_to (String email, HTML_In_Form element),
	1002	+ scroller (Int width, Int height,
	1003	+ Int content_width, Int content_height,
	1004	+ HTML_In_Form content),
	1005	+ actioner (Actioner_Connection, Actioner_Target, Actioner_Aspect,
	1006	+ String action_name, List((String,String)) extra_ops,
	1007	+ List(Actioner_Local_Action)),
	1008	+ foreign_link_new (Actioner_Target, Actioner_Aspect, String url),
	1009	+ foreign_link (List(Text_Option), String url),
	1010	+ foreign_link (List(Text_Option), String url, String name),
	1011	+ private_download (String abs_path, String name, String extra_ext,
	1012	+ Maybe((String,List((String,String)))) action),
	1013	+ text_input (List(InputAttrs), String label_text, HtmlId id, WebArgName name, InitialValue init, Int width),
	1014	+ text_input_ro (List(InputAttrs), String label_text, HtmlId id, WebArgName name, InitialValue init, Int width),
	1015	+ password_input (List(InputAttrs), String label_text, HtmlId id, WebArgName name, InitialValue init, Int width),
	1016	+ text_area (List(TextAreaOption), String label_text, HtmlId id, WebArgName name, InitialValue init, Int width, Int height),
	1017	+ file_upload (List(InputAttrs), String label, HtmlId id, WebArgName name, Int width),
	1018	+ selector (List(InputAttrs), String label_text, HtmlId id, WebArgName name, Int size, List(String) choices),
	1019	+ selector (List(InputAttrs), String label_text, HtmlId id, WebArgName name, Int size, List(String) choices, InitialValue selected),
	1020	+ // List((String,String)) = List((code,name)) where :
	1021	+ // code is the web-arg value
	1022	+ // name appears in selector
	1023	+ selector_c (List(InputAttrs), String label_text, HtmlId id, WebArgName name, Int size, List((WebArgValue,String)) choices),
	1024	+ selector_c (List(InputAttrs), String label_text, HtmlId id, WebArgName name, Int size, List((WebArgValue,String)) choices, InitialValue selected),
	1025	+ radio_button (List(InputAttrs), String label_text, HtmlId id, WebArgName name, WebArgValue value, Bool checked),
	1026	+ radio_button_r (List(InputAttrs), String label_text, HtmlId id, WebArgName name, WebArgValue value, Bool checked),
	1027	+ check_box (List(InputAttrs), String label_text, HtmlId id, WebArgName name, WebArgValue value, Bool checked),
	1028	+ check_box_r (List(InputAttrs), String label_text, HtmlId id, WebArgName name, WebArgValue value, Bool checked),
	1029	+ div (List(CoreAttrs), HTML_In_Form content),
	1030	+ div_empty (List(CoreAttrs)),
	1031	+ hidden (WebArgName name, InitialValue init).
	1032	+
	1033	+
	1034	+ 'HTML_In_Form' defines all the elements you may put within a form. We define a
	1035	+ convenience function:
	1036	+
	1037	+public define HTML_In_Form literal(Printable_tree t) = literal_pt(t).
	1038	+
	1039	+public define HTML_In_Form image(String url) = image([], url, url).
	1040	+
	1041	+public define HTML_In_Form image(String url, Int width, Int height) = image([], url, url, width, height).
	1042	+
	1043	+public define HTML_In_Form
	1044	+ foreign_link
	1045	+ (
	1046	+ Int tsize,
	1047	+ String url,
	1048	+ String name
	1049	+ ) =
	1050	+ foreign_link([size(tsize)],url,name).
	1051	+
	1052	+public define HTML_In_Form
	1053	+ actioner
	1054	+ (
	1055	+ Actioner_Connection conn,
	1056	+ Actioner_Target targ,
	1057	+ Actioner_Aspect asp,
	1058	+ String action_name,
	1059	+ List((String,String)) extra_ops
	1060	+ ) =
	1061	+ actioner(conn,targ,asp,action_name,extra_ops,[]).
	1062	+
	1063	+public define HTML_In_Form
	1064	+ actioner
	1065	+ (
	1066	+ Actioner_Connection conn,
	1067	+ Actioner_Target targ,
	1068	+ Actioner_Aspect asp,
	1069	+ ) =
	1070	+ actioner(conn, targ, asp, "", [], []).
	1071	+
	1072	+
	1073	+public define HTML_In_Form
	1074	+ text_area
	1075	+ (
	1076	+ WebArgName name,
	1077	+ InitialValue init,
	1078	+ Int width,
	1079	+ Int height
	1080	+ ) =
	1081	+ text_area([], "", htmlId(""), name,init,width,height).
	1082	+
	1083	+public define HTML_In_Form
	1084	+ text_area
	1085	+ (
	1086	+ List(TextAreaOption) options,
	1087	+ WebArgName name,
	1088	+ InitialValue init,
	1089	+ Int width,
	1090	+ Int height
	1091	+ ) =
	1092	+ text_area(options, "", htmlId(""), name,init,width,height).
	1093	+
	1094	+public define HTML_In_Form
	1095	+ table
	1096	+ (
	1097	+ List(HTML_Row(HTML_In_Form)) rows
	1098	+ ) =
	1099	+ table([],empty,rows,empty).
	1100	+
	1101	+public define HTML_In_Form
	1102	+ table
	1103	+ (
	1104	+ List(Table_Option) options,
	1105	+ List(HTML_Row(HTML_In_Form)) rows
	1106	+ ) =
	1107	+ table(options,empty,rows,empty).
	1108	+
	1109	+public define HTML_In_Form
	1110	+ table
	1111	+ (
	1112	+ HTML_Header_Row(HTML_In_Form) h_row,
	1113	+ List(HTML_Row(HTML_In_Form)) rows
	1114	+ ) =
	1115	+ table([],h_row,rows,empty).
	1116	+
	1117	+public define HTML_In_Form
	1118	+ table
	1119	+ (
	1120	+ List(Table_Option) options,
	1121	+ HTML_Header_Row(HTML_In_Form) h_row,
	1122	+ List(HTML_Row(HTML_In_Form)) rows
	1123	+ ) =
	1124	+ table(options,h_row,rows,empty).
	1125	+
	1126	+public define HTML_In_Form
	1127	+ private_download
	1128	+ (
	1129	+ String abs_path,
	1130	+ String name,
	1131	+ String extra_ext
	1132	+ ) =
	1133	+ private_download(abs_path,name,extra_ext,failure).
	1134	+
	1135	+public define HTML_In_Form
	1136	+ private_download
	1137	+ (
	1138	+ String abs_path,
	1139	+ String name,
	1140	+ String extra_ext,
	1141	+ String action_name,
	1142	+ List((String,String)) args
	1143	+ ) =
	1144	+ private_download(abs_path,name,extra_ext,success((action_name,args))).
	1145	+
	1146	+public define HTML_In_Form
	1147	+ text
	1148	+ (
	1149	+ String s
	1150	+ ) =
	1151	+ text([],s).
	1152	+
	1153	+public define HTML_In_Form
	1154	+ radio_button (List(InputAttrs) options, String label_text, WebArgName n, WebArgValue value, Bool checked)
	1155	+ = radio_button (options, label_text, htmlId(n.name), n, value, checked).
	1156	+
	1157	+public define HTML_In_Form
	1158	+ radio_button_r (List(InputAttrs) options, String label_text, WebArgName n, WebArgValue value, Bool checked)
	1159	+ = radio_button_r (options, label_text, htmlId(n.name), n, value, checked).
	1160	+
	1161	+public define HTML_In_Form
	1162	+ check_box (List(InputAttrs) options, String label_text, WebArgName n, WebArgValue value, Bool checked)
	1163	+ = check_box (options, label_text, htmlId(n.name), n, value, checked).
	1164	+
	1165	+public define HTML_In_Form
	1166	+ check_box_r (List(InputAttrs) options, String label_text, WebArgName n, WebArgValue value, Bool checked)
	1167	+ = check_box_r (options, label_text, htmlId(n.name), n, value, checked).
	1168	+
	1169	+public define HTML_In_Form
	1170	+ file_upload (WebArgName name, Int width)
	1171	+ = file_upload([], "", htmlId(""), name, width).
	1172	+
	1173	+
	1174	+public type HTML_Off_Form:
	1175	+ literal_pt (Printable_tree),
	1176	+ literal (String),
	1177	+ sequence (List(HTML_Off_Form) items),
	1178	+ text (List(Text_Option), String the_text),
	1179	+ preformated (List(Text_Option), String),
	1180	+ paragraph (List(Text_Option), HTML_Off_Form content),
	1181	+ image (List(CoreAttrs), String url, String alternate),
	1182	+ image (List(CoreAttrs), String url, String alternate, Int width, Int height),
	1183	+ table (List(Table_Option), HTML_Header_Row(HTML_Off_Form), List(HTML_Row(HTML_Off_Form)), HTML_Footer_Row(HTML_Off_Form)),
	1184	+ center (HTML_Off_Form),
	1185	+ mail_to (String email, HTML_Off_Form element),
	1186	+ scroller (Int width, Int height,
	1187	+ Int content_width, Int content_height,
	1188	+ HTML_Off_Form content),
	1189	+ fixed_size (HTML_Size width, HTML_Size height, HTML_Off_Form content),
	1190	+ fixed_size_2 (HTML_Size width, HTML_Size height, String name_of_HTML_file),
	1191	+ actioner (Actioner_Connection, Actioner_Target, Actioner_Aspect,
	1192	+ String action_name, List((String,String)) extra_ops,
	1193	+ List(Actioner_Local_Action)),
	1194	+ actioner (Actioner_Connection, Actioner_Target, Actioner_Aspect,
	1195	+ String action_name, List((String,String)) extra_ops,
	1196	+ List(Actioner_Local_Action), String form_name),
	1197	+ foreign_link_new (Actioner_Target, Actioner_Aspect, String url),
	1198	+ foreign_link (List(Text_Option), String url),
	1199	+ foreign_link (List(Text_Option), String url, String name),
	1200	+ private_download (String abs_path, String name, String extra_ext,
	1201	+ Maybe((String,List((String,String)))) action),
	1202	+ label (String name),
	1203	+ form (HtmlId form_id, List(CoreAttrs), HTML_In_Form content),
	1204	+ form (HtmlId form_id, List(CoreAttrs),
	1205	+ String action_name, List((String,String)) extra_ops,
	1206	+ HTML_In_Form content),
	1207	+ div (List(CoreAttrs), HTML_Off_Form content),
	1208	+ div_empty (List(CoreAttrs)).
	1209	+
	1210	+ 'HTML_Off_Form' defines all the elements you may put outside any form.
	1211	+
	1212	+
	1213	+public define HTML_Off_Form image(String url) = image([], url, url).
	1214	+
	1215	+public define HTML_Off_Form image(String url, Int width, Int height) = image([], url, url, width, height).
	1216	+
	1217	+public define HTML_Off_Form
	1218	+ form
	1219	+ (
	1220	+ String form_name,
	1221	+ List(CoreAttrs) options,
	1222	+ HTML_In_Form content
	1223	+ ) =
	1224	+ form(htmlId(form_name), options, content).
	1225	+
	1226	+public define HTML_Off_Form
	1227	+ form
	1228	+ (
	1229	+ String form_name,
	1230	+ List(CoreAttrs) options,
	1231	+ String action_name,
	1232	+ List((String,String)) extra_ops,
	1233	+ HTML_In_Form content
	1234	+ ) =
	1235	+ form(htmlId(form_name), options, action_name, extra_ops, content).
	1236	+
	1237	+
	1238	+public define HTML_Off_Form literal(Printable_tree t) = literal_pt(t).
	1239	+public define HTML_Off_Form fixed_size(HTML_Size width, HTML_Size height, String name_of_HTML_file)
	1240	+ = fixed_size_2(width,height,name_of_HTML_file).
	1241	+
	1242	+
	1243	+public define HTML_Off_Form
	1244	+ foreign_link
	1245	+ (
	1246	+ Int tsize,
	1247	+ String url,
	1248	+ String name
	1249	+ ) =
	1250	+ foreign_link([size(tsize)],url,name).
	1251	+
	1252	+
	1253	+public define HTML_Off_Form
	1254	+ actioner
	1255	+ (
	1256	+ Actioner_Connection conn,
	1257	+ Actioner_Target targ,
	1258	+ Actioner_Aspect asp,
	1259	+ String action_name,
	1260	+ List((String,String)) extra_ops
	1261	+ ) =
	1262	+ actioner(conn,targ,asp,action_name,extra_ops,[]).
	1263	+
	1264	+public define HTML_Off_Form
	1265	+ table
	1266	+ (
	1267	+ List(HTML_Row(HTML_Off_Form)) rows
	1268	+ ) =
	1269	+ table([],empty,rows,empty).
	1270	+
	1271	+public define HTML_Off_Form
	1272	+ table
	1273	+ (
	1274	+ List(Table_Option) options,
	1275	+ List(HTML_Row(HTML_Off_Form)) rows
	1276	+ ) =
	1277	+ table(options,empty,rows,empty).
	1278	+
	1279	+public define HTML_Off_Form
	1280	+ table
	1281	+ (
	1282	+ HTML_Header_Row(HTML_Off_Form) h_row,
	1283	+ List(HTML_Row(HTML_Off_Form)) rows
	1284	+ ) =
	1285	+ table([],h_row,rows,empty).
	1286	+
	1287	+public define HTML_Off_Form
	1288	+ table
	1289	+ (
	1290	+ List(Table_Option) options,
	1291	+ HTML_Header_Row(HTML_Off_Form) h_row,
	1292	+ List(HTML_Row(HTML_Off_Form)) rows
	1293	+ ) =
	1294	+ table(options,h_row,rows,empty).
	1295	+
	1296	+ We add two convenience functions for 'row'. The reason why we add two functions, one
	1297	+ for 'HTML_In_Form' and one for 'HTML_Off_Form', is that adding a schema with an
	1298	+ arbitrary '$T' creates too many ambiguities. This is due to the fact that, if we do so,
	1299	+ the arguments of the function do not refer to any of the types defined here.
	1300	+
	1301	+public define HTML_Row(HTML_In_Form)
	1302	+ row
	1303	+ (
	1304	+ HTML_In_Form content
	1305	+ ) =
	1306	+ row([],[cell([],content)]).
	1307	+
	1308	+public define HTML_Row(HTML_Off_Form)
	1309	+ row
	1310	+ (
	1311	+ HTML_Off_Form content
	1312	+ ) =
	1313	+ row([],[cell([],content)]).
	1314	+
	1315	+
	1316	+public define HTML_Off_Form
	1317	+ private_download
	1318	+ (
	1319	+ String abs_path,
	1320	+ String name,
	1321	+ String extra_ext
	1322	+ ) =
	1323	+ private_download(abs_path,name,extra_ext,failure).
	1324	+
	1325	+
	1326	+public define HTML_Off_Form
	1327	+ private_download
	1328	+ (
	1329	+ String abs_path,
	1330	+ String name,
	1331	+ String extra_ext,
	1332	+ String action_name,
	1333	+ List((String,String)) args
	1334	+ ) =
	1335	+ private_download(abs_path,name,extra_ext,success((action_name,args))).
	1336	+
	1337	+public define HTML_Off_Form
	1338	+ text
	1339	+ (
	1340	+ List(Text_Option) lto,
	1341	+ Int i
	1342	+ ) =
	1343	+ text(lto,to_decimal(i)).
	1344	+
	1345	+
	1346	+public define HTML_Off_Form
	1347	+ text
	1348	+ (
	1349	+ Int i
	1350	+ ) =
	1351	+ text([],i).
	1352	+
	1353	+public define HTML_Off_Form
	1354	+ text
	1355	+ (
	1356	+ String s
	1357	+ ) =
	1358	+ text([],s).
	1359	+
	1360	+ - Cell a gap between two other cells :
	1361	+
	1362	+public define HTML_Cell(HTML_Off_Form)
	1363	+ width_gap
	1364	+ (
	1365	+ Int w
	1366	+ ) =
	1367	+ cell([width(w)],text([],"")).
	1368	+
	1369	+public define HTML_Cell(HTML_In_Form)
	1370	+ width_gap
	1371	+ (
	1372	+ Int w
	1373	+ ) =
	1374	+ cell([width(w)],text([],"")).
	1375	+
	1376	+
	1377	+ - Row a gap between two other rows :
	1378	+
	1379	+public define HTML_Row(HTML_Off_Form)
	1380	+ height_gap
	1381	+ (
	1382	+ Int h
	1383	+ ) =
	1384	+ row([],[cell([height(h)],text([],""))]).
	1385	+
	1386	+public define HTML_Row(HTML_In_Form)
	1387	+ height_gap
	1388	+ (
	1389	+ Int h
	1390	+ ) =
	1391	+ row([],[cell([height(h)],text([],""))]).
	1392	+
	1393	+
	1394	+ Notice that the two types have alternatives in common (same name, same arguments types,
	1395	+ up to the value of the parameter $T), which correspond to elements which may be put
	1396	+ anywhere in the page.
	1397	+
	1398	+
	1399	+
	1400	+public type CSS_Style:
	1401	+ text_options(List(Text_Option)).
	1402	+
	1403	+public type CSS_File:
	1404	+ css_file(String file_name).
	1405	+
	1406	+public type JS_Attribute:
	1407	+ attr (String, String).
	1408	+
	1409	+public type JS_File:
	1410	+ js_file(String file_name,
	1411	+ List(JS_Attribute) attributes).
	1412	+
	1413	+public define JS_File
	1414	+ js_file
	1415	+ (
	1416	+ String file_name
	1417	+ ) =
	1418	+ js_file(file_name, []).
	1419	+
	1420	+define String
	1421	+ format
	1422	+ (
	1423	+ List(Text_Option) l
	1424	+ ).
	1425	+
	1426	+
	1427	+
	1428	+
	1429	+define Printable_tree
	1430	+ format_css_styles
	1431	+ (
	1432	+ List(CSS_Style) l
	1433	+ ) =
	1434	+ if l is
	1435	+ {
	1436	+ [ ] then [ ],
	1437	+ [h . t] then
	1438	+ [ if h is
	1439	+ {
	1440	+ text_options(tos) then
	1441	+ [" body, span, p { ", format(tos), " }\n" ]
	1442	+ }
	1443	+ . format_css_styles(t)]
	1444	+ }.
	1445	+
	1446	+
	1447	+
	1448	+public type HTML_Meta:
	1449	+ keywords (List(String)),
	1450	+ refresh (Actioner_Connection connection,
	1451	+ Actioner_Target target,
	1452	+ String action_name,
	1453	+ Int delay), // in seconds
	1454	+ refresh (String url, Int delay), // in seconds
	1455	+ meta (String name, String content),
	1456	+ http_equiv (String name, String content),
	1457	+ generic_meta (List((String,String))),
	1458	+ literal (String).
	1459	+
	1460	+ Meta tags are put in the 'head' of the HTML page.
	1461	+
	1462	+
	1463	+public type Body_Option:
	1464	+ core_attrs(List(CoreAttrs)),
	1465	+ background_color (RGB),
	1466	+ background_image (String url),
	1467	+ background_image (String url, List(BackgroundOption)).
	1468	+
	1469	+public type HTML_Body:
	1470	+ body(List(Body_Option) options, HTML_Off_Form content).
	1471	+
	1472	+
	1473	+public type HTTP_Answer:
	1474	+ html_page(String title,
	1475	+ List(HTML_Meta) meta_tags,
	1476	+ List(CSS_Style) styles,
	1477	+ List(CSS_File) css_files,
	1478	+ List(JS_File) js_files,
	1479	+ HTML_Body body),
	1480	+ plain_text (String text),
	1481	+ custom_text(String mime_type,
	1482	+ String content),
	1483	+ custom_binary(String mime_type,
	1484	+ ByteArray content),
	1485	+ custom_tree(String mime_type,
	1486	+ Printable_tree content),
	1487	+ http_raw(Printable_tree).
	1488	+
	1489	+public define HTTP_Answer
	1490	+ html_page
	1491	+ (
	1492	+ String title,
	1493	+ List(HTML_Meta) metas,
	1494	+ HTML_Body body
	1495	+ ) =
	1496	+ html_page(title,metas,[],[],[],body).
	1497	+
	1498	+public define HTTP_Answer
	1499	+ html_page
	1500	+ (
	1501	+ String title,
	1502	+ List(HTML_Meta) metas,
	1503	+ List(CSS_Style) styles,
	1504	+ HTML_Body body
	1505	+ ) =
	1506	+ html_page(title, metas, styles, [], [], body).
	1507	+
	1508	+ 'HTTP_Answer' represents the final product of the construction of a web page.
	1509	+
	1510	+
	1511	+
	1512	+
	1513	+ *** (3.2) ``in form'' versus ``off form''.
	1514	+
	1515	+ There is a variety of HTML elements: texts, buttons, links, forms, inputs, etc... Some
	1516	+ of them may have a content, which is yet another HTML element (or several). Hence, it
	1517	+ is meaningful to say that an element is 'within' another one. Now, putting any element
	1518	+ within any other one may be meaningless. For example, an input element must be put
	1519	+ within a form (otherwise, it is useless), and a from within another form has no precise
	1520	+ meaning (and is forbidden by the HTML specification).
	1521	+
	1522	+ Actually, the main criterium is ``within a form or not within a form''. So, HTML
	1523	+ elements in a given page are separated into two categories: those who are within a
	1524	+ form, and the others. Nevertheless, there are elements which may belong to both
	1525	+ categories, like images and texts. We want to make use of the strong typing mecanism of
	1526	+ Anubis in order to forbid non meaningful placement of elements.
	1527	+
	1528	+ The type 'HTML_In_Form' defines elements to be put within forms. Similarly,
	1529	+ 'HTML_Off_Form' defines elements not to be put within forms. Both types are recursive,
	1530	+ and 'HTML_Off_Form' refers to 'HTML_In_Form' (via the 'form' alternative, of course),
	1531	+ but the two types are not cross recursive. This is the reason why it is impossible to
	1532	+ put a form within a form. In order to construct a web page, you essentially have to
	1533	+ produce a datum of type 'HTML_Off_Form' (maybe containing data of type 'HTML_In_Form').
	1534	+
	1535	+ In practice, you don't have to worry so much about these two types, because elements
	1536	+ which may be put anywhere are constructed for both types by functions with the same
	1537	+ name and the same arguments. Hence, for both types, you just write the same thing. You
	1538	+ are warned by the compiler only when you try to put an element at a place it is not
	1539	+ allowed.
	1540	+
	1541	+
	1542	+
	1543	+ *** (3.3) Defining your own style.
	1544	+
	1545	+ We provide generic tools for constructing HTML elements. However, your web site needs
	1546	+ to have a ``style''.
	1547	+
	1548	+ To that end, you need to write down a set of ``styling functions'', using the tools
	1549	+ defined here. These styling functions allow the introduction of your colors and other
	1550	+ visual characteristics into the constructed elements once and for all. For example, you
	1551	+ may want all your texts to be rendered in the ``Helvetica'' font, in size 14 and using
	1552	+ some 'text_color'. You may write something like this:
	1553	+
	1554	+ define RGB text_color = rgb(10,40,40).
	1555	+
	1556	+ define HTML_Off_Form
	1557	+ text
	1558	+ (
	1559	+ String the_text
	1560	+ ) =
	1561	+ text([font("helvetica"),size(14),color(text_color)],
	1562	+ the_text).
	1563	+
	1564	+ (and the same one for type 'HTML_In_Form') so that in order to put a piece of text in a
	1565	+ page, you just write:
	1566	+
	1567	+ text("... some text ...")
	1568	+
	1569	+ and you don't have to provide the font, size and color for each text. If you want to
	1570	+ have several styles of text presentation, you just write several sets of such
	1571	+ convenience functions. This also suggests a trick. You may want for example different
	1572	+ colors for 'in form' texts and 'off form' texts. This may be achieved automatically by
	1573	+ defining two functions as above, with the same name and same argument type, but
	1574	+ returning either a 'HTML_In_Form' or a 'HTML_Off_Form'.
	1575	+
	1576	+ If this preliminary work is well done, you will not waste your time later when you
	1577	+ concentrate on the actual informational content of your pages.
	1578	+
	1579	+ This general principle should be applied to all sorts of elements. This is the best
	1580	+ thing to do in order to separate the functions defining the visual style from the
	1581	+ functions defining the informational content itself, so that changing the style without
	1582	+ changing the content becomes easy. This is also the best way for having a clean and
	1583	+ easily readable source for your web site.
	1584	+
	1585	+
	1586	+
	1587	+
	1588	+
	1589	+ *** (3.4) Actioners and forms.
	1590	+
	1591	+ We have gathered several notions from HTML into that of an 'actioner'. An actioner is
	1592	+ an HTML element which opens a connection to our server when clicked upon. Actioners may
	1593	+ have different visual aspects. They may look like hypertext links or like buttons
	1594	+ (rollovers), or even like selectors (with immediate action). In any case, their
	1595	+ behavior is the same: they open a connection to our server, and send a set of 'web
	1596	+ arguments', i.e. pairs 'name=value'. Among these web arguments, one of them denotes
	1597	+ the action to be performed, and the others should be considered as operands for this
	1598	+ action. Actually, the precise behavior of the actioner has several variants.
	1599	+
	1600	+ The connection with the server may be secured (HTTPS) or non secured (HTTP). See the
	1601	+ type 'Actioner_Connection' above.
	1602	+
	1603	+ You must also choose where the answer must be rendered. This may be in the same window
	1604	+ or in another window (or frame). If it is in another window, the name of that window
	1605	+ must be given. If the window does not exist, the browser will create it. Optionally,
	1606	+ you may give the dimensions of the new window and other characteristics. See the type
	1607	+ 'Actioner_Target' above.
	1608	+
	1609	+ The actioner also has a visual aspect. See the type 'Actioner_Aspect' above. In the
	1610	+ case of a rollover button, you provide the URLs of two images (of the same size)
	1611	+ representing the button:
	1612	+
	1613	+ url_off: to be used when the mouse is not over the button,
	1614	+ url_on: to be used when the mouse is over the button.
	1615	+
	1616	+ You can also create rollover buttons without creating images. Just use the second
	1617	+ alternative named 'button'. The server creates the images automatically.
	1618	+
	1619	+ The purpose of forms is just to give operands to actioners. If the actioner is placed
	1620	+ within a form, all the input elements which are within this form provide operands to
	1621	+ the actioner (except sometimes when they are not set by the client). If it is not put
	1622	+ within a form, the actioner gets no operand, except if the name of a form is explicitly
	1623	+ given, in which case the actioner gets all the inputs from that form as
	1624	+ operands. Furthermore, you may want to give extra operands to the actioner. This may be
	1625	+ useful for separating families of actioners with the same action name. Extra operands
	1626	+ 'name=value' must be given in the form of pairs '(name,value)'.
	1627	+
	1628	+ Notice that the name of a form may be used by an actioner which is off the form, so as
	1629	+ to get the operands provided by this form. Also notice that several actioners may refer
	1630	+ to the same form, being either in the form, or referring to the form from the
	1631	+ outside. These actioners simply get the same set of operands, even if they correspond
	1632	+ to distinct actions.
	1633	+
	1634	+ Input elements may be put only within a form.
	1635	+
	1636	+
	1637	+
	1638	+ *** (3.5) Local popup.
	1639	+
	1640	+ This element looks like a link or a rollover button. When this button is clicked upon,
	1641	+ a 'popup window' appears. Actually, this popup window is just a layer in the same HTML
	1642	+ page, which becomes suddenly visible. It is realized with a '<div>' HTML tag. In
	1643	+ particular, clicking on the button does not open any connection. This is why it is
	1644	+ called 'local'. The arguments have the following roles:
	1645	+
	1646	+ Actioner_Aspect aspect of the button (same semantics as for actioners)
	1647	+ content content of the popup window
	1648	+ x, y, position of the popup window on the HTML page (not relative
	1649	+ to the button but to the page itself)
	1650	+ title title of the popup window
	1651	+ color color of the title bar and close button in the popup window.
	1652	+ A lightened version of this color is used for the background
	1653	+ of the popup window.
	1654	+ width width of the title bar
	1655	+
	1656	+
	1657	+
	1658	+
	1659	+
	1660	+ --- That's all for the public part ! --------------------------------------------------
	1661	+
	1662	+
	1663	+
	1664	+
	1665	+
	1666	+ ----------------------------------- Table of Contents ---------------------------------
	1667	+
	1668	+ *** [1] States.
	1669	+ *** [1.1] Saving and retrieving states.
	1670	+ *** [1.2] Deleting out of date states.
	1671	+
	1672	+ *** [2] Tools.
	1673	+ *** [2.1] Directories.
	1674	+ *** [2.2] Secondary documents.
	1675	+
	1676	+ *** [3] Managing web arguments.
	1677	+ *** [3.1] Prefixing web arguments names.
	1678	+ *** [3.2] Separating web arguments.
	1679	+ *** [3.3] Applying an action.
	1680	+
	1681	+ *** [4] Web site descriptions and the 'awp handlers'.
	1682	+ *** [4.1] The type 'Web_Site'.
	1683	+ *** [4.2] Making a web site description.
	1684	+ *** [4.3] Starting the servers.
	1685	+
	1686	+ *** [5] HTML Formating.
	1687	+ *** [5.1] The type 'HTML_Any($T)'.
	1688	+ *** [5.2] Formating a color.
	1689	+ *** [5.3] Creating buttons.
	1690	+ *** [5.4] Formating an actioner.
	1691	+ *** [5.5] Formating a private download link.
	1692	+ *** [5.6] Formating rows and cells in a table.
	1693	+ *** [5.7] Formating elements which may be put anywhere.
	1694	+ *** [5.8] Formating 'in form' elements.
	1695	+ *** [5.9] Formating 'off form' elements.
	1696	+ *** [5.10] Formating meta-tags.
	1697	+
	1698	+ ---------------------------------------------------------------------------------------
	1699	+
	1700	+
	1701	+
	1702	+
	1703	+public define String
	1704	+ doctype_w3c_header
	1705	+ =
	1706	+ "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" "+
	1707	+ "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">\n".
	1708	+
	1709	+
	1710	+
	1711	+
	1712	+ *** [1] States.
	1713	+
	1714	+ We have to define functions for saving a state, retrieving a state, deleting out of
	1715	+ date states. We need one such function per web site. The types of the first two
	1716	+ functions depend on the parameter $State. This is not the case of the third one. The
	1717	+ fact that the instance of $State is variable from one web sites to the other implies
	1718	+ rather subtle manipulations using full functionality.
	1719	+
	1720	+
	1721	+ *** [1.1] Saving and retrieving states.
	1722	+
	1723	+ Each state is saved into a file on the server's disk (in the directory represented by
	1724	+ the symbol 'state_directory', which is 'my_anubis/web_sites/common_name/states'). The
	1725	+ state is saved together with a time stamp whose value is obtained by adding the current
	1726	+ time to the given timeout for states. The state receives a name obtained by hashing
	1727	+ (using sha1) the content of the file itself, and then encoding the hash with
	1728	+ 'web_arg_encode'. The name of the file into which the state is saved is the
	1729	+ concatenation of "s" and the name of the state.
	1730	+
	1731	+read CXM_web_arg_encode.anubis
	1732	+
	1733	+ The tool below constructs the function which is able to save a state on the server's
	1734	+ disk.
	1735	+
	1736	+define (Maybe($State) s) -> String // the function constructed returns the name of the state
	1737	+ make_save_state_function
	1738	+ (
	1739	+ Int timeout,
	1740	+ String state_directory
	1741	+ ) =
	1742	+ (Maybe($State) mbs) \|->
	1743	+ if mbs is
	1744	+ {
	1745	+ failure then "",
	1746	+ success(s) then
	1747	+ with time_stamp = now+timeout,
	1748	+ to_be_saved = (time_stamp,s),
	1749	+ state_name = web_arg_encode(sha1(s)),
	1750	+ if save(to_be_saved,state_directory+"/s"+state_name) is ok
	1751	+ then state_name
	1752	+ else (print("Cannot create state file in '"+state_directory+"'.\n"); "")
	1753	+ }.
	1754	+
	1755	+
	1756	+ When a request arrives, we need to retrieve the previous state from the server's
	1757	+ disk. We receive the name of that state. If the state is out of date, the state file is
	1758	+ kept 3 days, and then deleted.
	1759	+
	1760	+type PreviousState($State):
	1761	+ not_found, // cannot retrieve the previous state
	1762	+ out_of_date($State), // the previous state is out of date
	1763	+ still_valid($State). // the previous state is still valid
	1764	+
	1765	+define (String state_name) -> PreviousState($State)
	1766	+ make_retrieve_state_function
	1767	+ (
	1768	+ String state_directory
	1769	+ ) =
	1770	+ (String state_name) \|->
	1771	+ with file_path = state_directory+"/s"+state_name,
	1772	+ if (RetrieveResult((Int,$State)))retrieve(file_path) is ok(d)
	1773	+ then (
	1774	+ if d is (time_stamp,s) then
	1775	+ if time_stamp < now
	1776	+ then (
	1777	+ forget(remove(file_path));
	1778	+ out_of_date(s)
	1779	+ )
	1780	+ else still_valid(s) // state has been successfully retrieved
	1781	+ )
	1782	+ else not_found.
	1783	+
	1784	+
	1785	+
	1786	+ *** [1.2] Deleting out of date states.
	1787	+
	1788	+ We also need to delete states which are out of date and which will never be deleted by
	1789	+ the above method. This may be performed by a machine doing this periodically (say once
	1790	+ per states life time period).
	1791	+
	1792	+define (List(String) file_names) -> One
	1793	+ make_delete_out_of_date_states_function
	1794	+ (
	1795	+ Maybe($State) dummy,
	1796	+ String state_directory
	1797	+ ) =
	1798	+ (List(String) file_names) \|-df->
	1799	+ if file_names is
	1800	+ {
	1801	+ [ ] then unique,
	1802	+ [h . t] then
	1803	+ with file_path = state_directory+"/"+h,
	1804	+ if (RetrieveResult((Int,$State)))retrieve(file_path) is ok(d)
	1805	+ then (
	1806	+ if d is (time_stamp,data) then
	1807	+ if time_stamp < now
	1808	+ then (forget(remove(file_path)); df(t))
	1809	+ else df(t)
	1810	+ )
	1811	+ else (forget(remove(file_path)); df(t))
	1812	+ }.
	1813	+
	1814	+
	1815	+ The 'labelled arrow' \|-df-> is documented in 'documentation/en/anubis_doc.txt'.
	1816	+
	1817	+ Note: The argument 'dummy' (of type Maybe($State)) is not used in the body of the
	1818	+ function (hence its name). Nevertheless, it is required. Indeed, the Anubis compiler
	1819	+ does not accept a parameter in the body of a function (here the parameter is required
	1820	+ by the use of 'retrieve') if this parameter does not appear in the type of the
	1821	+ function. This is because this would create ambiguities that no explicit typing may
	1822	+ ever resolve. If you put a double slash in front of the declaration of 'dummy' above,
	1823	+ and if you compile this file, you will get a message like this one:
	1824	+
	1825	+ Error in 'making_a_web_site.anubis', line 1300, column 7:
	1826	+ A definition may not contain parameters which are not present
	1827	+ in the declaration part (hidden parameters):
	1828	+ $State
	1829	+
	1830	+ The type of the function constructed by 'make_delete_out_of_date_states_function' is
	1831	+ independant of the parameter $State. This is important because this allows to create
	1832	+ the list of such functions for all web sites. From this list, it is possible to call
	1833	+ the functions one after the other, so deleting out of date states for all web
	1834	+ sites. Actually, the next function receives a list of pairs (state_directory,function),
	1835	+ one for each web site.
	1836	+
	1837	+define One
	1838	+ delete_out_of_date_states // for all web sites
	1839	+ (
	1840	+ List((String, List(String) -> One)) directories_and_functions
	1841	+ ) =
	1842	+ if directories_and_functions is
	1843	+ {
	1844	+ [ ] then unique,
	1845	+ [h . t] then if h is (state_directory,function) then
	1846	+ function(directory_list(state_directory,"s*"));
	1847	+ delete_out_of_date_states(t)
	1848	+ }.
	1849	+
	1850	+
	1851	+ The above function must be called periodically in a separate virtual machine. The
	1852	+ period we have choosen is (rather logically) the life time of states itself. This may
	1853	+ be achieved by an 'infinite' loop, using a 'sleep(timeout)'. However, the loop must not
	1854	+ be really infinite, because the servers may be shutdown. Hence, our loop must test
	1855	+ (rather frequently; say every second) if the servers are down. If they are, the loop
	1856	+ must be exited.
	1857	+
	1858	+define One
	1859	+ delete_states_loop
	1860	+ (
	1861	+ List((String,List(String) -> One)) directories_and_functions,
	1862	+ Int timeout,
	1863	+ Int next_time,
	1864	+ Server http_server,
	1865	+ Server https_server,
	1866	+ Var(Bool) shutdown_required
	1867	+ ) =
	1868	+ if *shutdown_required
	1869	+ then (shutdown(http_server); shutdown(https_server))
	1870	+ else unique;
	1871	+ if (is_down(http_server) & is_down(https_server))
	1872	+ then unique
	1873	+ else if now > next_time
	1874	+ then
	1875	+ (
	1876	+ delete_out_of_date_states(directories_and_functions);
	1877	+ delete_states_loop(directories_and_functions,
	1878	+ timeout,
	1879	+ now+timeout,
	1880	+ http_server,
	1881	+ https_server,
	1882	+ shutdown_required)
	1883	+ )
	1884	+ else
	1885	+ (
	1886	+ sleep(1000); // sleep just one second and try again
	1887	+ delete_states_loop(directories_and_functions,
	1888	+ timeout,
	1889	+ next_time,
	1890	+ http_server,
	1891	+ https_server,
	1892	+ shutdown_required)
	1893	+ ).
	1894	+
	1895	+ The above loop must be run in a separate virtual machine. This will be done just after
	1896	+ the two servers are started.
	1897	+
	1898	+
	1899	+
	1900	+
	1901	+
	1902	+ *** [2] Tools.
	1903	+
	1904	+ *** [2.1] Directories.
	1905	+
	1906	+ We need a tool for creating directories (if needed).
	1907	+
	1908	+ (This tool has been moved to 'tools/basis.anubis').
	1909	+
	1910	+
	1911	+
	1912	+
	1913	+ *** [2.2] Secondary documents.
	1914	+
	1915	+ Some HTML elements (like '<object>', '<frame>') cannot receive their content directly
	1916	+ from the current document, but only through an URL. For this reason, we implement a
	1917	+ mecanism for creating secondary documents on the fly. To that end we use the 'private
	1918	+ download' mecanism.
	1919	+
	1920	+ A secondary document is formated by the same functions as the main document itself. The
	1921	+ next function takes an 'off form' element, creates the file containing the secondary
	1922	+ document in HTML format, and returns the URL at which the document will be available.
	1923	+
	1924	+define String
	1925	+ create_secondary_document
	1926	+ (
	1927	+ String sd, // site directory
	1928	+ String as, // authorization_secret
	1929	+ String sn, // state name
	1930	+ $T -> Printable_tree format_element,
	1931	+ $T content,
	1932	+ HTML_Size width
	1933	+ ) =
	1934	+ with private_download_directory = sd+"/private_download",
	1935	+ hash = web_arg_encode(sha1(content)),
	1936	+ file_content = (Printable_tree)
	1937	+ [doctype_w3c_header,
	1938	+ "<html><body><table ",
	1939	+ if width is
	1940	+ {
	1941	+ absolute(w) then ["width=\"",w-25],
	1942	+ percentage(w) then ["width=\"95%\""]
	1943	+ },"\"><tbody><tr><td align=right>",
	1944	+ format_element(content),
	1945	+ "</td></tr></tbody></table></body></html>"
	1946	+ ],
	1947	+ file_name = "sd"+hash+".html",
	1948	+ file_path = private_download_directory+"/"+file_name,
	1949	+ if write_to_file(file_path,file_content) is
	1950	+ {
	1951	+ cannot_open_file then print("Cannot open file '"+file_path+"'.\n"); "",
	1952	+ write_error(n) then print("Error writing file '"+file_path+"'.\n"); "",
	1953	+ ok then file_name+"?zauth="+
	1954	+ make_authorization(sd,as,private_download_directory+"/"+file_name)
	1955	+ }.
	1956	+
	1957	+
	1958	+
	1959	+
	1960	+ *** [2.3] Generating unique ids.
	1961	+
	1962	+ In order to uniquely name object for JavaScript we generate unique ids from a counter.
	1963	+
	1964	+define Int
	1965	+ new_idnum
	1966	+ (
	1967	+ Var(Int) ic_v // 'idnum' counter variable
	1968	+ ) =
	1969	+ protect
	1970	+ with result = *ic_v+1,
	1971	+ ic_v <- result;
	1972	+ result.
	1973	+
	1974	+
	1975	+
	1976	+
	1977	+
	1978	+
	1979	+ *** [3] Managing web arguments.
	1980	+
	1981	+ Web arguments are those pairs 'name=value' which are transmitted through the HTTP
	1982	+ protocol. We need precise naming conventions for these web arguments.
	1983	+
	1984	+
	1985	+
	1986	+ *** [3.1] Prefixing web arguments names.
	1987	+
	1988	+ CR 2008-07-08 Prefixing Removed
	1989	+
	1990	+
	1991	+
	1992	+ *** [3.2] Separating web arguments.
	1993	+
	1994	+ When a new request arrives, we need to separate the web arguments, that is to say:
	1995	+
	1996	+ - find the value of "s", and recover the corresponding state,
	1997	+ - find the value of "a", which is the name of the action to be performed,
	1998	+ - get the list of all the remaining web arguments (operands of the action).
	1999	+
	2000	+ We must also determine if the previous state may be recovered. If it is not the case
	2001	+ (either because the previous state name is invalid, or the previous state is out of
	2002	+ date), we must check if there is an action name. Indeed, the presence of an action name
	2003	+ indicates that the user has clicked on one of our buttons or links. If on the contrary
	2004	+ there is no action name the user has just entered our address in his browser. In this
	2005	+ last case, we must send the first page of our site (maybe a 'login' page), but if there
	2006	+ is an action, we must send a page just saying that the session ticket has expired. If
	2007	+ the previous state is recovered and there is no action, the new state is the same as
	2008	+ the previous state.
	2009	+
	2010	+ The result of the separation of the web arguments is of type:
	2011	+
	2012	+type Separated_Web_Args($State):
	2013	+ swa(Maybe(PreviousState($State)) previous_state,
	2014	+ Maybe(String) action_name,
	2015	+ List(Web_arg) operands).
	2016	+
	2017	+
	2018	+
	2019	+ The next function constructs the function which separates the web arguments.
	2020	+
	2021	+define (List(Web_arg) lwa) -> Separated_Web_Args($State)
	2022	+ make_separate_web_args_function
	2023	+ (
	2024	+ String state_directory,
	2025	+ String -> PreviousState($State) retrieve_state
	2026	+ ) =
	2027	+ (List(Web_arg) lwa) \|-swaf->
	2028	+ if lwa is
	2029	+ {
	2030	+ [ ] then
	2031	+ //
	2032	+ // no web arg found => no previous state and no action
	2033	+ //
	2034	+ swa(failure,failure,[]),
	2035	+
	2036	+ [wa_1 . wa_others] then
	2037	+ //
	2038	+ // at least one web arg =>
	2039	+ // separate other web args, and insert the first one as needed
	2040	+ //
	2041	+ if (Separated_Web_Args($State))swaf(wa_others) is
	2042	+ {
	2043	+ swa(ps1, // possible previous state
	2044	+ an1, // maybe an action name
	2045	+ op1) // operands so far
	2046	+ then
	2047	+ if wa_1 is
	2048	+ {
	2049	+ web_arg(n, value) then
	2050	+ with name = if substr(n,0,4) = "amp;" then substr(n, 4, length(n) - 4) else n,
	2051	+ if name = "s" then
	2052	+ swa(success(retrieve_state(value)),an1,op1)
	2053	+ else if name = "a" then
	2054	+ swa(ps1,success(value),op1)
	2055	+ else if name = "t" then
	2056	+ swa(ps1,an1,[web_arg("target",value) . op1])
	2057	+ else
	2058	+ swa(ps1,an1,[web_arg(name,value) . op1]),
	2059	+
	2060	+ upload(n,v,t) then
	2061	+ swa(ps1,an1,[wa_1 . op1])
	2062	+ }}
	2063	+ }.
	2064	+
	2065	+
	2066	+
	2067	+
	2068	+
	2069	+
	2070	+ *** [3.3] Applying an action.
	2071	+
	2072	+ When the web arguments are separated (and their names cleaned up from prefixes), we may
	2073	+ apply the action to the operands and the current state. We search for the action to be
	2074	+ applied in the list of actions. If no action is found, the new state is the same as
	2075	+ the previous state. Also, we deny the application of an HTTP action if the request
	2076	+ arrives through the HTTPS channel and conversely.
	2077	+
	2078	+
	2079	+define (Maybe($State) previous,
	2080	+ String action_name,
	2081	+ HTTP_Info http_info,
	2082	+ List(Web_arg) lwa,
	2083	+ Bool is_https) -> (Maybe($SessionTicket), Maybe($State), List(HTTP_header))
	2084	+ make_apply_action_function
	2085	+ (
	2086	+ List(Web_Action($SessionTicket, $State)) actions_list
	2087	+ ) =
	2088	+ with f =
	2089	+ (Maybe($State) previous,
	2090	+ String action_name,
	2091	+ HTTP_Info http_info,
	2092	+ List(Web_arg) lwa,
	2093	+ Bool is_https,
	2094	+ List(Web_Action($SessionTicket, $State)) actions) \|-f->
	2095	+ if actions is
	2096	+ {
	2097	+ [ ] then (print("action '"+action_name+
	2098	+ "' not found.\n"); (failure, previous, [])),
	2099	+ [ac1 . others] then if ac1 is
	2100	+ {
	2101	+ http_action(an,allow,do_it) then
	2102	+ if an = action_name
	2103	+ then if is_https
	2104	+ then (print("HTTP action '"+an+
	2105	+ "' called through HTTPS (denied).\n");
	2106	+ (failure, previous, []))
	2107	+ else if allow(previous)
	2108	+ then do_it(http_info,lwa,previous)
	2109	+ else (failure, previous, [])
	2110	+ else f(previous,action_name,http_info,lwa,is_https,others),
	2111	+
	2112	+ https_action(an,allow,do_it) then
	2113	+ if an = action_name
	2114	+ then if is_https
	2115	+ then if allow(previous)
	2116	+ then do_it(http_info,lwa,previous)
	2117	+ else (failure, previous, [])
	2118	+ else (print("HTTPS action '"+an+
	2119	+ "' called through HTTP (denied).\n");
	2120	+ (failure, previous, []))
	2121	+ else f(previous,action_name,http_info,lwa,is_https,others),
	2122	+
	2123	+ http_https_action(an,allow,do_it) then
	2124	+ if an = action_name
	2125	+ then if allow(previous)
	2126	+ then do_it(http_info,lwa,previous)
	2127	+ else (failure, previous, [])
	2128	+ else f(previous,action_name,http_info,lwa,is_https,others),
	2129	+
	2130	+ }
	2131	+ },
	2132	+ (Maybe($State) previous,
	2133	+ String action_name,
	2134	+ HTTP_Info http_info,
	2135	+ List(Web_arg) lwa,
	2136	+ Bool is_https) \|->
	2137	+ f(previous, action_name, http_info, lwa, is_https, actions_list).
	2138	+
	2139	+
	2140	+
	2141	+
	2142	+
	2143	+
	2144	+
	2145	+
	2146	+ *** [4] Web site descriptions and the 'awp handlers'.
	2147	+
	2148	+ *** [4.1] The type 'Web_Site'.
	2149	+
	2150	+ The type 'Web_Site_Description' is defined in 'web/multihost_http_server.anubis'. We
	2151	+ need another one, because, we have some extra informations to record for each site.
	2152	+
	2153	+public type Web_Site:
	2154	+ web_site((Word32,Word32) -> Web_Site_Description description,
	2155	+ List(String) -> One delete_out_of_date).
	2156	+
	2157	+
	2158	+
	2159	+
	2160	+ *** [4.2] Making a web site description.
	2161	+
	2162	+ Below is the function which creates a web site description. It first creates (if
	2163	+ needed) the directories for the site, then constructs the tool functions for the site,
	2164	+ and the site handler. Finally, it constructs the web site description.
	2165	+
	2166	+ We gather common (constant) informations in the following type:
	2167	+
	2168	+type CommonInfo:
	2169	+ info(String common_name,
	2170	+ Word32 http_port,
	2171	+ Word32 https_port,
	2172	+ String site_directory,
	2173	+ String authorization_secret
	2174	+ ).
	2175	+
	2176	+ We need a forward declaration.
	2177	+
	2178	+public define Printable_tree
	2179	+ format
	2180	+ (
	2181	+ CommonInfo cinfo,
	2182	+ String state_name,
	2183	+ List(HTTP_header) headers,
	2184	+ HTTP_Answer page,
	2185	+ Bool is_https,
	2186	+ String charset
	2187	+ ).
	2188	+
	2189	+
	2190	+define Printable_tree
	2191	+ format
	2192	+ (
	2193	+ HTML_Size s
	2194	+ ) =
	2195	+ if s is
	2196	+ {
	2197	+ absolute(x) then ["\"",x,"\""],
	2198	+ percentage(x) then ["\"",x,"%\""]
	2199	+ }.
	2200	+
	2201	+public define Web_Site
	2202	+ make_web_site_description
	2203	+ (
	2204	+ List(String) common_names, // for example: ["www.our-business.com"]
	2205	+ String site_directory,
	2206	+ String state_directory,
	2207	+ One -> One init,
	2208	+ (HTTP_Info,
	2209	+ List(Web_arg),
	2210	+ Bool is_https) -> (Maybe($SessionTicket), Maybe($State), List(HTTP_header)) initial_state,
	2211	+ ($State expired,
	2212	+ Maybe(String),
	2213	+ HTTP_Info,
	2214	+ List(Web_arg),
	2215	+ Bool is_https) -> (Maybe($SessionTicket), Maybe($State), List(HTTP_header)) ticket_expired_state,
	2216	+ (Maybe(String),
	2217	+ HTTP_Info,
	2218	+ List(Web_arg),
	2219	+ Bool is_https) -> (Maybe($SessionTicket), Maybe($State), List(HTTP_header)) ticket_lost_state,
	2220	+ List(Web_Action($SessionTicket, $State)) actions,
	2221	+ (Maybe($SessionTicket), Maybe($State), List(Web_arg) lwa) -> HTTP_Answer compute_page,
	2222	+ Int timeout,
	2223	+ Redirections redirections,
	2224	+ String charset,
	2225	+ List(String) journal_extensions,
	2226	+ List(String) journal_headers,
	2227	+ String secret,
	2228	+ List(MIME) known_mime_types,
	2229	+ (String action_name,
	2230	+ List(Web_arg) args) -> One before_send_file
	2231	+ ) =
	2232	+ init(unique);
	2233	+
	2234	+
	2235	+ //
	2236	+ // make required directories (if needed)
	2237	+ //
	2238	+ with web_sites_directory = (String) make_directory(my_anubis_directory+"/web_sites"),
	2239	+ base_directory = (String) make_directory(site_directory),
	2240	+ // state_directory = make_directory(site_directory+"/states"),
	2241	+ forget((String)make_directory(site_directory+"/public"));
	2242	+ //
	2243	+ // construct tool functions
	2244	+ //
	2245	+ with save_state = make_save_state_function(timeout,state_directory),
	2246	+ retrieve_state = make_retrieve_state_function(state_directory),
	2247	+ separate_web_args = make_separate_web_args_function(state_directory,retrieve_state),
	2248	+ apply_action = make_apply_action_function(actions),
	2249	+ //
	2250	+ // construct the site handler
	2251	+ //
	2252	+ site_handler = (Word32 http_port, Word32 https_port) \|->
	2253	+ ((String host_name,
	2254	+ HTTP_Info http_info,
	2255	+ List(Web_arg) lwa,
	2256	+ Bool is_https) \|->
	2257	+ (Printable_tree)
	2258	+ if separate_web_args(lwa) is
	2259	+ {
	2260	+ swa(mb_previous_state,mb_action_name,operands) then
	2261	+ with state_and_headers = if mb_previous_state is
	2262	+ {
	2263	+ failure then
	2264	+ if mb_action_name is
	2265	+ {
	2266	+ failure then initial_state(http_info, operands, is_https),
	2267	+ success(action_name) then
	2268	+ apply_action(failure,action_name,http_info,operands,is_https)
	2269	+ },
	2270	+ success(previous_state) then if previous_state is
	2271	+ {
	2272	+ not_found then
	2273	+ if mb_action_name is
	2274	+ {
	2275	+ failure then initial_state(http_info, operands, is_https),
	2276	+ success(_) then
	2277	+ ticket_lost_state(mb_action_name, http_info,operands,is_https)
	2278	+ },
	2279	+
	2280	+ out_of_date(state) then
	2281	+ ticket_expired_state(state, mb_action_name, http_info,operands,is_https),
	2282	+
	2283	+ still_valid(state) then
	2284	+ if mb_action_name is
	2285	+ {
	2286	+ failure then (failure, success(state), []),
	2287	+ success(action_name) then
	2288	+ apply_action(success(state),action_name,http_info,operands,is_https)
	2289	+ }
	2290	+ }
	2291	+ },
	2292	+ if state_and_headers is (session_ticket, mb_new_state, headers) then
	2293	+ with state_name = save_state(mb_new_state),
	2294	+ format(info(host_name, http_port, https_port, site_directory, secret),
	2295	+ state_name,
	2296	+ headers,
	2297	+ compute_page(session_ticket, mb_new_state, operands),
	2298	+ is_https,
	2299	+ charset)
	2300	+ }),
	2301	+ //
	2302	+ // make the delete_out_of_date function
	2303	+ //
	2304	+ delete_out_of_date =
	2305	+ make_delete_out_of_date_states_function((Maybe($State))failure,
	2306	+ site_directory+"/states"),
	2307	+ //
	2308	+ // construct the web site description
	2309	+ //
	2310	+ web_site((Word32 http_port, Word32 https_port) \|->
	2311	+ web_site_description(common_names,
	2312	+ site_directory,
	2313	+ redirections,
	2314	+ charset,
	2315	+ journal_extensions,
	2316	+ journal_headers,
	2317	+ secret,
	2318	+ known_mime_types,
	2319	+ site_handler(http_port,https_port),
	2320	+ (List(Web_arg) lwa) \|-> if separate_web_args(lwa) is
	2321	+ swa(mb_previous_state,mb_action_name,operands) then
	2322	+ if mb_action_name is
	2323	+ {
	2324	+ failure then unique
	2325	+ success(an) then before_send_file(an,operands)
	2326	+ }),
	2327	+ delete_out_of_date).
	2328	+
	2329	+
	2330	+
	2331	+
	2332	+ *** [4.3] Starting the servers.
	2333	+
	2334	+public define Start_Web_Sites_Result
	2335	+ start_web_sites
	2336	+ (
	2337	+ Word32 ip_address, // the IP address shared by the web sites
	2338	+ Word32 http_port, // usually: 80
	2339	+ Word32 https_port, // usually: 443
	2340	+ String ssl_certificate_common_name,
	2341	+ List(Web_Site) web_sites, // web sites to be started
	2342	+ Var(Bool) shutdown_required
	2343	+ ) =
	2344	+ with get_description = (Web_Site ws) \|-> description(ws)(http_port,https_port),
	2345	+ with http_server_r =
	2346	+ start_http_server(ip_address,http_port,
	2347	+ map(get_description,web_sites),
	2348	+ load_denial_of_service_info),
	2349	+ with https_server_r =
	2350	+ start_https_server(ip_address,https_port,
	2351	+ ssl_certificate_common_name,
	2352	+ map(get_description,web_sites),
	2353	+ load_denial_of_service_info),
	2354	+ if http_server_r is ok(http_server)
	2355	+ then
	2356	+ (
	2357	+ if https_server_r is ok(https_server)
	2358	+ then
	2359	+ (
	2360	+ start_http_servers_tasks(map(get_description,web_sites),
	2361	+ [http_server,https_server],
	2362	+ 600); // period of 10 minutes
	2363	+ delegate
	2364	+ delete_states_loop(
	2365	+ map((Web_Site ws) \|->
	2366	+ (site_directory(description(ws)(http_port,https_port))+
	2367	+ "/states",delete_out_of_date(ws)),
	2368	+ web_sites),
	2369	+ 3600243, // keep out of date states 3 days
	2370	+ now,
	2371	+ http_server,
	2372	+ https_server,
	2373	+ shutdown_required),
	2374	+ ok(http_server,https_server)
	2375	+ )
	2376	+ else cannot_bind_to_port(https_port)
	2377	+ )
	2378	+ else
	2379	+ (
	2380	+ if https_server_r is ok(https_server)
	2381	+ then cannot_bind_to_port(http_port)
	2382	+ else cannot_bind_to_port(http_port,https_port)
	2383	+ ).
	2384	+
	2385	+
	2386	+public define One
	2387	+ start_web_sites
	2388	+ (
	2389	+ Word32 ip_address, // the IP address shared by the web sites
	2390	+ Word32 http_port, // usually: 80
	2391	+ Word32 https_port, // usually: 443
	2392	+ String ssl_certificate_common_name,
	2393	+ List(Web_Site) web_sites, // web sites to be started
	2394	+ Var(Bool) shutdown_required,
	2395	+ Logger log
	2396	+ ) =
	2397	+ if (Start_Web_Sites_Result)start_web_sites(ip_address,
	2398	+ http_port,
	2399	+ https_port,
	2400	+ ssl_certificate_common_name,
	2401	+ web_sites,
	2402	+ shutdown_required) is
	2403	+ {
	2404	+ cannot_bind_to_port(n) then logError(log, "Cannot bind to port: "+n),
	2405	+ cannot_bind_to_port(n,m) then logError(log, "Cannot bind to ports: "+n+", "+m),
	2406	+ ok(s1,s2) then logInfo(log, "Servers started on ports "+http_port+" (HTTP) and "+https_port+" (HTTPS).")
	2407	+ }.
	2408	+
	2409	+
	2410	+
	2411	+
	2412	+
	2413	+ *** [5] HTML Formating.
	2414	+
	2415	+ We need to translate HTML elements as defined above into actual HTML text.
	2416	+
	2417	+ Actioners require special informations, which must be transmitted when needed by the
	2418	+ 'format' functions:
	2419	+
	2420	+ - the 'common name', which is used for URLs,
	2421	+ - the HTTP/HTTPS port number,
	2422	+ - the 'state name', which must be transmitted when the actioner is clicked upon,
	2423	+ - the 'form name' (if any) to which the actioner refers.
	2424	+
	2425	+ If the actioner is off form, and if it refers to a form, the name of that form is
	2426	+ already known by the actioner. On the contrary, if the actioner is 'in form', it refers
	2427	+ implicitly to the form containing it. The name of that form is transmitted to the
	2428	+ 'format' functions called from within the formating of that form.
	2429	+
	2430	+
	2431	+
	2432	+
	2433	+ *** [5.1] The type 'HTML_Any($T)'.
	2434	+
	2435	+ The type 'HTML_Any($T)' gathers elements which may be put anywhere in the page. The
	2436	+ parameter $T becomes either 'HTML_Off_Form' or 'HTML_In_Form'.
	2437	+
	2438	+type HTML_Any($T):
	2439	+ any_text (List(Text_Option), String the_text),
	2440	+ any_preformated (List(Text_Option), String),
	2441	+ any_paragraph (List(Text_Option), $T content),
	2442	+ any_image (List(CoreAttrs), String url, String alternate),
	2443	+ any_image (List(CoreAttrs), String url, String alternate, Int width, Int height),
	2444	+ any_table (List(Table_Option), HTML_Header_Row($T), List(HTML_Row($T)), HTML_Footer_Row($T)),
	2445	+ any_center ($T),
	2446	+ any_mail_to (String email, $T element),
	2447	+ any_scroller (Int width, Int height,
	2448	+ Int content_width, Int content_height,
	2449	+ $T content),
	2450	+ any_fixed_size (HTML_Size width, HTML_Size height, $T content),
	2451	+ any_fixed_size_2 (HTML_Size width, HTML_Size height, String name_of_HTML_file),
	2452	+ any_actioner (Actioner_Connection,
	2453	+ Actioner_Target,
	2454	+ Actioner_Aspect,
	2455	+ String action_name,
	2456	+ List((String,String)) extra_ops,
	2457	+ List(Actioner_Local_Action),
	2458	+ Maybe(String) form_name),
	2459	+ any_foreign_link_new (Actioner_Target, Actioner_Aspect, String url),
	2460	+ any_foreign_link (List(Text_Option), String url),
	2461	+ any_foreign_link (List(Text_Option), String url, String name),
	2462	+ any_private_download (String abs_path, String name, String extra_ext,
	2463	+ Maybe((String,List((String,String))))),
	2464	+ any_div (List(CoreAttrs), $T element),
	2465	+ any_div_empty (List(CoreAttrs)),
	2466	+ any_coreattrs (List(CoreAttrs)).
	2467	+
	2468	+
	2469	+
	2470	+ *** [5.2] Formating a color.
	2471	+
	2472	+ RGB colors are formatted as '#rrggbb' where rr, gg and bb are two characters
	2473	+ hexadecimal values.
	2474	+
	2475	+define String
	2476	+ html_format
	2477	+ (
	2478	+ RGB color
	2479	+ ) =
	2480	+ if color is rgb(r,g,b) then
	2481	+ "#" + to_hexa(r)
	2482	+ + to_hexa(g)
	2483	+ + to_hexa(b).
	2484	+
	2485	+
	2486	+ The following is a very arbitrary definition of the opposite color. The thing which is
	2487	+ important is that it is far from the original, so that characters in 'opposite' color
	2488	+ are clearly visible over the original.
	2489	+
	2490	+define RGB
	2491	+ opposite
	2492	+ (
	2493	+ RGB color
	2494	+ ) =
	2495	+ if color is rgb(r,g,b) then
	2496	+ rgb(255-r,
	2497	+ 255-g,
	2498	+ 255-b).
	2499	+
	2500	+
	2501	+
	2502	+
	2503	+ *** [5.3] Creating buttons.
	2504	+
	2505	+ We want to be able to create buttons in the form of a pair of images (rollovers)
	2506	+ automatically. We use the JPEG interface, because for the time being Anubis cannot
	2507	+ handle other kinds of images.
	2508	+
	2509	+
	2510	+ Computing printed text length.
	2511	+
	2512	+ define Int
	2513	+ printed_text_width
	2514	+ (
	2515	+ Word8 -> Int char_size,
	2516	+ List(Word8) l
	2517	+ ) =
	2518	+ if l is
	2519	+ {
	2520	+ [] then (Int) 0,
	2521	+ [h . t] then char_size(h) + 1+ printed_text_width(char_size,t)
	2522	+ }.
	2523	+
	2524	+ define Int
	2525	+ printed_text_width
	2526	+ (
	2527	+ SystemFont font,
	2528	+ String s
	2529	+ ) =
	2530	+ printed_text_width((Word8 c) \|-> word8_to_int32(width(get_char_info(font,c))),
	2531	+ explode(s)).
	2532	+
	2533	+
	2534	+
	2535	+ Converting RGB to RGBA.
	2536	+
	2537	+define RGBA
	2538	+ to_rgba
	2539	+ (
	2540	+ RGB color
	2541	+ ) =
	2542	+ if color is rgb(r,g,b) then rgba(r,g,b,255).
	2543	+
	2544	+
	2545	+ Drawing a 'relief'.
	2546	+
	2547	+ define One
	2548	+ draw_relief
	2549	+ (
	2550	+ RGBAImage dest,
	2551	+ RGBA color,
	2552	+ Int contrast,
	2553	+ Int x,
	2554	+ Int y,
	2555	+ Int width,
	2556	+ Int height
	2557	+ ) =
	2558	+ with l = lighten(color,contrast),
	2559	+ d = darken(color,contrast),
	2560	+ draw_rectangle(dest,rect(x,y,x+width,y+1),l);
	2561	+ draw_rectangle(dest,rect(x,y+1,x+1,y+height),l);
	2562	+ draw_rectangle(dest,rect(x+width-1,y+1,x+width,y+height),d);
	2563	+ draw_rectangle(dest,rect(x+1,y+height-1,x+width-1,y+height),d).
	2564	+
	2565	+
	2566	+ Creating a button background.
	2567	+
	2568	+ define RGBAImage
	2569	+ create_button_background
	2570	+ (
	2571	+ RGBA color,
	2572	+ Int width,
	2573	+ Int height
	2574	+ ) =
	2575	+ with result = create_rgba_image(width,height,color),
	2576	+ draw_relief(result,color,100,0,0,width,height);
	2577	+ draw_relief(result,color,70,1,1,width-2,height-2);
	2578	+ draw_relief(result,color,55,2,2,width-4,height-4);
	2579	+ draw_relief(result,color,35,3,3,width-6,height-6);
	2580	+ draw_relief(result,color,20,4,4,width-8,height-8);
	2581	+ draw_relief(result,color,10,5,5,width-10,height-10);
	2582	+ draw_relief(result,color,5,6,6,width-12,height-12);
	2583	+ result.
	2584	+
	2585	+
	2586	+ Drawing the text over the background.
	2587	+
	2588	+ define One
	2589	+ draw_button_text
	2590	+ (
	2591	+ RGBAImage image,
	2592	+ String text,
	2593	+ Int text_index,
	2594	+ Int pixel_x,
	2595	+ Int y,
	2596	+ Rectangle clip,
	2597	+ RGBA color,
	2598	+ SystemFont font,
	2599	+ ) =
	2600	+ if nth(text_index,text) is
	2601	+ {
	2602	+ failure then unique,
	2603	+ success(c) then
	2604	+ with cw = draw_system_character(image,clip,pixel_x,y,font,word8_to_int32(c),color),
	2605	+ draw_button_text(image,text,text_index+1,pixel_x+cw+1,y,clip,color,font)
	2606	+ }.
	2607	+
	2608	+ define One
	2609	+ draw_button_text
	2610	+ (
	2611	+ RGBAImage image,
	2612	+ String text,
	2613	+ Int text_width,
	2614	+ RGBA light_color,
	2615	+ RGBA dark_color,
	2616	+ SystemFont font
	2617	+ ) =
	2618	+ with image_width = width(image),
	2619	+ image_height = height(image),
	2620	+ x_pos = (image_width-text_width)>>1,
	2621	+ clip = rect(0,0,image_width,image_height),
	2622	+ new_light_color = lighten(light_color,150),
	2623	+ new_dark_color = darken(dark_color,40),
	2624	+ draw_button_text(image, text, 0, x_pos+2, 16, clip, new_dark_color, font);
	2625	+ draw_button_text(image, text, 0, x_pos, 14, clip, new_light_color, font).
	2626	+
	2627	+
	2628	+ The next function creates the two images for a button. The information given is the
	2629	+ main color of the button, the text of the button and the minimal width (in pixels) of
	2630	+ the button. The function does not create the button if the images already exist. The
	2631	+ two images are stored in the directory 'site_directory/buttons'. The names of the files
	2632	+ are of the form:
	2633	+
	2634	+ bxxxx_off.jpg
	2635	+ bxxxx_on.jpg
	2636	+
	2637	+ where the prefix 'b' is to avoid leading '-' which may perturb UNIX commands (like
	2638	+ 'rm'), and where 'xxxx' is created from the given informations by the formula:
	2639	+
	2640	+ xxxx = web_arg_encode(sha1((color,text,width)))
	2641	+
	2642	+ Hence, distinct informations give distinct file names.
	2643	+
	2644	+
	2645	+ define String // returns xxxx
	2646	+ create_button_images
	2647	+ (
	2648	+ String site_directory,
	2649	+ RGBA color,
	2650	+ String text,
	2651	+ Int width,
	2652	+ SystemFont font
	2653	+ ) =
	2654	+ with xxxx = web_arg_encode(sha1((color,text,width))),
	2655	+ buttons_dir = site_directory+"/public/buttons",
	2656	+ off_filepath = buttons_dir+"/b"+xxxx+"_off.jpg",
	2657	+ on_filepath = buttons_dir+"/b"+xxxx+"_on.jpg",
	2658	+ if file_exists(on_filepath)
	2659	+ then xxxx
	2660	+ else with
	2661	+ text_width = printed_text_width(font,text),
	2662	+ button_width = max(width,text_width+12),
	2663	+ button_height = (Int)20,
	2664	+ light_color = lighten(color,60),
	2665	+ very_light_color = lighten(light_color,30),
	2666	+ dark_color = darken(color,40),
	2667	+ background_off =
	2668	+ create_button_background(color,button_width,button_height),
	2669	+ background_on =
	2670	+ create_button_background(light_color,button_width,button_height),
	2671	+
	2672	+ draw_button_text(background_off,text,text_width,very_light_color,dark_color,font);
	2673	+ draw_button_text(background_on, text,text_width,very_light_color,dark_color,font);
	2674	+ forget(write_image_to_JPEG_file(to_JPEG(background_off),
	2675	+ off_filepath,
	2676	+ 100));
	2677	+ forget(write_image_to_JPEG_file(to_JPEG(background_on),
	2678	+ on_filepath,
	2679	+ 100));
	2680	+ xxxx.
	2681	+
	2682	+
	2683	+
	2684	+
	2685	+
	2686	+ *** [5.4] Formating an actioner.
	2687	+
	2688	+ An actioner works as follows. Assume first that it refers to a form. When it is clicked
	2689	+ upon, the actioner puts (via 'onMouseDown') the URL into the 'action' attribute of the
	2690	+ form, and submits the form, using the JavaScript command 'form_name.submit()'. If the
	2691	+ actioner does not refer to a form, it fires the URL directly via 'href', because in
	2692	+ that case, the actioner is always an <a> tag.
	2693	+
	2694	+ The URL itself is composed using the connection sort (same, http or https), the common
	2695	+ name and port number (if needed), the state name, the action name, and the extra
	2696	+ operands, which are put into a query string. It may look like this:
	2697	+
	2698	+ http://common_name:port/?s=state_name&a=action_name&oname=value...
	2699	+
	2700	+ Each extra operand is a pair of strings: (name,value). It is formated as:
	2701	+
	2702	+ &oname=value
	2703	+
	2704	+
	2705	+define String
	2706	+ format_extra_operands
	2707	+ (
	2708	+ List((String,String)) l
	2709	+ ) =
	2710	+ if l is
	2711	+ {
	2712	+ [ ] then "",
	2713	+ [h . t] then if h is (n,v) then
	2714	+ "&"+n+"="+v+format_extra_operands(t)
	2715	+ }.
	2716	+
	2717	+
	2718	+ It seams that the standard requires "&" instead of "&" !
	2719	+
	2720	+ In case the target is another window, we need to format the options for this window.
	2721	+
	2722	+define String
	2723	+ format
	2724	+ (
	2725	+ List(Other_Window_Option) l
	2726	+ ) =
	2727	+ if l is
	2728	+ {
	2729	+ [ ] then "",
	2730	+ [h . t] then if h is
	2731	+ {
	2732	+ resizable then "resizable",
	2733	+ scrollbars then "scrollbars",
	2734	+ width(w) then "width="+w,
	2735	+ height(h2) then "height="+h2
	2736	+ } + if t is [ ] then "" else (","+format(t))
	2737	+ }.
	2738	+
	2739	+
	2740	+
	2741	+ Formating choices for a <select> tag.
	2742	+
	2743	+public define Printable_tree
	2744	+ format_choices
	2745	+ (
	2746	+ List(String) l
	2747	+ ) =
	2748	+ if l is
	2749	+ {
	2750	+ [ ] then [ ],
	2751	+ [h . t] then ["<option>", h, "</option>\n" . format_choices(t)]
	2752	+ }.
	2753	+
	2754	+
	2755	+public define Printable_tree
	2756	+ format_choices
	2757	+ (
	2758	+ List(String) l,
	2759	+ InitialValue selected
	2760	+ ) =
	2761	+ if l is
	2762	+ {
	2763	+ [ ] then [ ],
	2764	+ [h . t] then if h = selected.value
	2765	+ then ["<option selected=\"selected\">", h, "</option>\n" . format_choices(t)]
	2766	+ else ["<option>", h, "</option>\n" . format_choices(t,selected)]
	2767	+ }.
	2768	+
	2769	+
	2770	+public define Printable_tree
	2771	+ format_choices
	2772	+ (
	2773	+ List((WebArgValue,String)) l
	2774	+ ) =
	2775	+ if l is
	2776	+ {
	2777	+ [ ] then [ ],
	2778	+ [h . t] then
	2779	+ if h is (val,item)
	2780	+ then ["<option value=\""+val.value+"\">", item, "</option>\n" . format_choices(t)]
	2781	+ }.
	2782	+
	2783	+public define Printable_tree
	2784	+ format_choices
	2785	+ (
	2786	+ List((WebArgValue,String)) l,
	2787	+ InitialValue selected
	2788	+ ) =
	2789	+ if l is
	2790	+ {
	2791	+ [ ] then [ ],
	2792	+ [h . t] then
	2793	+ if h is (val,item) then
	2794	+ if val.value = selected.value
	2795	+ then ["<option value=\""+val.value+"\" selected=\"selected\">", item, "</option>\n" . format_choices(t)]
	2796	+ else ["<option value=\""+val.value+"\">", item, "</option>\n" . format_choices(t,selected)]
	2797	+ }.
	2798	+
	2799	+
	2800	+
	2801	+variable Int count = 0.
	2802	+
	2803	+ Note: this counter is private to the virtual machine, hence there is one counter by
	2804	+ client and by page : it seems that a new VM (simply a delegate) is started for each request.
	2805	+
	2806	+define Int
	2807	+ new_count
	2808	+ =
	2809	+ count <- *count+1;
	2810	+ *count.
	2811	+
	2812	+
	2813	+ The next function composes the URL. It is a JavaScript URL when the target is another
	2814	+ window.
	2815	+
	2816	+define String
	2817	+ make_actioner_url
	2818	+ (
	2819	+ CommonInfo cinfo,
	2820	+ Actioner_Connection connection,
	2821	+ Actioner_Target target,
	2822	+ String state_name,
	2823	+ String action_name,
	2824	+ List((String,String)) extra_ops,
	2825	+ Bool is_https
	2826	+ ) =
	2827	+ if cinfo is info(common_name,http_port,https_port,site_directory,secret) then
	2828	+ with strict_url =
	2829	+ if connection is
	2830	+ {
	2831	+ same then "/",
	2832	+ /*
	2833	+ same then if is_https
	2834	+ then "https://"+common_name+":"+https_port+"/"
	2835	+ else "http://"+common_name+":"+https_port+"/",
	2836	+ */
	2837	+
	2838	+ http then "http://"+common_name+":"+http_port+"/",
	2839	+ https then "https://"+common_name+":"+https_port+"/",
	2840	+ } +
	2841	+ "?s=" + state_name + "&a=" + action_name +
	2842	+ format_extra_operands(extra_ops),
	2843	+ if target is
	2844	+ {
	2845	+ same then strict_url,
	2846	+ same(label) then strict_url+"#"+label,
	2847	+ other(wn,ops) then
	2848	+
	2849	+ "javascript:void window.open('"+strict_url+"&t="+wn+"','"+
	2850	+ "w"+to_ascii(sha1(wn))+"','"+format(ops)+"')"
	2851	+ }.
	2852	+
	2853	+define String
	2854	+ make_foreign_link_url
	2855	+ (
	2856	+ Actioner_Target target,
	2857	+ String url
	2858	+ ) =
	2859	+ if target is
	2860	+ {
	2861	+ same then "/",
	2862	+ same(label) then "/#"+label,
	2863	+ other(wn,ops) then
	2864	+
	2865	+ "javascript:void window.open('"+url+"','"+
	2866	+ "w"+to_ascii(sha1(wn))+"','"+format(ops)+"')"
	2867	+ }.
	2868	+
	2869	+
	2870	+ Depending on the fact that the actioner refers to a form or not, the URL is used in two
	2871	+ different ways. If the actioner does not refer to a form, it is realized by a '<a>'
	2872	+ tag, with a 'href' attribute. If it refers to a form, it is still realized by a '<a>'
	2873	+ tag, but with no href attribute. In this case, we use the 'onMouseDown' or 'onChange'
	2874	+ event handler. The handler calls a JavaScript function which puts the URL as the value
	2875	+ of the 'action' attribute of the form, and submits the form.
	2876	+
	2877	+type URL_or_JavaScript:
	2878	+ url (String),
	2879	+ javascript (Printable_tree script, Printable_tree handler).
	2880	+
	2881	+
	2882	+ It was as shown below, in order to allow submission of a form from outside the form,
	2883	+ but this makes problems:
	2884	+
	2885	+define URL_or_JavaScript
	2886	+ format_action
	2887	+ (
	2888	+ String the_url,
	2889	+ Actioner_Aspect aspect,
	2890	+ Maybe(String) mb_id,
	2891	+ Maybe(String) mb_form_name
	2892	+ ) =
	2893	+ if mb_form_name is
	2894	+ {
	2895	+ failure then
	2896	+ url(the_url),
	2897	+ success(form_name) then
	2898	+ with n = new_count,
	2899	+ fn_name = "pfu_" + if mb_id is
	2900	+ {
	2901	+ failure then form_name + n,
	2902	+ success(id) then id,
	2903	+ },
	2904	+ javascript(
	2905	+ [
	2906	+ "<script type=\"text/javascript\" language =\"JavaScript\">\n",
	2907	+ "function ", fn_name, "() {\n",
	2908	+ " var fa = document.forms.",form_name,";\n",
	2909	+ " var u = \"",the_url,"\";\n",
	2910	+ " fa.action = u;",
	2911	+ if aspect is submit(_, _) then " }\n"
	2912	+ else "\n fa.submit(); }\n",
	2913	+ "</script>\n"
	2914	+ ],
	2915	+ [fn_name,"();"]
	2916	+ )
	2917	+ }.
	2918	+
	2919	+
	2920	+
	2921	+ Now, we format the actioner according to its aspect.
	2922	+
	2923	+define List(Text_Option)
	2924	+ get_text_options
	2925	+ (
	2926	+ List(Text_Option) l
	2927	+ )
	2928	+ =
	2929	+ if l is
	2930	+ {
	2931	+ [] then [],
	2932	+ [h . t ] then
	2933	+ if h is class(_) then
	2934	+ get_text_options(t)
	2935	+ else if h is id(_) then
	2936	+ get_text_options(t)
	2937	+ else if h is style(_) then
	2938	+ get_text_options(t)
	2939	+ else if h is title(_) then
	2940	+ get_text_options(t)
	2941	+ else
	2942	+ [ h . get_text_options(t) ]
	2943	+
	2944	+ }.
	2945	+
	2946	+ /**
	2947	+ * Extract the CSS class list from the list of Text_Option
	2948	+ */
	2949	+define List(CoreAttrs)
	2950	+ get_css_class
	2951	+ (
	2952	+ List(Text_Option) l
	2953	+ )
	2954	+ =
	2955	+ if l is
	2956	+ {
	2957	+ [] then [],
	2958	+ [h . t ] then
	2959	+
	2960	+
	2961	+ if h is class(name) then
	2962	+ [ class(name) . get_css_class(t) ]
	2963	+ else if h is id(name) then
	2964	+ [ id(name) . get_css_class(t) ]
	2965	+ else if h is style(the_style) then
	2966	+ [ style(the_style) . get_css_class(t) ]
	2967	+ else if h is title(name) then
	2968	+ [ tooltip(name) . get_css_class(t) ]
	2969	+ else
	2970	+ get_css_class(t)
	2971	+ }
	2972	+ .
	2973	+
	2974	+define Printable_tree
	2975	+ format
	2976	+ (
	2977	+ List(Actioner_Local_Action) l
	2978	+ ) =
	2979	+ if l is
	2980	+ {
	2981	+ [ ] then [ ],
	2982	+ [h . t] then [if h is
	2983	+ {
	2984	+ close_window then [" window.close(); "]
	2985	+ }
	2986	+ . format(t)]
	2987	+ }.
	2988	+
	2989	+public define String
	2990	+ format_attrs
	2991	+ (
	2992	+ List(CoreAttrs) attributs
	2993	+ )=
	2994	+ if attributs is
	2995	+ {
	2996	+ [] then "",
	2997	+ [h .t] then
	2998	+ with current = if h is
	2999	+ {
	3000	+ id(id_name) then
	3001	+ " id=\"" + id_name + "\"",
	3002	+ class(class_name) then
	3003	+ " class=\"" + class_name + "\"",
	3004	+ style(style_string) then
	3005	+ " style=\"" + style_string + "\"",
	3006	+
	3007	+ title(title_string) then
	3008	+ " title=\"" + title_string + "\"",
	3009	+
	3010	+ lang(lang) then
	3011	+ " xml:lang=" + lang,
	3012	+ dir(reading_Way) then
	3013	+ if reading_Way is
	3014	+ {
	3015	+ ltr then " dir=ltr",
	3016	+ rtl then " dir=rtl"
	3017	+ },
	3018	+
	3019	+ accesskey(key) then
	3020	+ " accesskey=\"" + key + "\"",
	3021	+ tabindex(index) then
	3022	+ " tabindex=\"" + index + "\"",
	3023	+
	3024	+ attr(name, value) then
	3025	+ " " + name + "=\"" + value + "\"",
	3026	+
	3027	+ event(e, value) then
	3028	+ " " + event_name(e) + "=\"" + value + "\"",
	3029	+ },
	3030	+ current + format_attrs(t)
	3031	+ }.
	3032	+
	3033	+define String
	3034	+ format_attrs
	3035	+ (
	3036	+ List(InputAttrs) attributs
	3037	+ )=
	3038	+ if attributs is
	3039	+ {
	3040	+ [] then "",
	3041	+ [h .t] then
	3042	+ with current = if h is
	3043	+ {
	3044	+ class(class_name) then
	3045	+ " class=\"" + class_name + "\"",
	3046	+ style(style_string) then
	3047	+ " style=\"" + style_string + "\"",
	3048	+
	3049	+ title(title_string) then
	3050	+ " title=\"" + title_string + "\"",
	3051	+
	3052	+ lang(lang) then
	3053	+ " xml:lang=" + lang,
	3054	+ dir(reading_Way) then
	3055	+ if reading_Way is
	3056	+ {
	3057	+ ltr then " dir=ltr",
	3058	+ rtl then " dir=rtl"
	3059	+ },
	3060	+
	3061	+ accesskey(key) then
	3062	+ " accesskey=\"" + key + "\"",
	3063	+ tabindex(index) then
	3064	+ " tabindex=\"" + index + "\"",
	3065	+
	3066	+ attr(name, value) then
	3067	+ " " + name + "=\"" + value + "\"",
	3068	+
	3069	+ event(e, value) then
	3070	+ " " + event_name(e) + "=\"" + value + "\"",
	3071	+ },
	3072	+ current + format_attrs(t)
	3073	+ }.
	3074	+
	3075	+define String
	3076	+ format_text_options
	3077	+ (
	3078	+ List(Text_Option) l
	3079	+ )
	3080	+ =
	3081	+ with text_options = get_text_options(l),
	3082	+ css_classes = get_css_class(l),
	3083	+ if text_options is
	3084	+ {
	3085	+ [] then "",
	3086	+ [_._] then " style=\"" + format(text_options) + "\" "
	3087	+ }
	3088	+ +
	3089	+ if css_classes is
	3090	+ {
	3091	+ [] then "",
	3092	+ [_._] then format_attrs(css_classes)
	3093	+ }.
	3094	+
	3095	+//define String
	3096	+// _format
	3097	+// (
	3098	+// List(CoreAttrs) opt
	3099	+// )=
	3100	+// if opt is
	3101	+// {
	3102	+// [] then "",
	3103	+// [h .t] then
	3104	+// with current = if h is
	3105	+// {
	3106	+// id(id_name) then
	3107	+// " id=\"" + id_name + "\"",
	3108	+// class(class_name) then
	3109	+// " class=\"" + class_name + "\"",
	3110	+// style(style_string) then
	3111	+// " style=\"" + style_string + "\"",
	3112	+//
	3113	+// title(title_string) then
	3114	+// " title=\"" + title_string + "\"",
	3115	+// lang(lang) then
	3116	+// " xml:lang=" + lang,
	3117	+// dir(reading_Way) then
	3118	+// if reading_Way is
	3119	+// {
	3120	+// ltr then " dir=ltr",
	3121	+// rtl then " dir=rtl"
	3122	+// },
	3123	+// attr(name, value) then
	3124	+// " " + name + "=\"" + value + "\"",
	3125	+// event(e, value) then
	3126	+// " " + event_name(e) + "=\"" + value + "\""
	3127	+// },
	3128	+// current + _format(t)
	3129	+// }
	3130	+// .
	3131	+
	3132	+define Printable_tree
	3133	+ format_div_option
	3134	+ (
	3135	+ List(CoreAttrs) options
	3136	+ )=
	3137	+ ["<div" + format_attrs(options) + ">"] .
	3138	+
	3139	+
	3140	+define Maybe(String)
	3141	+ extract_id
	3142	+ (
	3143	+ List(CoreAttrs) attrbs
	3144	+ ) =
	3145	+ if attrbs is
	3146	+ {
	3147	+ [] then failure,
	3148	+ [h . t] then
	3149	+ if h is id(value) then success(value)
	3150	+ else extract_id(t)
	3151	+ }.
	3152	+
	3153	+define Maybe(String)
	3154	+ extract_id
	3155	+ (
	3156	+ Actioner_Aspect aspect
	3157	+ ) =
	3158	+ if aspect is
	3159	+ {
	3160	+ link(_,_,_) then failure,
	3161	+ img_link(_,_) then failure,
	3162	+ push_button(opts,_) then extract_id(opts),
	3163	+ button(_,_) then failure,
	3164	+ button(_,_,_,_) then failure,
	3165	+ submit(opts,_) then extract_id(opts),
	3166	+ immediate_selector(_,_,_,_) then failure,
	3167	+ immediate_selector(_,_,_,_,_) then failure,
	3168	+ }.
	3169	+
	3170	+to do Complete format_foreign_link
	3171	+//TODO Complete format_foreign_link
	3172	+define Printable_tree
	3173	+ format_foreign_link
	3174	+ (
	3175	+// CommonInfo cinfo,
	3176	+ Actioner_Target target,
	3177	+ Actioner_Aspect aspect,
	3178	+ String url,
	3179	+ Bool is_https,
	3180	+ ) =
	3181	+ //if cinfo is info(common_name,http_port,https_port,site_dir,secret) then
	3182	+ with full_url = make_foreign_link_url(target,url),
	3183	+// with action = format_action(full_url, aspect, extract_id(aspect), mb_form_name),
	3184	+ if aspect is
	3185	+ {
	3186	+
	3187	+ link(opt, text, mb_name) then
	3188	+ with name_tag = if mb_name is success(n) then " name=\"" + n + "\"" else "",
	3189	+ [
	3190	+ "<a href=\"", full_url, "\"", format_text_options(opt), name_tag, ">",
	3191	+ text,
	3192	+ "</a>"
	3193	+ ],
	3194	+ img_link(img,alt_text) then
	3195	+ [
	3196	+ "<a href=\"", full_url ,"\"><img src=\"", img,
	3197	+ "\" alt=\"" + alt_text + "\" border=\"0\"></a>"
	3198	+ ],
	3199	+ push_button(options, text) then
	3200	+ ["<a href=\"",full_url,"\"", format_attrs(options), ">",
	3201	+ text, "</a>"
	3202	+ ],
	3203	+ button(url_off,url_on) then
	3204	+ [ ],
	3205	+
	3206	+ button(url_off,url_on,w,h) then
	3207	+ [ ],
	3208	+
	3209	+ submit(options, text) then
	3210	+ [ ],
	3211	+
	3212	+ immediate_selector(opt,name,size,choices) then
	3213	+ [ ],
	3214	+ immediate_selector(opt,name,size,choices,selected) then
	3215	+ [ ],
	3216	+ }.
	3217	+
	3218	+define Printable_tree
	3219	+ format_actioner
	3220	+ (
	3221	+ CommonInfo cinfo,
	3222	+ String state_name,
	3223	+ Actioner_Connection connection,
	3224	+ Actioner_Target target,
	3225	+ Actioner_Aspect aspect,
	3226	+ String action_name,
	3227	+ List((String,String)) extra_ops,
	3228	+ List(Actioner_Local_Action) local_actions,
	3229	+ Maybe(String) mb_form_name,
	3230	+ Bool is_https,
	3231	+ ) =
	3232	+ if cinfo is info(common_name,http_port,https_port,site_dir,secret) then
	3233	+ with url = make_actioner_url(cinfo,connection,target,
	3234	+ state_name,action_name,extra_ops,is_https),
	3235	+ with action = format_action(url, aspect, extract_id(aspect), mb_form_name),
	3236	+ if aspect is
	3237	+ {
	3238	+
	3239	+ link(opt, text, mb_name) then
	3240	+ with name_tag = if mb_name is success(n) then " name=\"" + n + "\"" else "",
	3241	+ [
	3242	+ "<a href=\"", url, "\"", format_text_options(opt), name_tag, ">",
	3243	+ text,
	3244	+ "</a>"
	3245	+ ],
	3246	+ img_link(img, alt_text) then
	3247	+ [
	3248	+ "<a href=\"", url ,"\"><img src=\"", img,
	3249	+ "\" alt=\"" + alt_text + "\" border=\"0\"></a>"
	3250	+ ],
	3251	+ push_button(options, text) then
	3252	+ [
	3253	+ if action is
	3254	+ {
	3255	+ url(u) then ["<a href=\"",u,"\"", format_attrs(options), ">",
	3256	+ text, "</a>"
	3257	+ ],
	3258	+ javascript(s,h) then
	3259	+ if action_name = "" then
	3260	+ ["<input type=\"button\" value=\"",text,"\"", format_attrs(options), " />"]
	3261	+ else
	3262	+ [s,"<input type=\"button\" value=\"",text,"\"", format_attrs(options), " onclick=\"",h,"\" />"]
	3263	+ }
	3264	+ ],
	3265	+ button(url_off,url_on) then
	3266	+ [ if action is
	3267	+ {
	3268	+ url(u) then ["<a href=\"",u],
	3269	+ javascript(s,h) then [s,"<a onMouseDown=\"",h]
	3270	+ },
	3271	+ "\" style=\"text-decoration:none\">",
	3272	+ "<img alt=\"",url_off,"\" src=\"",url_off,"\" border=0",
	3273	+ " onMouseOver=\"this.src='",url_on,"'\" ",
	3274	+ " onMouseOut=\"this.src='",url_off,"'\">",
	3275	+ "</a>"
	3276	+ ],
	3277	+
	3278	+ button(url_off,url_on,w,h) then
	3279	+ [ if action is
	3280	+ {
	3281	+ url(u) then ["<a href=\"",u],
	3282	+ javascript(s,h2) then [s,"<a onMouseDown=\"",h2]
	3283	+ },
	3284	+ "\" style=\"text-decoration:none\">",
	3285	+ "<img width=",w," height=",h," alt=\"",url_off,"\" src=\"",url_off,"\" border=0",
	3286	+ " onMouseOver=\"this.src='",url_on,"'\" ",
	3287	+ " onMouseOut=\"this.src='",url_off,"'\">",
	3288	+ "</a>"
	3289	+ ],
	3290	+
	3291	+ submit(options, text) then
	3292	+ [
	3293	+ if action is
	3294	+ {
	3295	+ url(u) then ["<a href=\"",u,"\"", format_attrs(options), ">",
	3296	+ text, "</a>"
	3297	+ ],
	3298	+ javascript(s,h) then
	3299	+ if action_name = "" then // special case where URL (so the action_name) is provided by the form itself
	3300	+ // so javascript isn't needed. This is the standard HMTL way.
	3301	+ ["<input type=\"submit\" value=\"",text,"\"", format_attrs(options), " />"]
	3302	+ else
	3303	+ [s,"<input type=\"submit\" value=\"",text,"\"", format_attrs(options), " onclick=\"",h,"\" />"]
	3304	+ }
	3305	+ ],
	3306	+
	3307	+ immediate_selector(options,name,size,choices) then
	3308	+ [ if action is
	3309	+ {
	3310	+ url(u) then ["<select href=\"",u]
	3311	+ javascript(s,h) then [s,"<select onchange=\"",h]
	3312	+ },
	3313	+ "\" name=\"",name,"\" size=\"",size,"\"", format_attrs(options), ">",
	3314	+ format_choices(choices),"</select>"
	3315	+ ],
	3316	+ immediate_selector(options,name,size,choices,selected) then
	3317	+ [ if action is
	3318	+ {
	3319	+ url(u) then ["<select href=\"",u]
	3320	+ javascript(s,h) then [s,"<select onchange=\"",h]
	3321	+ },
	3322	+ "\" name=\"",name,"\" size=\"",size,"\"", format_attrs(options), ">",
	3323	+ format_choices(choices, selected),"</select>"
	3324	+ ],
	3325	+ }.
	3326	+
	3327	+
	3328	+
	3329	+
	3330	+
	3331	+
	3332	+ *** [5.5] Formating a private download link.
	3333	+
	3334	+ We get the absolute path of the file to be downloaded, and the name under which it
	3335	+ should appear to the client. The function 'format_private_download' creates an
	3336	+ hypertext link for downloading the file. The secured mecanism of private download is
	3337	+ used. This function is called by the function which formats HTML_Any($T) elements.
	3338	+
	3339	+
	3340	+define Printable_tree
	3341	+ format_private_download
	3342	+ (
	3343	+ CommonInfo cinfo,
	3344	+ String sn, // state name
	3345	+ String abs_path, // absolute file path on server
	3346	+ String name, // name of file as it appears in the browser
	3347	+ String extra, // extra extension
	3348	+ Maybe((String,List((String,String)))) action
	3349	+
	3350	+ ) =
	3351	+ if cinfo is info(common_name,http_port,https_port,site_directory,secret) then
	3352	+ with private_download_directory = site_directory+"/private_download",
	3353	+ with auth = make_authorization(site_directory,secret,abs_path),
	3354	+ [
	3355	+ "<a href=\"",name,extra,"?zauth=",auth,
	3356	+ if action is
	3357	+ {
	3358	+ failure then [ ]
	3359	+ success(a) then if a is (an,args) then
	3360	+ ["&a=",an,format_extra_operands(args)]
	3361	+ },
	3362	+ "\">",
	3363	+ name,
	3364	+ "</a>"
	3365	+ ].
	3366	+
	3367	+
	3368	+
	3369	+
	3370	+ *** [5.6] Formating rows and cells in a table.
	3371	+
	3372	+define Int
	3373	+ percent
	3374	+ (
	3375	+ Int p
	3376	+ ) =
	3377	+ if p < 0 then 0 else if p > 100 then 100 else p.
	3378	+
	3379	+
	3380	+
	3381	+
	3382	+ Formating cell options.
	3383	+
	3384	+
	3385	+
	3386	+define String
	3387	+ format
	3388	+ (
	3389	+ BackgroundOption o
	3390	+ ) =
	3391	+ if o is
	3392	+ {
	3393	+ repeat then "",
	3394	+ repeat_horizontal then "; background-repeat: repeat-x",
	3395	+ repeat_vertical then "; background-repeat: repeat-y",
	3396	+ no_repeat then "; background-repeat: no-repeat",
	3397	+ center then "; background-position: center top"
	3398	+ }.
	3399	+
	3400	+define String
	3401	+ format
	3402	+ (
	3403	+ List(BackgroundOption) l
	3404	+ ) =
	3405	+ if l is
	3406	+ {
	3407	+ [ ] then "",
	3408	+ [h . t] then format(h)+format(t)
	3409	+ }.
	3410	+
	3411	+
	3412	+define String
	3413	+ format
	3414	+ (
	3415	+ List(Cell_Option) options
	3416	+ ) =
	3417	+ if options is
	3418	+ {
	3419	+ [ ] then "",
	3420	+ [h . t] then
	3421	+ if h is
	3422	+ {
	3423	+ core_attrs(core_attr_list) then format_attrs(core_attr_list),
	3424	+ left then " align=\"left\"",
	3425	+ h_center then " align=\"center\"",
	3426	+ right then " align=\"right\"",
	3427	+ top then " valign=\"top\"",
	3428	+ v_center then " valign=\"middle\"",
	3429	+ bottom then " valign=\"bottom\"",
	3430	+ base_line then " valign=\"baseline\"",
	3431	+ background_color(c) then " bgcolor=\""+html_format(c)+"\"",
	3432	+ background_image(n,o) then " style=\"background: url("+n+")"+format(o)+"\"",
	3433	+ width(w) then " width=\""+w+"\"",
	3434	+ percentage_width(n) then " width=\""+percent(n)+"%\"",
	3435	+ height(h2) then " height=\""+h2+"\"",
	3436	+ columns(n) then " colspan=\""+n+"\"",
	3437	+ rows(n) then " rowspan=\""+n+"\"",
	3438	+ nowrap then " nowrap"
	3439	+ }
	3440	+ + format(t)
	3441	+ }.
	3442	+
	3443	+
	3444	+ Normalizing a list of cell options (horizontal position must be specified; the default
	3445	+ is 'left').
	3446	+
	3447	+define List(Cell_Option)
	3448	+ normalize
	3449	+ (
	3450	+ List(Cell_Option) l
	3451	+ ) =
	3452	+ if member(l,left) then l else
	3453	+ if member(l,h_center) then l else
	3454	+ if member(l,right) then l else
	3455	+ //[left . l]. CR: why ? there is no default because we can use CSS
	3456	+ l.
	3457	+
	3458	+
	3459	+ Formating cells in a row.
	3460	+
	3461	+define Printable_tree
	3462	+ format
	3463	+ (
	3464	+ List(HTML_Cell($T)) cells,
	3465	+ $T -> Printable_tree format_element
	3466	+ ) =
	3467	+ if cells is
	3468	+ {
	3469	+ [ ] then [ ],
	3470	+ [h . t] then if h is cell(options,element) then
	3471	+ ["<td ",format(reverse(normalize(options))),">",
	3472	+ format_element(element),
	3473	+ "</td>"
	3474	+ . format(t,format_element)]
	3475	+ }.
	3476	+
	3477	+define Printable_tree
	3478	+ format
	3479	+ (
	3480	+ List(HTML_Header_Cell($T)) cells,
	3481	+ $T -> Printable_tree format_element
	3482	+ ) =
	3483	+ if cells is
	3484	+ {
	3485	+ [ ] then [ ],
	3486	+ [h . t] then if h is header_cell(options,element) then
	3487	+ ["<th ",format(reverse(normalize(options))),">",
	3488	+ format_element(element),
	3489	+ "</th>"
	3490	+ . format(t,format_element)]
	3491	+ }.
	3492	+
	3493	+ Formating the rows in a table.
	3494	+
	3495	+define Printable_tree
	3496	+ format
	3497	+ (
	3498	+ List(HTML_Row($T)) rows,
	3499	+ $T -> Printable_tree format_element,
	3500	+ ) =
	3501	+ if rows is
	3502	+ {
	3503	+ [ ] then [ ],
	3504	+ [h . t] then if h is row(options,cells) then
	3505	+ ["<tr ",format(reverse(options)),">",
	3506	+ format(cells,format_element),
	3507	+ "</tr>\n"
	3508	+ . format(t,format_element)]
	3509	+ }.
	3510	+
	3511	+define Printable_tree
	3512	+ format
	3513	+ (
	3514	+ HTML_Header_Row($T) row,
	3515	+ $T -> Printable_tree format_element
	3516	+ ) =
	3517	+ if row is
	3518	+ {
	3519	+ empty then [ ],
	3520	+ header_row(options,cells) then
	3521	+ ["<thead> <tr ",format(reverse(options)),">",
	3522	+ format(cells,format_element),
	3523	+ "</tr> </thead>\n"
	3524	+ ]
	3525	+ }.
	3526	+
	3527	+define Printable_tree
	3528	+ format
	3529	+ (
	3530	+ HTML_Footer_Row($T) row,
	3531	+ $T -> Printable_tree format_element
	3532	+ ) =
	3533	+ if row is
	3534	+ {
	3535	+ empty then [ ],
	3536	+ footer_row(options,cells) then
	3537	+ ["<tfoot> <tr ",format(reverse(options)),">",
	3538	+ format(cells,format_element),
	3539	+ "</tr> </tfoot>\n"
	3540	+ ]
	3541	+ }.
	3542	+
	3543	+define Printable_tree
	3544	+ format1
	3545	+ (
	3546	+ List(TextAreaOption) l
	3547	+ ) =
	3548	+ if l is
	3549	+ {
	3550	+ [] then [],
	3551	+ [h . t] then if h is
	3552	+ {
	3553	+ input_attrs(input_attr_list) then [format_attrs(input_attr_list) . format1(t)],
	3554	+ disabled then [" disabled=\"disabled\" " . format1(t)]
	3555	+ read_only then [" readonly=\"readonly\" " . format1(t)]
	3556	+ wrap_lines then [" wrap=\"wrap\" " . format1(t)]
	3557	+ }
	3558	+ }.
	3559	+
	3560	+define Printable_tree
	3561	+ format
	3562	+ (
	3563	+ List(TextAreaOption) l
	3564	+ ) =
	3565	+ if member(l,wrap_lines)
	3566	+ then format1(l)
	3567	+ else [" wrap=\"off\" " . format1(l)].
	3568	+
	3569	+
	3570	+ *** [5.7] Formating elements which may be put anywhere.
	3571	+
	3572	+ The function below involves the parameter $T which is later instantiated as
	3573	+ 'HTML_In_Form' or as 'HTML_Off_Form'. Now, since there are dictinct 'format' functions
	3574	+ for these two types, and because formating of tables requires recursive calls of such
	3575	+ functions, it is necessary to provide the 'format' function to be called recursively as
	3576	+ an argument. Putting naively a call to 'format' will not work, because the compiler
	3577	+ will look for a function able to format data of type $T (which is at that time distinct
	3578	+ from any other type, including our two types). Such a function does not exist. Hence
	3579	+ the function to be called for formating elements must be passed as a functional
	3580	+ argument (called 'format_element' below). Actually, what we pass is a function taking
	3581	+ a unique argument of type $T. Other informations (like the name of the state) are
	3582	+ already in the function by way of full functionality.
	3583	+
	3584	+
	3585	+ Formating text options. They are formated in CSS syntax, to be used within a
	3586	+ 'style=...'.
	3587	+
	3588	+define String
	3589	+ format
	3590	+ (
	3591	+ List(Text_Option) l
	3592	+ ) =
	3593	+ if l is
	3594	+ {
	3595	+ [ ] then "",
	3596	+ [h . t] then if h is
	3597	+ {
	3598	+ size(n) then "font-size:"+n+"pt",
	3599	+ font(fn) then "font-family:"+fn,
	3600	+ color(c) then if c is rgb(r,g,b) then
	3601	+ "color:rgb("+to_decimal(r)+","+to_decimal(g)+","+to_decimal(b)+")",
	3602	+ italic then "font-style:italic",
	3603	+ oblique then "font-style:oblique",
	3604	+ small_capitals then "font-variant:small-caps",
	3605	+ bold then "font-weight:bold",
	3606	+ underlined then "text-decoration:underline",
	3607	+ left_justified then "text-align:left",
	3608	+ right_justified then "text-align:right",
	3609	+ justified then "text-align:justify",
	3610	+ line_through then "text-decoration:line-through",
	3611	+ nowrap then "white-space:nowrap",
	3612	+ class(class_name)then " class=\"" + class_name +"\"",
	3613	+ id(id_name) then " id=\"" + id_name +"\"",
	3614	+ style(style_string) then " style=\"" + style_string + "\"",
	3615	+ title(s) then " title=\"" + s +"\""
	3616	+ } + if t is [ ] then "" else ("; "+format(t))
	3617	+ }.
	3618	+
	3619	+
	3620	+
	3621	+ Formating table options.
	3622	+
	3623	+define String
	3624	+ format
	3625	+ (
	3626	+ List(Table_Option) l,
	3627	+ Bool border_seen
	3628	+ ) =
	3629	+ if l is
	3630	+ {
	3631	+ [ ] then if border_seen then "" else " border=\"0\" cellspacing=\"0\" cellpadding=\"0\"",
	3632	+ [h . t] then if h is
	3633	+ {
	3634	+ background_color(c) then " bgcolor=\""+html_format(c)+"\""+format(t,border_seen),
	3635	+ background_image(url) then " background="+url+format(t,border_seen),
	3636	+ border(o,top,i,c) then " border=\""+o+"\" cellspacing=\""+top+"\" cellpadding=\""+i+"\""+
	3637	+ //" bordercolor="+format(c)+
	3638	+ format(t,true),
	3639	+ width(w) then " width=\""+w+"\""+format(t,border_seen),
	3640	+ percentage_width(p) then " width=\""+percent(p)+"%\""+format(t,border_seen),
	3641	+ }
	3642	+ }.
	3643	+
	3644	+
	3645	+
	3646	+
	3647	+
	3648	+define Printable_tree
	3649	+ format_scroller
	3650	+ (
	3651	+ String sn,
	3652	+ Int width,
	3653	+ Int height,
	3654	+ Int content_width,
	3655	+ Int content_height,
	3656	+ Int idnum, // identifying the scroller
	3657	+ $T content,
	3658	+ $T -> Printable_tree format_element
	3659	+ ) =
	3660	+ [
	3661	+ "<script type = \"text/javascript\" language=\"JavaScript\">",
	3662	+ "function doscroll_",idnum,"(dx,dy) {\n",
	3663	+ " if (document.layers) { var c_",idnum," = eval(document.cs_",idnum,"); } else\n",
	3664	+ " if (document.getElementById) {var c_",idnum," = eval(\"document.getElementById('cs_",
	3665	+ idnum,"').style\"); } else\n",
	3666	+ " if (document.all) { var c_",idnum," = eval(document.all.cs_",idnum,".style); };\n",
	3667	+ " var x_",idnum," = parseInt(c_",idnum,".left);\n",
	3668	+ " var y_",idnum," = parseInt(c_",idnum,".top);\n",
	3669	+ " if ((x_",idnum,"+dx <= 0) && (x_",idnum,"+dx > ",width-content_width,"))\n",
	3670	+ " { x_",idnum," += dx; }\n",
	3671	+ " if ((y_",idnum,"+dy <= 0) && (y_",idnum,"+dy > ",height-content_height,"))\n",
	3672	+ " { y_",idnum," += dy; }\n",
	3673	+ " c_",idnum,".left = x_",idnum,";\n",
	3674	+ " c_",idnum,".top = y_",idnum,";\n",
	3675	+ " }\n",
	3676	+ "</script>\n",
	3677	+ "<table>",
	3678	+ "<tbody>",
	3679	+ "<tr>",
	3680	+ "<td align=left valign=top",
	3681	+ " width=",width,
	3682	+ " height=",height,
	3683	+ ">",
	3684	+ "<div id=\"ws_",idnum,"\" style=\"position:absolute; width:",width,"px; height:",height,"px;",
	3685	+ " clip:rect(0px ",width,"px ",height,"px 0px)\">",
	3686	+ "<div id=\"cs_",idnum,"\" style=\"position:absolute; left:0px; top:0px\">",
	3687	+ format_element(content),
	3688	+ "</div>",
	3689	+ "</div>",
	3690	+ "</td>",
	3691	+ "<td valign=bottom>",
	3692	+ "<table>",
	3693	+ "<tbody>",
	3694	+ "<tr><td><img alt=\"sroll up\" src=\"scrollup.gif\" onmousedown=\"doscroll_", idnum,"(0,20);\"></td></tr>",
	3695	+ "<tr><td><img alt=\"scroll down\" src=\"scrolldown.gif\" onmousedown=\"doscroll_", idnum,"(0,-20);\"></td></tr>",
	3696	+ "</tbody>",
	3697	+ "</table>",
	3698	+ "</td>",
	3699	+ "</tr>",
	3700	+ (if content_width > width then
	3701	+ [
	3702	+ "<tr>",
	3703	+ "<td align=right>",
	3704	+ "<table>",
	3705	+ "<tbody>",
	3706	+ "<tr>",
	3707	+ "<td><img alt=\"scroll left\" src=\"scrollleft.gif\" onmousedown=\"doscroll_", idnum,"(20,0);\"></td>",
	3708	+ "<td><img alt=\"scroll right\" src=\"scrollright.gif\" onmousedown=\"doscroll_", idnum,"(-20,0);\"></td>",
	3709	+ "</tr>",
	3710	+ "</tbody>",
	3711	+ "</table>",
	3712	+ "</td>",
	3713	+ "</tr>",
	3714	+ ] else [ ]),
	3715	+ "</tbody>",
	3716	+ "</table>"
	3717	+ ].
	3718	+
	3719	+
	3720	+
	3721	+ // The function below formats a datum of type 'HTML_Any($T)'.
	3722	+
	3723	+define Printable_tree
	3724	+ format
	3725	+ (
	3726	+ CommonInfo cinfo,
	3727	+ String sn, // state_name
	3728	+ Var(Int) ic_v,
	3729	+ HTML_Any($T) element,
	3730	+ $T -> Printable_tree format_element, // able to format a datum of type $T
	3731	+ Bool is_https,
	3732	+ ) =
	3733	+ if cinfo is info(common_name,http_port,https_port,site_directory,secret) then
	3734	+ if element is
	3735	+ {
	3736	+ any_text(opts,t) then
	3737	+ ["<span ", format_text_options(opts), ">",t,"</span>"],
	3738	+ any_preformated(opts,s) then
	3739	+ ["<span ", format_text_options(opts), "><pre>",s,"</pre></span>"],
	3740	+ //["<pre>",s,"</pre>"],
	3741	+ any_paragraph(opts,e) then
	3742	+ ["<p ", format_text_options(opts), ">",format_element(e),"</p>\n"],
	3743	+ any_image(opts, url, alt) then
	3744	+ ["<img alt=\"",alt,"\" src=\"",url,"\" ", format_attrs(opts)," />"],
	3745	+ any_image(opts, url, alt, w, h) then
	3746	+ ["<img alt=\"",alt,"\" src=\"",url,"\" width=\"",w,"\" height=\"",h,"\" ", format_attrs(opts)," />"],
	3747	+ any_table(opts,h_row, rows, f_row) then
	3748	+ ["<table ",format(reverse(opts),false),">",
	3749	+ format(h_row, format_element),
	3750	+ "<tbody>",format(rows,format_element),"</tbody>",
	3751	+ format(f_row, format_element),
	3752	+ "</table>\n"],
	3753	+ any_center(e) then
	3754	+ ["<center>",format_element(e),"</center>"],
	3755	+ any_mail_to(email,elem) then
	3756	+ ["<a href=\"mailto:",email,"\">",format_element(elem),"</a>"],
	3757	+ any_scroller(w,h,cw,ch,c) then
	3758	+ format_scroller(sn,w,h,cw,ch,new_idnum(ic_v),c,format_element),
	3759	+ any_fixed_size(w,h,c) then
	3760	+ with url = create_secondary_document(site_directory,secret,sn,format_element,c,w),
	3761	+ ["<object data=\"",url,"\" type=\"text/html\" width=\"",format(w),"\" height=\"",format(h),"\" >",
	3762	+ "secondary document",
	3763	+ "</object>"],
	3764	+ any_fixed_size_2(w,h,fn) then
	3765	+ with url = fn+"?zauth="+make_authorization(site_directory,secret,
	3766	+ fn),
	3767	+ ["<object data=\"",url,"\" type=\"text/html\" width=\"",format(w),"\" height=\"",format(h),"\" >",
	3768	+ "secondary document",
	3769	+ "</object>"],
	3770	+ any_actioner(c,t,a,an,eo,ja,fn) then
	3771	+ format_actioner(cinfo,sn,c,t,a,an,eo,ja,fn,is_https),
	3772	+
	3773	+ any_foreign_link_new(target, aspect, url) then
	3774	+ format_foreign_link(target, aspect, url, is_https),
	3775	+
	3776	+ any_foreign_link(options,url) then
	3777	+ ["<a href=\"",url,"\" ", format_text_options(options), "></a>"], // IE7 doesn't support the form <a href="..." />
	3778	+ any_foreign_link(options,url,name) then
	3779	+ ["<a href=\"",url,"\"><span ", format_text_options(options), ">",name,"</span></a>"],
	3780	+ any_private_download(url,name,extra_ext,action) then
	3781	+ format_private_download(cinfo,sn,url,name,extra_ext,action),
	3782	+ any_div(options, e) then
	3783	+ [format_div_option(options), format_element(e),"</div>\n"],
	3784	+ any_div_empty(options) then
	3785	+ [format_div_option(options), "</div>\n"],
	3786	+ any_coreattrs(attributs) then
	3787	+ [format_attrs(attributs)]
	3788	+ }.
	3789	+
	3790	+
	3791	+
	3792	+
	3793	+ // *** [5.8] Formating 'in form' elements.
	3794	+
	3795	+
	3796	+define Printable_tree
	3797	+ maybe_label
	3798	+ (
	3799	+ String label_text,
	3800	+ HtmlId id
	3801	+ ) =
	3802	+ if length(label_text) > 0 then ["<label for=\"",id,"\">",label_text,"</label>"]
	3803	+ else [].
	3804	+
	3805	+
	3806	+define Printable_tree
	3807	+ format
	3808	+ (
	3809	+ CommonInfo cinfo,
	3810	+ String fn, // form_name
	3811	+ String sn, // state_name
	3812	+ Var(Int) ic_v, // idnum counter variable
	3813	+ HTML_In_Form element,
	3814	+ Bool is_https,
	3815	+ ) =
	3816	+ if cinfo is info(common_name,http_port,https_port,site_directory,secret) then
	3817	+ with format_element = (HTML_In_Form e) \|-> format(cinfo,fn,sn,ic_v,e,is_https),
	3818	+ if element is
	3819	+ {
	3820	+ literal_pt(t) then t,
	3821	+ literal(t) then [t],
	3822	+ sequence(l) then flat(map(format_element,l))
	3823	+ text(opts,t) then
	3824	+ format(cinfo,sn,ic_v,any_text(opts,t),format_element,is_https),
	3825	+ preformated(o,s) then
	3826	+ format(cinfo,sn,ic_v,any_preformated(o,s),format_element,is_https),
	3827	+ paragraph(opts,t) then
	3828	+ format(cinfo,sn,ic_v,any_paragraph(opts,t),format_element,is_https),
	3829	+ image(opts, url, alt) then
	3830	+ format(cinfo,sn,ic_v,any_image(opts, url, alt),format_element,is_https),
	3831	+ image(opts, url, alt, w, h) then
	3832	+ format(cinfo,sn,ic_v,any_image(opts, url, alt, w, h),format_element,is_https),
	3833	+ table(opts,header_row,rows,footer_row) then
	3834	+ format(cinfo,sn,ic_v,any_table(opts, header_row, rows, footer_row),format_element,is_https),
	3835	+ center(e) then
	3836	+ format(cinfo,sn,ic_v,any_center(e),format_element,is_https),
	3837	+ mail_to(a,e) then
	3838	+ format(cinfo,sn,ic_v,any_mail_to(a,e),format_element,is_https),
	3839	+ scroller(w,h,cw,ch,c) then
	3840	+ format(cinfo,sn,ic_v,any_scroller(w,h,cw,ch,c),format_element,is_https),
	3841	+ actioner(c,t,a,an,eo,ja) then
	3842	+ format(cinfo,sn,ic_v,any_actioner(c,t,a,an,eo,ja,success(fn)),format_element,is_https),
	3843	+
	3844	+ foreign_link_new(target, aspect, url) then
	3845	+ format(cinfo,sn,ic_v,any_foreign_link_new(target,aspect,url),format_element,is_https),
	3846	+
	3847	+ foreign_link(options,url) then
	3848	+ format(cinfo,sn,ic_v,any_foreign_link(options,url),format_element,is_https),
	3849	+ foreign_link(options,url,name) then
	3850	+ format(cinfo,sn,ic_v,any_foreign_link(options,url,name),format_element,is_https),
	3851	+ private_download(url,name,extra,action) then
	3852	+ format(cinfo,sn,ic_v,any_private_download(url,name,extra,action),format_element,is_https),
	3853	+ text_input(options, label_text, id, name, i, w) then
	3854	+ [ maybe_label(label_text, id),
	3855	+ "<input type=\"text\" name=\"",name,"\" id=\"",id,"\" size=\"",w,"\" value=\"",i,"\"",format_attrs(options)," />"],
	3856	+ text_input_ro(options, label_text, id, name,i,w) then
	3857	+ [ maybe_label(label_text, id),
	3858	+ "<input readonly=\"readonly\" type=\"text\" name=\"",name,"\" id=\"",id,"\" size=\"",w,"\" value=\"",i,"\"",format_attrs(options)," />"],
	3859	+ password_input(options, label_text, id, name,i,w) then
	3860	+ [ maybe_label(label_text, id),
	3861	+ "<input type=\"password\" name=\"",name,"\" id=\"",id,"\" size=\"",w,"\" value=\"",i,"\"",format_attrs(options)," />"],
	3862	+ text_area(opts,label_text, id, n,i,w,h) then
	3863	+ [ maybe_label(label_text, id), "<textarea ",format(opts)," id=\"",id,"\" name=\"",n,"\" cols=\"",w,"\" rows=\"",h,"\">",i,"</textarea>"],
	3864	+ file_upload(options, label, id, n, w) then
	3865	+ [ maybe_label(label, id),
	3866	+ "<input type=\"file\" id=\"",id,"\" size=\"",w,"\" name=\"",n,"\"",format_attrs(options)," />"],
	3867	+ selector(opts, label, id, n,s,cs) then
	3868	+ [ maybe_label(label, id),
	3869	+ "<select id=\"",id,"\" name=\"",n,"\" size=\"",s,"\" ",format_attrs(opts),">",format_choices(cs),"</select>"],
	3870	+ selector(opts, label, id, n,s,cs,sd) then
	3871	+ [ maybe_label(label, id),
	3872	+ "<select id=\"",id,"\" name=\"",n,"\" size=\"",s,"\" ",format_attrs(opts),">",format_choices(cs,sd),"</select>"],
	3873	+ selector_c(opts, label, id, n,s,cs) then
	3874	+ [ maybe_label(label, id),
	3875	+ "<select id=\"",id,"\" name=\"",n,"\" size=\"",s,"\" ",format_attrs(opts),">",format_choices(cs),"</select>"],
	3876	+ selector_c(opts, label, id, n,s,cs,sd) then
	3877	+ [ maybe_label(label, id),
	3878	+ "<select id=\"",id,"\" name=\"",n,"\" size=\"",s,"\" ",format_attrs(opts),">",format_choices(cs,sd),"</select>"],
	3879	+
	3880	+ radio_button(options, label_text, id, n, v, c) then
	3881	+ [ maybe_label(label_text, id),
	3882	+ "<input type=\"radio\" name=\"",n,"\" id=\"",id,"\" value=\"",v,"\"",(if c then " checked=\"checked\"" else ""),format_attrs(options)," />"],
	3883	+ radio_button_r(options, label_text, id, n, v, c) then
	3884	+ [ "<input type=\"radio\" name=\"",n,"\" id=\"",id,"\" value=\"",v,"\"",(if c then " checked=\"checked\"" else ""),format_attrs(options)," />",
	3885	+ maybe_label(label_text, id)],
	3886	+ check_box(options, label_text, id, n, v, c) then
	3887	+ [ maybe_label(label_text, id),
	3888	+ "<input type=\"checkbox\" name=\"",n,"\" id=\"",id,"\" value=\"",v,"\"",(if c then " checked=\"checked\" " else ""),format_attrs(options)," />"]
	3889	+ check_box_r(options, label_text, id, n, v, c) then
	3890	+ [ "<input type=\"checkbox\" name=\"",n,"\" id=\"",id,"\" value=\"",v,"\"",(if c then " checked=\"checked\" " else ""),format_attrs(options)," />",
	3891	+ maybe_label(label_text, id)]
	3892	+ div(options, e) then
	3893	+ format(cinfo,sn,ic_v,any_div(options, e),format_element,is_https),
	3894	+ div_empty(options) then
	3895	+ format(cinfo,sn,ic_v,any_div_empty(options),format_element,is_https),
	3896	+ hidden(name, value) then
	3897	+ ["<input type=\"hidden\" name=\"",name,"\" value=\"",value,"\" />"],
	3898	+
	3899	+ }.
	3900	+
	3901	+
	3902	+
	3903	+
	3904	+
	3905	+
	3906	+ *** [5.9] Formating 'off form' elements.
	3907	+
	3908	+ The encryption type 'multipart/form-data' is required for a form containing an upload.
	3909	+
	3910	+
	3911	+define Bool
	3912	+ contains_an_upload
	3913	+ (
	3914	+ HTML_In_Form form_content
	3915	+ ).
	3916	+
	3917	+define Bool
	3918	+ contains_an_upload
	3919	+ (
	3920	+ HTML_Row(HTML_In_Form) row
	3921	+ ) =
	3922	+ mapor(contains_an_upload,
	3923	+ map(content,cells(row))).
	3924	+
	3925	+define Bool
	3926	+ contains_an_upload
	3927	+ (
	3928	+ HTML_Footer_Row(HTML_In_Form) row
	3929	+ ) =
	3930	+ if row is
	3931	+ {
	3932	+ empty then false,
	3933	+ footer_row(_, cells) then
	3934	+ mapor(contains_an_upload,
	3935	+ map(content,cells))
	3936	+ }.
	3937	+
	3938	+define Bool
	3939	+ contains_an_upload
	3940	+ (
	3941	+ HTML_In_Form form_content
	3942	+ ) =
	3943	+ if form_content is
	3944	+ {
	3945	+ literal_pt(t) then false,
	3946	+ literal(t) then false,
	3947	+ sequence(l) then mapor(contains_an_upload,l)
	3948	+ text(o,t) then false,
	3949	+ preformated(o,s) then false,
	3950	+ paragraph(o,t) then false,
	3951	+ image(o,u,a) then false,
	3952	+ image(o,u,a,w,h) then false,
	3953	+ table(o,_,rows,f_row) then if mapor(contains_an_upload,rows) then true
	3954	+ else contains_an_upload(f_row),
	3955	+ center(e) then contains_an_upload(e),
	3956	+ mail_to(m,e) then false, // 'e' may but should not contain an upload
	3957	+ scroller(w,h,cw,ch,e) then contains_an_upload(e),
	3958	+ actioner(c,t,a,an,eo,ja) then false,
	3959	+ foreign_link_new(_,_,_) then false,
	3960	+ foreign_link(o,u) then false,
	3961	+ foreign_link(o,u,n) then false,
	3962	+ private_download(p,n,e,a) then false,
	3963	+ text_input(o,lt,l,n,i,w) then false,
	3964	+ text_input_ro(o,lt,l,n,i,w) then false,
	3965	+ password_input(o,lt,l,n,i,w) then false,
	3966	+ text_area(o,lt,id,n,i,w,h) then false,
	3967	+ file_upload(o,l,i,n,w) then true,
	3968	+ selector(o,l,i,n,s,c) then false,
	3969	+ selector(o,l,i,n,s,c,p) then false,
	3970	+ selector_c(o,l,i,n,s,c) then false,
	3971	+ selector_c(o,l,i,n,s,c,p) then false,
	3972	+ radio_button(o,_,_,n,v,c) then false,
	3973	+ radio_button_r(o,_,_,n,v,c) then false,
	3974	+ check_box(o,_,_,n,v,c) then false,
	3975	+ check_box_r(o,_,_,n,v,c) then false,
	3976	+ div(o,c) then contains_an_upload(c),
	3977	+ div_empty(o) then false,
	3978	+ hidden(_,_) then false
	3979	+ }.
	3980	+
	3981	+define String
	3982	+ enctype
	3983	+ (
	3984	+ HTML_In_Form form_content
	3985	+ ) =
	3986	+ if contains_an_upload(form_content)
	3987	+ then " enctype=\"multipart/form-data\""
	3988	+ else "".
	3989	+
	3990	+
	3991	+
	3992	+define Printable_tree
	3993	+ format
	3994	+ (
	3995	+ CommonInfo cinfo,
	3996	+ String sn, // state_name
	3997	+ Var(Int) ic_v, // 'idnum' counter variable
	3998	+ HTML_Off_Form element,
	3999	+ Bool is_https,
	4000	+ ) =
	4001	+ if cinfo is info(common_name,http_port,https_port,site_directory,secret) then
	4002	+ with format_element = (HTML_Off_Form e) \|-> format(cinfo,sn,ic_v,e,is_https),
	4003	+ if element is
	4004	+ {
	4005	+ literal_pt(t) then t,
	4006	+ literal(t) then [t],
	4007	+ sequence(l) then flat(map(format_element,l)),
	4008	+ text(opts,t) then
	4009	+ format(cinfo,sn,ic_v,any_text(opts,t),format_element,is_https),
	4010	+ preformated(o,s) then
	4011	+ format(cinfo,sn,ic_v,any_preformated(o,s),format_element,is_https),
	4012	+ paragraph(opts,t) then
	4013	+ format(cinfo,sn,ic_v,any_paragraph(opts,t),format_element,is_https),
	4014	+ image(opts,url,alt) then
	4015	+ format(cinfo,sn,ic_v,any_image(opts,url,alt),format_element,is_https),
	4016	+ image(opts,url,alt,w,h) then
	4017	+ format(cinfo,sn,ic_v,any_image(opts,url,alt,w,h),format_element,is_https),
	4018	+ table(opts,header_row, rows, footer_row) then
	4019	+ format(cinfo,sn,ic_v,any_table(opts,header_row, rows, footer_row),format_element,is_https),
	4020	+ center(e) then
	4021	+ format(cinfo,sn,ic_v,any_center(e),format_element,is_https),
	4022	+ mail_to(a,e) then
	4023	+ format(cinfo,sn,ic_v,any_mail_to(a,e),format_element,is_https),
	4024	+ scroller(w,h,cw,ch,c) then
	4025	+ format(cinfo,sn,ic_v,any_scroller(w,h,cw,ch,c),format_element,is_https),
	4026	+ fixed_size(w,h,c) then
	4027	+ format(cinfo,sn,ic_v,any_fixed_size(w,h,c),format_element,is_https),
	4028	+ fixed_size_2(w,h,fn) then
	4029	+ format(cinfo,sn,ic_v,any_fixed_size_2(w,h,fn),format_element,is_https),
	4030	+ actioner(c,t,a,an,eo,ja) then
	4031	+ format(cinfo,sn,ic_v,any_actioner(c,t,a,an,eo,ja,failure),format_element,is_https),
	4032	+ actioner(c,t,a,an,eo,ja,fn) then
	4033	+ format(cinfo,sn,ic_v,any_actioner(c,t,a,an,eo,ja,success(fn)),format_element,is_https),
	4034	+ foreign_link_new(target, aspect, url) then
	4035	+ format(cinfo,sn,ic_v,any_foreign_link_new(target,aspect,url),format_element,is_https),
	4036	+ foreign_link(options,url) then
	4037	+ format(cinfo,sn,ic_v,any_foreign_link(options,url),format_element,is_https),
	4038	+ foreign_link(options,url,name) then
	4039	+ format(cinfo,sn,ic_v,any_foreign_link(options,url,name),format_element,is_https),
	4040	+ private_download(url,name,extra,action) then
	4041	+ format(cinfo,sn,ic_v,any_private_download(url,name,extra,action),format_element,is_https),
	4042	+ label(n) then ["<a name=\"",n,"\">"],
	4043	+ form(fn,attributs, c) then
	4044	+ [
	4045	+ "<form id=\"",fn,"\"",
	4046	+ format(cinfo,sn,ic_v,any_coreattrs(attributs),format_element,is_https),
	4047	+ " method=\"post\"",
	4048	+ enctype(c),
	4049	+ " action=\"http",
	4050	+ if is_https then "s" else "",
	4051	+ "://",common_name,":",to_decimal(http_port),"/\">",
	4052	+ // action is set dynamically by
	4053	+ // the actioner using JavaScript
	4054	+ if fn is htmlId(id) then
	4055	+ format(cinfo,id,sn,ic_v,c,is_https),
	4056	+ "</form>"
	4057	+ ]
	4058	+ form(fn,attributs, action_name, extra_ops, c) then
	4059	+ with url = make_actioner_url(cinfo, same, same,
	4060	+ sn, action_name, extra_ops, is_https),
	4061	+ [
	4062	+ "<form id=\"",fn,"\"",
	4063	+ format(cinfo,sn,ic_v,any_coreattrs(attributs),format_element,is_https),
	4064	+ " method=\"post\"",
	4065	+ enctype(c),
	4066	+ " action=\"" + url + "\">",
	4067	+// " action=\"http",
	4068	+// if is_https then "s" else "",
	4069	+// "://",common_name,":",http_port,"/\">",
	4070	+ // action is set dynamically by
	4071	+ // the actioner using JavaScript
	4072	+ if fn is htmlId(id) then
	4073	+ format(cinfo,id,sn,ic_v,c,is_https),
	4074	+ "</form>"
	4075	+ ]
	4076	+ div(options, e) then
	4077	+ format(cinfo,sn,ic_v,any_div(options, e),format_element,is_https),
	4078	+ div_empty(options) then
	4079	+ format(cinfo,sn,ic_v,any_div_empty(options),format_element,is_https),
	4080	+
	4081	+ }.
	4082	+
	4083	+
	4084	+
	4085	+
	4086	+ *** [5.10] Formating meta-tags.
	4087	+
	4088	+define Printable_tree
	4089	+ format_keywords
	4090	+ (
	4091	+ List(String) l
	4092	+ ) =
	4093	+ if l is
	4094	+ {
	4095	+ [] then [ ],
	4096	+ [h . t] then if t is []
	4097	+ then [h]
	4098	+ else [h , ", " . format_keywords(t)]
	4099	+ }.
	4100	+
	4101	+
	4102	+define Printable_tree
	4103	+ format
	4104	+ (
	4105	+ CommonInfo cinfo,
	4106	+ String state_name,
	4107	+ HTML_Meta m,
	4108	+ Bool is_https
	4109	+ ) =
	4110	+ if m is
	4111	+ {
	4112	+ keywords(l) then ["<meta name=\"keywords\" content=\"",format_keywords(l),"\" />\n"],
	4113	+ refresh(co,ta,an,delay) then
	4114	+ ["<meta http-equiv=\"Refresh\" content=\"",delay,"; URL=",
	4115	+ make_actioner_url(cinfo,co,ta,state_name,an,[],is_https),"\" />\n"],
	4116	+ refresh(url,delay) then
	4117	+ ["<meta http-equiv=\"Refresh\" content=\"",delay,"; URL=",url,"\" />\n"],
	4118	+ meta(n,c) then ["<meta name=\"",n,"\" content=\"",c,"\" />\n"],
	4119	+ http_equiv(n,c) then ["<meta http-equiv=\"",n,"\" content=\"",c,"\" />\n"],
	4120	+ generic_meta(l) then ["<meta ",
	4121	+ flat(map(((String,String) p) \|-> if p is (n,v) then [n,"=\"",v,"\" "],
	4122	+ l)),
	4123	+ " />\n"],
	4124	+ literal(s) then [s]
	4125	+ }.
	4126	+
	4127	+
	4128	+define Printable_tree
	4129	+ format
	4130	+ (
	4131	+ CommonInfo cinfo,
	4132	+ String state_name,
	4133	+ List(HTML_Meta) metas,
	4134	+ Bool is_https,
	4135	+ String charset
	4136	+ ) =
	4137	+ if metas is
	4138	+ {
	4139	+ [] then [format(cinfo,state_name,http_equiv("content-type",
	4140	+ "text/html; charset="+charset),is_https)],
	4141	+ [h . t] then [format(cinfo,state_name,h,is_https)
	4142	+ . format(cinfo,state_name,t,is_https,charset)]
	4143	+ }.
	4144	+
	4145	+
	4146	+define Printable_tree
	4147	+ format
	4148	+ (
	4149	+ Body_Option o
	4150	+ ) =
	4151	+ if o is
	4152	+ {
	4153	+ core_attrs(core_attr_list) then [" " + format_attrs(core_attr_list)],
	4154	+ background_color(c) then [" bgcolor=\"" , (String)html_format(c), "\""],
	4155	+ background_image(n) then [" background=", n],
	4156	+ background_image(n,o2) then [" style=\"background: url(",n,")",format(o2),"\""]
	4157	+
	4158	+ }.
	4159	+
	4160	+
	4161	+
	4162	+define Printable_tree
	4163	+ format
	4164	+ (
	4165	+ List(Body_Option) l
	4166	+ ) =
	4167	+ if l is
	4168	+ {
	4169	+ [ ] then [ ],
	4170	+ [h . t] then [format(h) . format(t)]
	4171	+ }.
	4172	+
	4173	+define Printable_tree
	4174	+ add_css_files
	4175	+ (
	4176	+ List(CSS_File) l
	4177	+ ) =
	4178	+ if l is
	4179	+ {
	4180	+ [ ] then [ ],
	4181	+ [h . t] then
	4182	+ [ ["<link rel=\"stylesheet\" type=\"text/css\" href=\"" + file_name(h) + "\" />\n" ]
	4183	+ . add_css_files(t)]
	4184	+ }.
	4185	+
	4186	+define Printable_tree
	4187	+ add_js_files_attributes
	4188	+ (
	4189	+ List(JS_Attribute) l
	4190	+ ) =
	4191	+ if l is
	4192	+ {
	4193	+ [ ] then [ ],
	4194	+ [h . t] then
	4195	+ if h is attr(name, value) then
	4196	+ [ " " + name + "=\"" + value + "\""
	4197	+ . add_js_files_attributes(t)]
	4198	+ }.
	4199	+
	4200	+
	4201	+define Printable_tree
	4202	+ add_js_files
	4203	+ (
	4204	+ List(JS_File) l
	4205	+ ) =
	4206	+ if l is
	4207	+ {
	4208	+ [ ] then [ ],
	4209	+ [h . t] then
	4210	+ [ ["<script src=\""+ file_name(h) +"\" type=\"text/javascript\""
	4211	+ . add_js_files_attributes(attributes(h)) ]
	4212	+ . ["></script>\n"
	4213	+ . add_js_files(t)] ]
	4214	+ }.
	4215	+
	4216	+define Printable_tree
	4217	+ add_css_styles
	4218	+ (
	4219	+ List(CSS_Style) css_styles
	4220	+ ) =
	4221	+
	4222	+ if css_styles is
	4223	+ {
	4224	+ [] then [],
	4225	+ [_._] then [ "<style type=\"text/css\"><!--\n",
	4226	+ format_css_styles(css_styles),
	4227	+ " --></style>\n"
	4228	+ ]
	4229	+ }.
	4230	+
	4231	+define Printable_tree
	4232	+ format
	4233	+ (
	4234	+ CommonInfo cinfo,
	4235	+ String state_name,
	4236	+ List(HTTP_header) additional_headers,
	4237	+ HTTP_Answer page,
	4238	+ Bool is_https,
	4239	+ String charset
	4240	+ ) =
	4241	+ if cinfo is info(common_name,http_port,https_port,site_directory,secret) then
	4242	+ with ic_v = var((Int)0),
	4243	+ if page is
	4244	+ {
	4245	+ html_page(title,metas,css_styles, css_files, js_files, body) then
	4246	+ if body is body(options,element) then
	4247	+ with answer_body =
	4248	+ [ doctype_w3c_header,
	4249	+ "<html xmlns=\"http://www.w3.org/1999/xhtml\">\n",
	4250	+ "<head>\n",
	4251	+ add_css_styles(css_styles),
	4252	+ add_css_files(css_files),
	4253	+ add_js_files(js_files),
	4254	+ "<link rel=\"shortcut icon\" href=\"favicon.ico\" />\n",
	4255	+ "<script type = \"text/javascript\" language=\"JavaScript\">",
	4256	+ " function show_local_popup(divname,stvname) {",
	4257	+ " if (document.layers) { var d = eval(document.divname); } else\n",
	4258	+ " if (document.getElementById) { var d = eval(\"document.getElementById(divname)\"); } else\n",
	4259	+ " if (document.all) { var d = eval(document.all.divname.style)};\n",
	4260	+ // " alert(typeof(eval(stvname))); ",
	4261	+ " var s = eval(stvname); ",
	4262	+ " if (s[0]==0) ",
	4263	+ " { s[0]=1; d.style.visibility = 'visible'; d.zIndex = 100; } else\n",
	4264	+ " { s[0]=0; d.style.visibility = 'hidden'; }; }",
	4265	+ "</script>\n",
	4266	+ "<title>",title,"</title>\n", // put title
	4267	+ format(cinfo,state_name,metas,is_https,charset), // format the metas
	4268	+ "</head>\n",
	4269	+ "<body ", format(options), ">", // format body options
	4270	+ //"<center>",
	4271	+ format(cinfo,state_name,ic_v,element,is_https),
	4272	+ //"</center>",
	4273	+ "</body>\n",
	4274	+ "</html>"
	4275	+ ],
	4276	+ [ "HTTP/1.1 200 OK", crlf,
	4277	+ format_headers(standard_headers),
	4278	+ format_headers(standard_headers_for("text/html", length(answer_body), success(charset))),
	4279	+ format_headers(additional_headers),
	4280	+ crlf
	4281	+ . answer_body
	4282	+ ],
	4283	+
	4284	+ plain_text (String text) then
	4285	+ [ "HTTP/1.1 200 OK", crlf,
	4286	+ format_headers(standard_headers),
	4287	+ format_headers(standard_headers_for("text/plain", length(text), success(charset))),
	4288	+ format_headers(additional_headers),
	4289	+ crlf,
	4290	+ text . (Printable_tree)[]
	4291	+ ],
	4292	+
	4293	+ custom_text(String mime_type, String content) then
	4294	+ [ "HTTP/1.1 200 OK", crlf,
	4295	+ format_headers(standard_headers),
	4296	+ format_headers(standard_headers_for(mime_type, length(content), success(charset))),
	4297	+ format_headers(additional_headers),
	4298	+ crlf,
	4299	+ content . (Printable_tree)[]
	4300	+ ],
	4301	+ custom_binary(String mime_type, ByteArray content) then
	4302	+ [ "HTTP/1.1 200 OK", crlf,
	4303	+ format_headers(standard_headers),
	4304	+ format_headers(standard_headers_for(mime_type, length(content), failure)),
	4305	+ format_headers(additional_headers),
	4306	+ crlf,
	4307	+ content . (Printable_tree)[]
	4308	+ ],
	4309	+
	4310	+ custom_tree(String mime_type, Printable_tree content) then
	4311	+ [ "HTTP/1.1 200 OK", crlf,
	4312	+ format_headers(standard_headers),
	4313	+ format_headers(standard_headers_for(mime_type, length(content), success(charset))),
	4314	+ format_headers(additional_headers),
	4315	+ crlf .
	4316	+ content
	4317	+ ],
	4318	+
	4319	+ http_raw(Printable_tree content) then content
	4320	+ }.
	4321	+
...	...

MF_1_1/web/CXM_mime.anubis 0 → 100644

Wrap text Show/Hide comments View file @9ca943b

	1	+
	2	+ Project The Anubis Project
	3	+
	4	+ Title MIME Types definition.
	5	+
	6	+ Copyright Copyright (c) Alain Prouté 2005.
	7	+
	8	+
	9	+ Authors Alain Prouté
	10	+ David René
	11	+
	12	+
	13	+read tools/base64.anubis
	14	+read tools/basis.anubis
	15	+read system/string.anubis
	16	+
	17	+public type MIME:
	18	+ mime(String name,
	19	+ String file_extension).
	20	+
	21	+public define List(MIME)
	22	+ known_mime_types
	23	+ =
	24	+ [
	25	+ mime("application/octet-stream", ".exe"),
	26	+ mime("application/x-pdf", ".pdf"),
	27	+ mime("application/x-pdf", ".PDF"),
	28	+ mime("image/bmp", ".bmp"),
	29	+ mime("image/gif", ".gif"),
	30	+ mime("image/gif", ".GIF"),
	31	+ mime("image/jpeg", ".jpg"),
	32	+ mime("image/jpeg", ".JPG"),
	33	+ mime("image/jpeg", ".jpeg"),
	34	+ mime("image/png", ".png"),
	35	+ mime("image/png", ".PNG"),
	36	+ mime("image/x-icon", ".ico"),
	37	+ mime("text/html", ".html"),
	38	+ mime("text/html", ".htm"),
	39	+ mime("text/css", ".css"),
	40	+ mime("text/javascript", ".js"),
	41	+ mime("text/plain", ".txt"),
	42	+ mime("text/plain", ".anubis"),
	43	+ mime("text/plain", ".c"),
	44	+ mime("text/plain", ".h"),
	45	+ mime("text/plain", ".y"),
	46	+ mime("text/plain", "/Makefile"),
	47	+ mime("text/comma-separated-values", ".csv"),
	48	+ mime("application/msword", ".doc"),
	49	+ mime("application/octet-stream", ".emz"),
	50	+ mime("application/octet-stream", ".xml"),
	51	+ mime("application/octet-stream", ".mso"),
	52	+ mime("application/octet-stream", ".wmf"),
	53	+ mime("application/octet-stream", ".gz"),
	54	+ mime("application/octet-stream", ".rar"),
	55	+ mime("application/octet-stream", ".zip"),
	56	+ mime("application/octet-stream", ".card"),
	57	+ mime("application/octet-stream", ".ankh"),
	58	+ mime("application/octet-stream", ".adm"),
	59	+ mime("application/octet-stream", ".swf"),
	60	+ mime("application/octet-stream", ".downloaded"),
	61	+ mime("audio/x-mpeg", ".mp3"),
	62	+ mime("video/x-msvideo", ".avi"),
	63	+ ].
	64	+
	65	+public define String
	66	+ to_MIME_text
	67	+ (
	68	+ String charset,
	69	+ String text
	70	+ )=
	71	+ with text2 = "=?"+charset+"?B?"+to_string(base64_encode(to_byte_array(text)))+"?=",
	72	+ find_and_replace(text2, implode([13,10]), implode([13,10,32])).
...	...

MF_1_1/web/CXM_multihost_http_server.anubis 0 → 100644

Wrap text Show/Hide comments View file @9ca943b

	1	+
	2	+ Project The Anubis Project
	3	+
	4	+ Title A Multi Host HTTP/HTTPS Server
	5	+
	6	+ Copyright Copyright (c) Anubis Team 2003-2007.
	7	+
	8	+
	9	+ Authors Alain Prouté
	10	+ David René
	11	+ Cédric Ricard
	12	+
	13	+
	14	+ Revised July 2007.
	15	+
	16	+
	17	+
	18	+ Overviews
	19	+ In this file a HTTP/HTTPS server is defined, which is able to handle multiple hosts
	20	+ (virtual hosts). It answers HTTP/HTTPS requests, sends files (images or any other kind
	21	+ of file), constructs HTML pages on the fly using informations received from the client
	22	+ (when the URI ends by '.awp'), handles uploading of files and redirections. It is
	23	+ multitasking by itself, and can handle any number of sites and clients simultaneously.
	24	+ It should better be used in conjunction with 'making_a_web_site.anubis' to be found in
	25	+ the same directory. If you use 'web/making_a_web_site.anubis', you don't need to read
	26	+ this file.
	27	+
	28	+
	29	+ ----------------------------------- Table of Contents ---------------------------------
	30	+
	31	+ *** (1) Multihosting and redirections.
	32	+ *** (2) The incompatibility between SSL and virtual hosts.
	33	+ *** (3) HTTP headers and web arguments.
	34	+ *** (4) Site descriptions.
	35	+ *** (5) Protection against denial of service attacks.
	36	+ *** (6) Starting your HTTP and HTTPS servers.
	37	+ *** (7) Private download.
	38	+ *** (8) About web argument names.
	39	+ *** (9) A web dispatcher.
	40	+
	41	+ ---------------------------------------------------------------------------------------
	42	+
	43	+
	44	+
	45	+
	46	+ *** (1) Multihosting and redirections.
	47	+
	48	+ This HTTP/HTTPS server can handle several host (also called 'virtual hosts'), in other
	49	+ words, you may have several sites on the same server, with the same IP address and same
	50	+ port numbers, but distinct 'host names'.
	51	+
	52	+ A HTTP request sent by a browser contains the following informations:
	53	+
	54	+ - a 'host name',
	55	+ - an URI (Uniform Resource Identifier),
	56	+ - HTTP headers,
	57	+ - web arguments (in the form 'name=value').
	58	+
	59	+ Actually, the host name is just the value of the HTTP header whose name is 'Host'. The
	60	+ host name indicates which site is requested. Hence, it is the primary information for
	61	+ branching to the right site. If there is no 'Host' HTTP header in the request, the
	62	+ request is denied.
	63	+
	64	+ From now on, we may assume that the host is determined, and consequently that we are
	65	+ concerned by only one site. Each site has his own directories on the server's
	66	+ disk.
	67	+
	68	+ Each site also has a list of 'redirections'. A redirection is a triplet, like this one:
	69	+
	70	+ redirect("/", "www.our-business.com", "/homepage.awp")
	71	+
	72	+ meaning that if the host is "www.our-business.com", and if the requested URI is "/",
	73	+ then the URI to be served is "/homepage.awp". 'redirect' is a constructor of the type
	74	+ 'Redirection' defined in 'web/common.anubis'.
	75	+
	76	+ Now, an URI may end by ".awp" (meaning 'Anubis Web Page') or not. If it does, the
	77	+ server understands that an HTML page must be constructed on the fly, and to that end it
	78	+ calls the 'awp handler' of the site. Otherwise, the URI must end by a known extension,
	79	+ like ".jpg", ".png", ".txt", etc... and represents a file path relative to the
	80	+ 'public' directory of the site. If these conditions are satisfied, the file is sent to
	81	+ the client. Known extensions are recorded in 'web/mime.anubis'.
	82	+
	83	+
	84	+
	85	+
	86	+ *** (2) The incompatibility between SSL and virtual hosts.
	87	+
	88	+ Handling virtual hosts makes a problem under SSL (i.e. when using HTTPS), which is due
	89	+ to the fact that the guys at Netscape who designed SSL probably did not have the
	90	+ question of virtual hosts in mind. Indeed, the SSL handshake is completed before the
	91	+ server can know about the value of the 'Host' HTTP header, so that it cannot know which
	92	+ server certificate must be sent to the client. This makes a problem, because the
	93	+ browser will not accept a certificate whose common name does not correspond to the name
	94	+ of the requested host. The user will have to accept the certificate manually, which is
	95	+ not good for the security image of the site. This problem has at least two solutions
	96	+ (as far as Anubis is concerned).
	97	+
	98	+ Solution 1. Arrange so that the network interface on which the server is listening
	99	+ has at least as many different IP addresses as you have virtual hosts. Such
	100	+ supplementary IP addresses are called 'IP Aliases'. In this case, start one HTTPS
	101	+ server for each virtual host, each one listening on a different address. For the time
	102	+ being, this method is applicable under Anubis only if you start as many instances of
	103	+ 'anbexec' as you have virtual hosts, because each instance of 'anbexec' can handle only
	104	+ one server certificate. Of course, getting IP aliases is another problem to be solved
	105	+ with your Internet provider.
	106	+
	107	+ Solution 2. We propose a simple solution, using only one server certificate (hence
	108	+ only one instance of 'anbexec'). Since, we have only one server certificate, we must
	109	+ introduce a notion of 'main host', i.e. a host containing all other 'virtual
	110	+ hosts'. The unique server certificate belong to the main host, so that only the main
	111	+ host is identified by the client. The client must trust the main host and be confident
	112	+ that the main host redirects him to the right virtual host. Actually, the process will
	113	+ be transparent to the client, except that the client will see the name of the main host
	114	+ instead of the name of the virtual host in the 'location' field of the browser.
	115	+
	116	+ So, assume that the name of main host is 'www.securedhost.com', and that the names of
	117	+ the virtual hosts are:
	118	+
	119	+ actual name simplified name
	120	+ -----------------------------------------------------
	121	+ www.virtual1.com virtual1
	122	+ www.virtual2.com virtual2
	123	+ www.virtual3.com virtual3
	124	+
	125	+ Then the (confidential) document '/doc/my_document.pdf' on 'www.virtual2.com' will have
	126	+ the URL:
	127	+
	128	+ https://www.securedhost.com/virtual2/doc/my_document.pdf
	129	+
	130	+ In order to work transparently, this solution must combine HTTP and HTTPS. Indeed, the
	131	+ vitual host must have a first page reachable under HTTP, through the URL:
	132	+
	133	+ http://www.virtual2.com/
	134	+
	135	+ The HTTP server will redirect this URL to the awp handler of virtual host 'virtual2'.
	136	+ The handler of this virtual host is able to generate a first page containing the
	137	+ following HTML meta:
	138	+
	139	+ <meta http-equiv="Refresh" content="0;URL=https://www.securedhost.com/virtual2/">,
	140	+
	141	+ so that the client is immediately redirected to the main host under HTTPS (hence
	142	+ accepting tranparently the server certificate). The awp handler of 'virtual2' then
	143	+ redirects this URL to the home page (maybe a login page) of 'virtual2'.
	144	+
	145	+ See 'web/making_a_web_site.anubis' for the sequel of this story.
	146	+
	147	+
	148	+
	149	+
	150	+
	151	+ *** (3) HTTP headers and web arguments.
	152	+
	153	+ Each HTTP request which arrives on the server contains a request line followed by a
	154	+ series of HTTP headers. Each HTTP header is a pair '(name,value)' assigning a value to
	155	+ a name. The type 'HTTP_header' is defined in 'web/common.anubis'.
	156	+
	157	+ The request may also have a 'body'. The body contains either 'web arguments' or
	158	+ uploaded files (or both). The request line itself may also contain web arguments (in a
	159	+ so-called 'query string'). Like HTTP headers, 'web arguments' are pairs
	160	+ '(name,value)', but the difference is that these pairs are generated by the page within
	161	+ which the client clicks, while HTTP headers are generated by the browser itself. The
	162	+ type 'Web_arg' is defined in 'web/common.anubis'. It has two alternatives, one for
	163	+ ordinary web arguments (pairs) and one for uploaded files.
	164	+
	165	+read CXM_common.anubis
	166	+read tools/basis.anubis
	167	+read system/string.anubis
	168	+read system/files.anubis
	169	+read CXM_mime.anubis
	170	+
	171	+
	172	+
	173	+ *** (4) Site descriptions.
	174	+
	175	+ The type HTTP_Info gathers informations comming along with the client's request. These
	176	+ informations are rarely used for composing HTML pages. Nevertheless, they are at your
	177	+ disposal.
	178	+
	179	+public type HTTP_Info:
	180	+ http_info
	181	+ (
	182	+ Word32 ip_address, // IP address of the client
	183	+ String uri, // URI requested by the client
	184	+ List(HTTP_header) http_headers, // HTTP headers sent by the client
	185	+ One -> String generate_trust_ticket // may be used against denial of
	186	+ // service attacks
	187	+ ).
	188	+
	189	+
	190	+
	191	+ Each site is described by a 'web site description', which is a datum of type
	192	+ 'Web_Site_Description'.
	193	+
	194	+public type Web_Site_Description:
	195	+ web_site_description(
	196	+ List(String) common_names,
	197	+ String site_directory,
	198	+ Redirections redirections,
	199	+ String charset,
	200	+ List(String) journal_extensions,
	201	+ List(String) journal_headers,
	202	+ String authorization_secret,
	203	+ List(MIME) known_mime_types,
	204	+ (String host_name,
	205	+ HTTP_Info http_info,
	206	+ List(Web_arg) lwa,
	207	+ Bool is_https) -> (Printable_tree) awp_handler,
	208	+ (List(Web_arg) lwa) -> One before_send_file).
	209	+
	210	+ The component 'common_names' is the list of names of the site, like for example
	211	+ "www.our-business.com". The reason why we have a list of common names instead of a
	212	+ single common name, is that it may be useful to have a common name like "192.168.0.1"
	213	+ for testing.
	214	+
	215	+ 'charset' is a string which will determine the character encoding to be used by the
	216	+ browser. Typically, this string is one of: "UTF-8", "ISO-8859-1", "Windows-1252",
	217	+ etc...
	218	+
	219	+ 'journal_extensions' is the list of URI extensions for which you want a log in the
	220	+ journal (and on the console). When a request arrives, and if the extension is a member
	221	+ of this list, a message is printed into the journal of the site including the date, the
	222	+ IP address of the client, the complete HTTP request line. The HTTP headers whose name
	223	+ is a member of 'journal_headers' are also printed in the journal. A reasonable minimum
	224	+ for these two components is:
	225	+
	226	+ [".awp"] for journal_extensions
	227	+ ["user-agent"] for journal_headers
	228	+
	229	+ 'authorization_secret' is a string which should just be unguessable. You may choose
	230	+ something like (but don't choose this one !):
	231	+
	232	+ "Hg8kJe42gCML9jNH-74"
	233	+
	234	+ i.e. a sequence of characters typed at random, long enough to be unguessable. This is
	235	+ used by the 'private download' mecanism, which is discussed later in this file.
	236	+
	237	+ The component 'awp_handler' is a function of type:
	238	+
	239	+ (String host_name,
	240	+ HTTP_Info http_info,
	241	+ List(Web_arg) web_args,
	242	+ Bool is_https) -> Printable_tree
	243	+
	244	+ ('Printable_tree' is a substitute for 'String' and is defined in
	245	+ 'tools/basis.anubis'). This function is the 'awp handler' for the site. When the URI
	246	+ ends by ".awp", this function is called, and the result (an HTML page) is sent to the
	247	+ client over the connection. The last operand to this function is a boolean which is
	248	+ 'true' when the requests arrives through the HTTPS channel, and 'false' when it arrives
	249	+ through the HTTP channel.
	250	+
	251	+
	252	+
	253	+
	254	+
	255	+
	256	+
	257	+ *** (5) Protection against denial of service attacks.
	258	+
	259	+ We need to protect our servers against 'denial of service' attacks. The attack may be
	260	+ send automatically from machines which are infested by viruses. In that case, our
	261	+ server is saturated of connections (all virtual machines at work), but nothing is
	262	+ comming on the connections. In order to avoid this problem, we propose the following:
	263	+
	264	+ (1) Limit the number of simultaneous connections (say to 100).
	265	+ (2) Close a connection if the request is not complete after say 10 seconds.
	266	+ (3) Close the connection if the request is bigger than a given size (normal requests
	267	+ are small except when there are uploaded files.
	268	+ (4) Close the connection during the sending of the answer if the client is waiting
	269	+ too much.
	270	+ (5) Record all IP addresses with which we have encountered one of the problems above.
	271	+ (6) Immediately close the connections if the IP address is in our list.
	272	+ (7) Remove an address from the list only after 5 minutes of inactivity of this
	273	+ address.
	274	+ (8) Maintain a list of reliable IP addresses.
	275	+
	276	+ Of course, all the above are approximative solutions which may in some circumstances
	277	+ become either cumbersome or also partially block the system. So, it is needed to have a
	278	+ set of dynamically modifiable parameters in order to master the behavior of this
	279	+ mecanism.
	280	+
	281	+
	282	+ Each dubious IP address is recorded together with its last activity time.
	283	+
	284	+public type DubiousIP:
	285	+ dubious_ip (Word32 address,
	286	+ Int last_activity).
	287	+
	288	+
	289	+public type DenialOfService:
	290	+ denial_of_service(Var(Int) max_connections,
	291	+ Var(Int) request_line_delay, // seconds
	292	+ Var(Int) headers_delay,
	293	+ Var(Int) answer_delay,
	294	+ Var(List(DubiousIP)) list_of_dubious,
	295	+ Var(List(Word32)) reliable_addresses).
	296	+
	297	+ The informations in this set of variables are stored serialized into the file
	298	+ 'my_anubis/web_sites/dos_info'. If this file does not exist a set if variables with
	299	+ default values is created. The values are saved on the disk each time they are
	300	+ modified.
	301	+
	302	+public define DenialOfService load_denial_of_service_info.
	303	+
	304	+
	305	+
	306	+ *** (6) Starting your HTTP and HTTPS servers.
	307	+
	308	+ When your web site descriptions are ready, you can start a pair of servers (a HTTP
	309	+ server and a HTTPS server) for serving your web sites. Notice that there are always
	310	+ two servers, regardless of the number of web sites, and that each web sites normally
	311	+ uses the two servers.
	312	+
	313	+
	314	+public define StartServerResult
	315	+ start_http_server
	316	+ (
	317	+ Word32 ip_address,
	318	+ Word32 http_port,
	319	+ List(Web_Site_Description) web_sites,
	320	+ DenialOfService dos
	321	+ ).
	322	+
	323	+public define StartServerResult
	324	+ start_https_server
	325	+ (
	326	+ Word32 ip_address,
	327	+ Word32 https_port,
	328	+ String certificate_common_name,
	329	+ List(Web_Site_Description) web_sites,
	330	+ DenialOfService dos
	331	+ ).
	332	+
	333	+ The first argument 'ip_address' is the IP address on which the servers listen. If you
	334	+ put 0, the servers listen on all adresses of the machine (which is useful if the
	335	+ machine has several network interfaces). Otherwise, use the function 'ip_address'
	336	+ defined in 'tools/basis.anubis' for composing a particular IP address.
	337	+
	338	+ The next arguments are the port numbers for HTTP and HTTPS. The usual values are 80 and
	339	+ 443, but you may have reasons to choose other values.
	340	+
	341	+ The next argument is the list of your web site descriptions. All the sites described in
	342	+ this list will be accessible on the server.
	343	+
	344	+ The argument 'dos' is a set of dynamic variables containing the informations for
	345	+ protecting the servers against denial of service attacks.
	346	+
	347	+
	348	+
	349	+
	350	+
	351	+
	352	+ *** (7) Private download.
	353	+
	354	+ It may happen that you want to propose private files for download. This means that such
	355	+ a file could be downloaded only by the authorized person, and should not be seen by any
	356	+ other one. This feature can be used only under HTTPS, not under HTTP.
	357	+
	358	+ The file may be located anywhere on the server. Hence, the file has a complete absolute
	359	+ path, like for example:
	360	+
	361	+ /home/georges/my_documents/my_text.pdf
	362	+
	363	+ which has nothing to do with the directories of the web server. Now, you may also want
	364	+ to show another path or simply just a name to the client, not the actual absolute path
	365	+ above, which may need to remain secret. So for example, the same file may appear to the
	366	+ client as:
	367	+
	368	+ informations.pdf
	369	+
	370	+ The page must provide a link with an authorization. The authorization is just a web
	371	+ argument, whose name is "zauth". The value of this web argument is computed by hashing
	372	+ some secret string (known only from the programmer of the web site) with the absolute
	373	+ path of the file. The HTTPS request will have the form:
	374	+
	375	+ GET /informations.pdf?zauth=d38161f5b4e87e2d46e06ff8b3e233be563794d1
	376	+
	377	+ The server will search for a file named
	378	+
	379	+ zd38161f5b4e87e2d46e06ff8b3e233be563794d1
	380	+
	381	+ (i.e. "z" concatenated with the value of the authorization) in the subdirectory
	382	+ 'private_download' of the site directory. This file contains the absolute path of the
	383	+ file, i.e:
	384	+
	385	+ /home/georges/my_documents/my_text.pdf
	386	+
	387	+ At that point, the server may hash the secret string and the absolute path together, to
	388	+ check if the client is authorized to download the file. If it is the case, it sends the
	389	+ file (the MIME type is declared as 'application/octet-stream' if it is not recognized).
	390	+ The file is sent under the visible name.
	391	+
	392	+ The server creates automatically the subdirectory 'private_download/' within the 'site
	393	+ directory' (for each web site) if it does not already exist. Files in this directory
	394	+ are deleted when they become too old (for example, after 3 days of life).
	395	+
	396	+ Here is the function for computing the value of the authorization, and for making the
	397	+ authorization file in 'private_download'.
	398	+
	399	+public define String
	400	+ make_authorization
	401	+ (
	402	+ String site_directory,
	403	+ String authorization_secret, // known only by the programmer of the web site
	404	+ String absolute_path // on server
	405	+ ).
	406	+
	407	+ See 'web/making_a_web_site.anubis' for the construction of the link for downloading.
	408	+
	409	+
	410	+
	411	+
	412	+
	413	+
	414	+
	415	+
	416	+ *** (8) About web argument names.
	417	+
	418	+ The server reserves the name "zauth" for the authorization in the private download
	419	+ mecanism. Also, if the name of a web arguments begins by "p" (like 'password'), it does
	420	+ not print the value of the web argument neither on the console or in the journal. A
	421	+ good politics is to prefix all web arguments by letters distinct from 'p' and 'z'. This
	422	+ method is used in 'web/making_a_web_site.anubis'. This will avoid clashes of names.
	423	+
	424	+
	425	+
	426	+
	427	+
	428	+
	429	+ *** (9) A web dispatcher.
	430	+
	431	+ For hosting several sites you may prefer another method which we now describe. We start
	432	+ a HTTP server on port 80 (or on another port). This server is called the
	433	+ ``dispatcher''. When a requests arrives, the dispatcher examines the ``host'' HTTP
	434	+ header, so that it gets the name of the requested host. Then it sends to the client a
	435	+ page like this one:
	436	+
	437	+ <html>
	438	+ <head>
	439	+ <meta http-equiv="Refresh" content="0;URL=...">
	440	+ </head>
	441	+ <body>
	442	+ </body>
	443	+ </html>
	444	+
	445	+ where the URL represented by '...' is the URL of the requested site. This URL may have
	446	+ the same IP address as the dispatcher, except that the port number is different. It may
	447	+ also have a different IP address.
	448	+
	449	+ The dispatcher uses the file 'my_anubis/web_sites/dispatcher.info'. This file contains
	450	+ a serialized datum of type 'List(DispatcherInfo)'.
	451	+
	452	+public type DispatcherInfo:
	453	+ site(String common_name,
	454	+ Word32 http_port).
	455	+
	456	+ The dispatcher does not write into this file. It reads it when it starts, and rereads
	457	+ it each time the date of last modification of the file changes, so that the dispatcher
	458	+ always has up to date data. The file may be managed (written and updated) by another
	459	+ program.
	460	+
	461	+ So, for each site, the dispatcher knows the common name (needed to recognize the 'host'
	462	+ HTTP header), and the pair (ip_address,port) used by the actual site for HTTP. The
	463	+ dispatcher does not worry about HTTPS. HTTPS must be managed by the actual site.
	464	+
	465	+ The dispatcher is started by:
	466	+
	467	+public define One
	468	+ start_web_dispatcher
	469	+ (
	470	+ Word32 ip_address, // address for listening (typically 0)
	471	+ Word32 port, // typically 80
	472	+ DenialOfService dos
	473	+ ).
	474	+
	475	+ A command line tool for managing the file 'my_anubis/web_sites/dispatcher.info' is also
	476	+ provided:
	477	+
	478	+ global define One
	479	+ manage_web_dispatcher
	480	+ (
	481	+ List(String) args
	482	+ ).
	483	+
	484	+
	485	+
	486	+
	487	+
	488	+
	489	+
	490	+ --- That's all for the public part ! --------------------------------------------------
	491	+
	492	+define Maybe(String) get_host_header_value(List(HTTP_header) headers).
	493	+
	494	+define String
	495	+ utime_to_string
	496	+ (
	497	+ UTime t
	498	+ ) =
	499	+ to_decimal(t.seconds) + "." + zero_pad_n(6, t.microseconds ) + "s".
	500	+
	501	+
	502	+variable UTime t0 = utime(0,0).
	503	+variable UTime t1 = utime(0,0).
	504	+
	505	+define One
	506	+ accumulate_t1
	507	+ (
	508	+ UTime start
	509	+ ) =
	510	+ with delta = (UTime)unow - start,
	511	+ t1 <- delta + *t1;
	512	+ unique.
	513	+
	514	+variable UTime t2 = utime(0,0).
	515	+
	516	+define One
	517	+ accumulate_t2
	518	+ (
	519	+ UTime start
	520	+ ) =
	521	+ with delta = (UTime)unow - start,
	522	+ t2 <- delta + *t2;
	523	+ unique.
	524	+
	525	+
	526	+public define One
	527	+ print_delta
	528	+ (
	529	+ String txt
	530	+ ) =
	531	+ println(utime_to_string((UTime)unow - *t0) + " : " + txt).
	532	+
	533	+
	534	+ ----------------------------------- Table of Contents ---------------------------------
	535	+
	536	+ *** [1] Types which are private to this file.
	537	+
	538	+ *** [2] Tools.
	539	+ *** [2.1] Formating an error message.
	540	+ *** [2.2] Converting IP addresses.
	541	+ *** [2.3] Reading and unputting characters.
	542	+ *** [2.4] Reading and discarding characters.
	543	+ *** [2.5] Reading a character string.
	544	+ *** [2.6] Padding integers with zeros.
	545	+ *** [2.7] Converting web arguments to ASCII.
	546	+ *** [2.8] Server description.
	547	+
	548	+ *** [3] Managing the journal.
	549	+ *** [3.1] Naming journal files.
	550	+ *** [3.2] Formating HTTP headers.
	551	+ *** [3.3] Formating web arguments.
	552	+ *** [3.4] Formating the whole request.
	553	+ *** [3.5] Putting it in the journal file (and on the console).
	554	+
	555	+ *** [4] Reading the HTTP request.
	556	+ *** [4.1] Skipping leading blanks.
	557	+ *** [4.2] Reading a new line.
	558	+ *** [4.3] Reading a 'word'.
	559	+ *** [4.4] Separating the URI from the query string.
	560	+ *** [4.5] Reading the web arguments.
	561	+ *** [4.7] Reading the request line.
	562	+ *** [4.8] Reading the HTTP headers.
	563	+ *** [4.9] Getting the size of the request's body.
	564	+ *** [4.10] Reading the body of the request.
	565	+
	566	+ *** [5] Making the HTTP answer.
	567	+ *** [5.1] Avoiding illegal URIs.
	568	+ *** [5.2] Managing authorizations for downloading private files.
	569	+ *** [5.3] Recognizing MIME types.
	570	+ *** [5.4] Formating HTTP headers.
	571	+ *** [5.5] Sending a file.
	572	+ *** [5.6] Answering a www-url encoded request.
	573	+ *** [5.7] Answering a multipart/form-data encoded request.
	574	+ *** [5.7.1] Finding the boundary.
	575	+ *** [5.7.2] Reading attributes from a multipart entity.
	576	+ *** [5.7.3] Creating a temporary filename for an uploaded file.
	577	+ *** [5.7.4] Saving an uploaded file under a temporary filename.
	578	+ *** [5.7.5] Removing the path from a file name.
	579	+ *** [5.7.6] Reading a multipart entity.
	580	+ *** [5.8] Handling redirections.
	581	+ *** [5.9] Answering both sorts of requests.
	582	+
	583	+ *** [6] The HTTP/HTTPS servers.
	584	+ *** [6.1] The HTTP request handler.
	585	+ *** [6.2] Server's tasks.
	586	+ *** [6.3] Starting the HTTP/HTTPS servers.
	587	+
	588	+ *** [7] The web dispatcher.
	589	+ *** [7.1] The dispatcher server.
	590	+ *** [7.2] The dispatcher web site.
	591	+ *** [7.3] Managing the info file.
	592	+
	593	+ ---------------------------------------------------------------------------------------
	594	+
	595	+
	596	+
	597	+
	598	+read tools/basis.anubis
	599	+read tools/findstring.anubis
	600	+read tools/connections.anubis
	601	+
	602	+
	603	+
	604	+
	605	+
	606	+ *** [1] Types which are private to this file.
	607	+
	608	+ We use the following self-explanatory types.
	609	+
	610	+type Error:
	611	+ cannot_read_from_connection,
	612	+ not_get_or_post_request(String),
	613	+ end_of_line_expected,
	614	+ incorrect_content_length_value,
	615	+ colon_expected,
	616	+ timeout(Int).
	617	+
	618	+type HTTP_RequestType:
	619	+ get,
	620	+ post.
	621	+
	622	+type HTTP_RequestLine:
	623	+ request_line (HTTP_RequestType type,
	624	+ String uri,
	625	+ List(Web_arg) query_string).
	626	+
	627	+type EncodingType:
	628	+ www_url,
	629	+ multipart_form_data.
	630	+
	631	+type BufferedConnection:
	632	+ buffered_connection(Connection conn,
	633	+ Var(ByteArray) buffer,
	634	+ Var(Int) read_pos).
	635	+
	636	+
	637	+
	638	+ *** [2] Tools.
	639	+
	640	+ *** [2.1] Formating an error message.
	641	+
	642	+ The next function formats an error message.
	643	+
	644	+define String
	645	+ format
	646	+ (
	647	+ Error msg
	648	+ ) =
	649	+ if msg is
	650	+ {
	651	+ cannot_read_from_connection then
	652	+ "Cannot read from connection.\n",
	653	+ not_get_or_post_request(s) then
	654	+ "The request did not begin by 'GET' or 'POST': "+s+".\n",
	655	+ end_of_line_expected then
	656	+ "End of line expected.\n",
	657	+ incorrect_content_length_value then
	658	+ "Incorrect value for HTTP header 'Content-Length'.\n",
	659	+ colon_expected then
	660	+ "':' was expected.\n",
	661	+ timeout(n) then
	662	+ //"time out: "+n+"\n"
	663	+ //"time out.\n"
	664	+ ""
	665	+ }.
	666	+
	667	+
	668	+
	669	+
	670	+
	671	+
	672	+ *** [2.2] Converting IP addresses.
	673	+
	674	+ We need two conversion functions for IP addresses:
	675	+
	676	+ (Word8,Word8,Word8,Word8) --> Word32 ip_address
	677	+ Word32 --> String ip_addr_to_string
	678	+
	679	+ These conversions are defined in 'tools/basis.anubis'.
	680	+
	681	+
	682	+
	683	+
	684	+
	685	+
	686	+
	687	+
	688	+ *** [2.3] Reading and unputting characters.
	689	+
	690	+ We need a mecanism for unputting several characters (actually at least 3). This is
	691	+ because when reading the client connection, we must sometimes go ahead several
	692	+ characters, and virtually put them back into the connection, so that they can be
	693	+ reread. Of course, we do not send them back to the client. We store them in a list
	694	+ (hold by the variable 'unput_chars'), and we manage this list, so that characters may
	695	+ be virtually put back in the connection (this is called 'unputting').
	696	+
	697	+variable List(Word8) unput_chars = [].
	698	+
	699	+ The most recently read one is the head of list. Fortunately, this variable is private
	700	+ to this virtual machine (hence to this client).
	701	+
	702	+
	703	+define One
	704	+ unput // unputting a character (add it in front of the list)
	705	+ (
	706	+ Word8 character
	707	+ ) =
	708	+ unput_chars <- (List(Word8))[character . *unput_chars].
	709	+
	710	+
	711	+
	712	+define One record_dubious_IP(Word32 addr,DenialOfService dos).
	713	+
	714	+variable Int sttm = 0. // contains the start time for this connection.
	715	+
	716	+define Result(Error,Word8)
	717	+ record_dubious_connection
	718	+ (
	719	+ Connection conn,
	720	+ Int dead_line,
	721	+ DenialOfService dos,
	722	+ ) =
	723	+ if remote_IP_address_and_port(conn) is (addr,port) then
	724	+ record_dubious_IP(addr,dos);
	725	+ print("Recording IP address "+ip_addr_to_string(addr)+
	726	+ " as dubious after "+(dead_line-*sttm)+" seconds. Total: "+
	727	+ length(*list_of_dubious(dos))+"\n");
	728	+ error(timeout(dead_line)).
	729	+
	730	+define String
	731	+ pid
	732	+ =
	733	+ "[" + virtual_machine_id + "] ".
	734	+
	735	+
	736	+define One
	737	+ put
	738	+ (
	739	+ ByteArray source,
	740	+ ByteArray dest,
	741	+ Int position,
	742	+ Int i
	743	+ ) =
	744	+ if nth(i,source) is
	745	+ {
	746	+ failure then unique,
	747	+ success(b) then if put(dest,position,b) is
	748	+ {
	749	+ failure then unique,
	750	+ success(_) then put(source,dest,position+1,i+1)
	751	+ }
	752	+ }.
	753	+
	754	+define ReadResult
	755	+ read_from_connexion
	756	+ (
	757	+ BufferedConnection connection,
	758	+ Int size,
	759	+ Int time_out,
	760	+ ByteArray result_buffer,
	761	+ Int position
	762	+ ) =
	763	+ //println(pid + "read_from_connexion(" + size + ")");
	764	+
	765	+ if connection.read_pos < length(connection.buffer) then
	766	+ //println(pid + " reading from buffer (size = " + length(connection.buffer) + ", pos = " + connection.read_pos);
	767	+ //with t1_tmp = (UTime) unow,
	768	+ with result = extract(connection.buffer, connection.read_pos, *connection.read_pos + size),
	769	+ size_read = length(result),
	770	+ put(result,result_buffer,position,0);
	771	+ connection.read_pos <- *connection.read_pos + size_read;
	772	+ //accumulate_t1(t1_tmp);
	773	+ if size > size_read then
	774	+ //println("Wanted " + size + ", read only " + size_read);
	775	+
	776	+ terminal read_from_connexion(connection, size - size_read, time_out, result_buffer,position+size_read)
	777	+// {
	778	+// error then error,
	779	+// timeout then ok(result),
	780	+// ok(ba) then ok(result + ba)
	781	+// }
	782	+ else
	783	+ ok(result_buffer)
	784	+ else
	785	+ //if unow > dead_line then record_dubious_connection(connection,dead_line,dos) else
	786	+ if read(connection.conn, 16384, time_out) is // the connection is closed after 10 minutes of inactivity
	787	+ {
	788	+ error then println(pid + "read failed)"); error,
	789	+ timeout then timeout,
	790	+ ok(ba) then
	791	+// println(pid + "ba = " + length(ba));
	792	+ connection.buffer <- ba;
	793	+ connection.read_pos <- 0;
	794	+ //println(pid + "rb = " + length(*read_buffer));
	795	+
	796	+ terminal read_from_connexion(connection, size, time_out, result_buffer,position)
	797	+ }.
	798	+
	799	+define Result(Error,Word8)
	800	+ next_char // reading a character (check the list first, and read on the connection
	801	+ // only when the list is empty).
	802	+ (
	803	+ BufferedConnection connection,
	804	+ Int dead_line,
	805	+ DenialOfService dos
	806	+ ) =
	807	+ //with t2_tmp = (UTime) now,
	808	+ if *unput_chars is
	809	+ {
	810	+ [ ] then
	811	+ // ///////////////////
	812	+ // Buffered reading
	813	+ //if unow > dead_line then record_dubious_connection(connection,dead_line,dos) else
	814	+ if nth(connection.read_pos, connection.buffer) is
	815	+ {
	816	+ failure then
	817	+ if read_from_connexion(connection,1,600, constant_byte_array(1,0),0) is // the connection is closed after 10 minutes of inactivity
	818	+ {
	819	+ error then /accumulate_t2(t2_tmp);/ error(cannot_read_from_connection),
	820	+ timeout then /accumulate_t2(t2_tmp);/ error(timeout(600)),
	821	+ //record_dubious_connection(connection,dead_line,dos),
	822	+ ok(ba) then if nth(0,ba) is
	823	+ {
	824	+ failure then /accumulate_t2(t2_tmp);/ error(cannot_read_from_connection),
	825	+ success(c) then
	826	+ //println("-" + pid + "read [" + implode([c]) + "]\t");
	827	+ //accumulate_t2(t2_tmp);
	828	+ ok(c)
	829	+ }
	830	+ },
	831	+ success(c) then
	832	+ connection.read_pos <- *connection.read_pos + 1;
	833	+ //accumulate_t2(t2_tmp);
	834	+ ok(c)
	835	+ },
	836	+
	837	+ // ///////////////////
	838	+ // standard reading
	839	+// if read(connection.conn, 1, 600) is // the connection is closed after 10 minutes of inactivity
	840	+// {
	841	+// error then accumulate_t2(t2_tmp); println(pid + "read failed)"); error(cannot_read_from_connection),
	842	+// timeout then accumulate_t2(t2_tmp); error(timeout(600)),
	843	+// ok(ba) then if nth(0,ba) is
	844	+// {
	845	+// failure then accumulate_t2(t2_tmp); error(cannot_read_from_connection),
	846	+// success(c) then accumulate_t2(t2_tmp);
	847	+// ok(c)
	848	+// }
	849	+// },
	850	+
	851	+ [h . t] then
	852	+ unput_chars <- t; //accumulate_t2(t2_tmp);
	853	+ ok(h)
	854	+ }.
	855	+
	856	+
	857	+
	858	+
	859	+
	860	+
	861	+ *** [2.4] Reading and discarding characters.
	862	+
	863	+ The next function reads the specified number of bytes (this is the same as
	864	+ 'characters') from the connection and discards them. This is used for discarding CR LF
	865	+ just before the body of a request.
	866	+
	867	+define Result(Error,One)
	868	+ read_and_ignore
	869	+ (
	870	+ BufferedConnection connection, // to client
	871	+ Int dead_line,
	872	+ Int number_of_characters, // number of characters to read and ignore
	873	+ DenialOfService dos
	874	+ ) =
	875	+ if number_of_characters =< 0 then ok(unique) else
	876	+ if next_char(connection, dead_line, dos) is
	877	+ {
	878	+ error(msg) then error(msg),
	879	+ ok(c) then read_and_ignore(connection,dead_line,number_of_characters-1,dos)
	880	+ }.
	881	+
	882	+
	883	+
	884	+
	885	+
	886	+
	887	+
	888	+ *** [2.5] Reading a character string.
	889	+
	890	+ Sometimes values of HTTP attributes or web args are presented in the form of double
	891	+ quoted strings. The next function handles the reading of such things. The leading
	892	+ double quote is already read in. We must read subsequent characters until the next non
	893	+ backslashed double quote.
	894	+
	895	+define Result(Error,String)
	896	+ read_string
	897	+ (
	898	+ BufferedConnection connection, // connection with the client
	899	+ Int dead_line,
	900	+ List(Word8) so_far, // characters read so far (in reverse order)
	901	+ DenialOfService dos
	902	+ ) =
	903	+ if next_char(connection, dead_line,dos) is
	904	+ {
	905	+ error(msg) then error(msg),
	906	+ ok(c) then
	907	+ if c = '\\'
	908	+ then if next_char(connection,dead_line,dos) is
	909	+ {
	910	+ error(msg) then error(msg),
	911	+ ok(d) then
	912	+ if d = '\"'
	913	+ then read_string(connection,dead_line,['\"' . so_far],dos)
	914	+ else read_string(connection,dead_line,[d, c . so_far],dos)
	915	+ }
	916	+ else if c = '\"'
	917	+ then ok(implode(reverse(so_far)))
	918	+ else read_string(connection,dead_line,[c . so_far],dos)
	919	+ }.
	920	+
	921	+
	922	+
	923	+
	924	+
	925	+
	926	+
	927	+
	928	+
	929	+
	930	+
	931	+
	932	+ *** [2.7] Converting web arguments to ASCII.
	933	+
	934	+ The function 'web_to_ascii' gets a character string and replaces web encoding by normal
	935	+ ASCII encoding. This amounts to replacing:
	936	+
	937	+ + by blank
	938	+ %xx by the character whose ASCII code is xx in hexadecimal
	939	+
	940	+ Note: We assume that '9' < 'A' (which is the case for ASCII code).
	941	+
	942	+
	943	+
	944	+define Word8
	945	+ web_decode
	946	+ (
	947	+ Word8 x1,
	948	+ Word8 x2
	949	+ ) =
	950	+ with n1 = if x1 +=< '9' then (x1 - '0') else (x1 - 'A' + 10),
	951	+ n2 = if x2 +=< '9' then (x2 - '0') else (x2 - 'A' + 10),
	952	+ (n1 << 4) + n2.
	953	+
	954	+
	955	+
	956	+define String
	957	+ web_to_ascii
	958	+ (
	959	+ String web_string,
	960	+ Int n, // current position in web_string
	961	+ List(Word8) so_far
	962	+ ) =
	963	+ if nth(n,web_string) is
	964	+ {
	965	+ failure then implode(reverse(so_far)),
	966	+ success(c) then
	967	+ if c = '+'
	968	+ then web_to_ascii(web_string,n+1,[' ' . so_far])
	969	+ else if c = '%'
	970	+ then if nth(n+1,web_string) is
	971	+ {
	972	+ failure then implode(reverse(so_far)),
	973	+ success(x1) then if nth(n+2,web_string) is
	974	+ {
	975	+ failure then implode(reverse(so_far)),
	976	+ success(x2) then web_to_ascii(web_string,n+3,[web_decode(x1,x2) . so_far])
	977	+ }
	978	+ }
	979	+ else web_to_ascii(web_string,n+1,[c . so_far])
	980	+ }.
	981	+
	982	+
	983	+
	984	+
	985	+
	986	+
	987	+
	988	+
	989	+ *** [3] Managing the journal.
	990	+
	991	+ Concurrently working machines should not try to access the same file at the same
	992	+ time. This problem may be solved by using the 'protect' mecanism.
	993	+
	994	+
	995	+
	996	+ *** [3.1] Naming journal files.
	997	+
	998	+ Since journal messages are rather prolific, we should have at least one file per
	999	+ hour. Hence, the name of a journal file must be constructed from the current year,
	1000	+ month, day and hour. For example, it may be:
	1001	+
	1002	+ 2003_03_12_19
	1003	+
	1004	+ (this is for the journal of 7 PM to 8 PM, 2003/mar/12).
	1005	+
	1006	+define String
	1007	+ make_current_journal_file_name
	1008	+ =
	1009	+ if convert_time(now) is date_and_time(y,m,d,h,_,_,_,_,_) then
	1010	+ to_decimal(y)+"_"+
	1011	+ zero_pad_n(2,m)+"_"+
	1012	+ zero_pad_n(2,d)+"_"+
	1013	+ zero_pad_n(2,h).
	1014	+
	1015	+
	1016	+
	1017	+
	1018	+
	1019	+
	1020	+
	1021	+ *** [3.2] Formating HTTP headers.
	1022	+
	1023	+ HTTP headers may be shown on the console or written in the journal. The function below
	1024	+ formats a list of HTTP headers.
	1025	+
	1026	+define String
	1027	+ show_format
	1028	+ (
	1029	+ Web_Site_Description desc,
	1030	+ List(HTTP_header) headers,
	1031	+ ) =
	1032	+ if headers is
	1033	+ {
	1034	+ [ ] then "",
	1035	+ [h . t] then if h is http_header(name,value) then
	1036	+ if member(journal_headers(desc),name)
	1037	+ then " \| "+name+": "+value+"\n"+show_format(desc,t)
	1038	+ else show_format(desc,t)
	1039	+ }.
	1040	+
	1041	+
	1042	+
	1043	+
	1044	+
	1045	+
	1046	+ *** [3.3] Formating web arguments.
	1047	+
	1048	+ The same thing for web arguments.
	1049	+
	1050	+define String
	1051	+ show_format
	1052	+ (
	1053	+ List(Web_arg) lwa
	1054	+ ) =
	1055	+ if lwa is
	1056	+ {
	1057	+ [ ] then "",
	1058	+ [h . t] then if h is
	1059	+ {
	1060	+ web_arg(n,v) then
	1061	+ " \| "+n+"="+(if nth(0,n) = success('p') then "<not shown>" else v)+"\n"+show_format(t),
	1062	+ upload(n,fn,tfn) then
	1063	+ " \| "+n+"="+fn+" (uploaded as '"+tfn+"')\n"+show_format(t)
	1064	+ }
	1065	+ }.
	1066	+
	1067	+
	1068	+
	1069	+
	1070	+
	1071	+
	1072	+ *** [3.4] Formating the whole request.
	1073	+
	1074	+ It is cheap to transform month numbers into abbreviated month names. This enhances the
	1075	+ readability of the journal.
	1076	+
	1077	+define String
	1078	+ format_month
	1079	+ (
	1080	+ Int m
	1081	+ ) =
	1082	+ if m = 1 then "jan" else
	1083	+ if m = 2 then "feb" else
	1084	+ if m = 3 then "mar" else
	1085	+ if m = 4 then "apr" else
	1086	+ if m = 5 then "may" else
	1087	+ if m = 6 then "jun" else
	1088	+ if m = 7 then "jul" else
	1089	+ if m = 8 then "aug" else
	1090	+ if m = 9 then "sep" else
	1091	+ if m = 10 then "oct" else
	1092	+ if m = 11 then "nov" else
	1093	+ if m = 12 then "dec" else
	1094	+ "???".
	1095	+
	1096	+
	1097	+ Below we format a whole HTTP request. This may give this (actually, it depends on how
	1098	+ you defined the values of 'journal_headers' and 'journal_extensions'):
	1099	+
	1100	+ [3] 2003/mar/10 10:06:57 from 123.456.123.456: /homepage.awp
	1101	+ \| host: www.the-best-one.com
	1102	+ \| user-agent: Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.0.1) Gecko/20020823 Netscape/7.0
	1103	+
	1104	+ The leading number between brackets is the number of the virtual machine which served
	1105	+ the URI.
	1106	+
	1107	+define String
	1108	+ format_request
	1109	+ (
	1110	+ Web_Site_Description desc,
	1111	+ Connection client_connection,
	1112	+ HTTP_RequestLine request_line,
	1113	+ List(HTTP_header) headers,
	1114	+ List(Web_arg) web_args
	1115	+ ) =
	1116	+ with dt = convert_time(now),
	1117	+ if remote_IP_address_and_port(client_connection) is (addr,port) then
	1118	+ to_decimal(year(dt))+"/"+format_month(month(dt))+"/"+zero_pad_n(2,day(dt))+" "+
	1119	+ zero_pad_n(2,hour(dt))+":"+zero_pad_n(2,minute(dt))+":"+zero_pad_n(2,second(dt))+
	1120	+ " from "+ip_addr_to_string(addr)+
	1121	+ ": "+uri(request_line)+"\n"+
	1122	+ show_format(desc,headers)+
	1123	+ show_format(web_args).
	1124	+
	1125	+
	1126	+
	1127	+
	1128	+
	1129	+
	1130	+
	1131	+ *** [3.5] Putting it in the journal file (and on the console).
	1132	+
	1133	+ We must not forget to 'protect' this operation, so that the messages of two machines
	1134	+ (working for the same site) will not be mixed together.
	1135	+
	1136	+define One
	1137	+ log_journal_msg
	1138	+ (
	1139	+ Web_Site_Description desc,
	1140	+ String msg,
	1141	+ ) =
	1142	+ with ba_msg = to_byte_array("["+virtual_machine_id+"] "+msg+"\n"),
	1143	+ protect
	1144	+ (
	1145	+ if file(site_directory(desc)+"/journal/"+make_current_journal_file_name,append) is
	1146	+ {
	1147	+ failure then unique,
	1148	+ success(journal_file) then
	1149	+ forget(reliable_write(file(journal_file),ba_msg))
	1150	+ };
	1151	+ forget(reliable_write(file(stdout),ba_msg))
	1152	+ ).
	1153	+
	1154	+
	1155	+
	1156	+
	1157	+
	1158	+
	1159	+
	1160	+ *** [4] Reading the HTTP request.
	1161	+
	1162	+
	1163	+ *** [4.1] Skipping leading blanks.
	1164	+
	1165	+ One of the peculiarities of HTTP is that the characters 13 (carriage return) and 10
	1166	+ (line feed) followed by either a space (32) or a tab (9), is considered as a blank not
	1167	+ containing any new line. 'skip_http_blanks' must skip all blanks characters until the
	1168	+ first non blank character, which should not be read in. Obviously, because of the above
	1169	+ peculiarity, we need at least 3 characters of lookahead to do this. In other words, we
	1170	+ must be able to unput at least 3 characters (hopefully we are).
	1171	+
	1172	+ Strictly blanks characters are 'space' and 'tab'.
	1173	+
	1174	+define Bool
	1175	+ is_strict_blank
	1176	+ (
	1177	+ Word8 c
	1178	+ ) =
	1179	+ if c = ' ' then true else c = '\t'.
	1180	+
	1181	+
	1182	+ On the contrary, blanks include 13 and 10.
	1183	+
	1184	+define Bool
	1185	+ is_blank
	1186	+ (
	1187	+ Word8 c
	1188	+ ) =
	1189	+ if c = ' ' then true else
	1190	+ if c = '\t' then true else
	1191	+ if c = 13 then true else
	1192	+ c = 10.
	1193	+
	1194	+
	1195	+ Skipping HTTP blanks.
	1196	+
	1197	+define Result(Error,One)
	1198	+ skip_http_blanks
	1199	+ (
	1200	+ BufferedConnection connection,
	1201	+ Int dead_line,
	1202	+ DenialOfService dos
	1203	+ ) =
	1204	+ if next_char(connection,dead_line,dos) is
	1205	+ {
	1206	+ error(msg) then error(msg),
	1207	+ ok(c) then
	1208	+ if is_strict_blank(c)
	1209	+ then skip_http_blanks(connection,dead_line,dos)
	1210	+ else if c = 13
	1211	+ then if next_char(connection,dead_line,dos) is
	1212	+ {
	1213	+ error(msg) then error(msg), // (unput(c); ok(unique)),
	1214	+ ok(d) then
	1215	+ if d = 10
	1216	+ then if next_char(connection,dead_line,dos) is
	1217	+ {
	1218	+ error(msg) then error(msg), // (unput(d); unput(c); ok(unique)),
	1219	+ ok(e) then
	1220	+ if is_strict_blank(e)
	1221	+ then skip_http_blanks(connection,dead_line,dos)
	1222	+ else (unput(e); unput(d); unput(c); ok(unique))
	1223	+ }
	1224	+ else (unput(d); unput(c); ok(unique))
	1225	+ }
	1226	+ else (unput(c); ok(unique))
	1227	+ }.
	1228	+
	1229	+
	1230	+
	1231	+
	1232	+
	1233	+
	1234	+
	1235	+
	1236	+ *** [4.2] Reading a new line.
	1237	+
	1238	+ Normally in HTTP a new line is the sequence 13 10 (carriage return line feed), not
	1239	+ followed by a space or tabulator. If it is followed by a space or tabulator, the three
	1240	+ characters are considered blanks, and no new line has been read. Before trying to read
	1241	+ a new line, we first skip leading spaces and tabs. Then we try to read 13 and 10, and
	1242	+ we read another character. if this character is space or tab, we consider we have read
	1243	+ only blanks and we continue reading in order to find our new line. Otherwise, we unput
	1244	+ this character (which may be for example the first character of the name of the next
	1245	+ header), and answer that we have seen a new line.
	1246	+
	1247	+ Warning: we must not use this function for reading the last pair (13,10) before the
	1248	+ beginning of the body, because if the body is empty, there is no character to read
	1249	+ after this pair, so that the server could wait for a character which will never
	1250	+ come. This is the reason for 'read_and_ignore' above, which is used precisely for
	1251	+ reading that last (13,10) pair.
	1252	+
	1253	+define Result(Error,One)
	1254	+ read_new_line
	1255	+ (
	1256	+ BufferedConnection connection,
	1257	+ Int dead_line,
	1258	+ DenialOfService dos
	1259	+ ) =
	1260	+ if skip_http_blanks(connection,dead_line,dos) is
	1261	+ {
	1262	+ error(msg) then error(msg),
	1263	+ ok(_) then
	1264	+ if next_char(connection,dead_line,dos) is
	1265	+ {
	1266	+ error(msg) then error(msg),
	1267	+ ok(c) then
	1268	+ if c = 13
	1269	+ then if next_char(connection,dead_line,dos) is
	1270	+ {
	1271	+ error(msg) then error(msg),
	1272	+ ok(d) then
	1273	+ if d = 10
	1274	+ then ok(unique)
	1275	+ else (unput(d);
	1276	+ unput(c);
	1277	+ error(end_of_line_expected))
	1278	+ }
	1279	+ else (unput(c);
	1280	+ error(end_of_line_expected))
	1281	+ }}.
	1282	+
	1283	+
	1284	+
	1285	+
	1286	+
	1287	+
	1288	+
	1289	+
	1290	+ *** [4.3] Reading a 'word'.
	1291	+
	1292	+ A 'word' is a sequence of characters which begins either by a double quote or not by a
	1293	+ double quote. (However, any leading blanks are read in and ignored. This is
	1294	+ accomplished by 'skip_http_blanks'.) If it begins by a double quote, it is read like a
	1295	+ string, i.e. it ends at the next (non backslashed) double quote. Otherwise, it is
	1296	+ right delimited by any character which may be considered as 'blank'. If the word is
	1297	+ double quoted, the closing double quote is read in. On the contrary, if the word is not
	1298	+ double quoted, the right delimiting blank character is not read in (it is 'unput' back
	1299	+ into the connection), and may be read in again. This is needed because carriage return
	1300	+ or line feed which are 'blank', also have a meaning in HTTP.
	1301	+
	1302	+define Result(Error,String)
	1303	+ read_word_aux
	1304	+ (
	1305	+ BufferedConnection connection,
	1306	+ Int dead_line,
	1307	+ List(Word8) so_far,
	1308	+ DenialOfService dos
	1309	+ ) =
	1310	+ if next_char(connection,dead_line,dos) is
	1311	+ {
	1312	+ error(msg) then error(msg),
	1313	+ ok(c) then
	1314	+ if is_blank(c)
	1315	+ then (unput(c);
	1316	+ ok(implode(reverse(so_far))))
	1317	+ else read_word_aux(connection,dead_line,[c . so_far],dos)
	1318	+ }.
	1319	+
	1320	+define Result(Error,String)
	1321	+ read_word
	1322	+ (
	1323	+ BufferedConnection connection,
	1324	+ Int dead_line,
	1325	+ DenialOfService dos
	1326	+ ) =
	1327	+ if skip_http_blanks(connection,dead_line,dos) is
	1328	+ {
	1329	+ error(msg) then error(msg),
	1330	+ ok(_) then
	1331	+ if next_char(connection,dead_line,dos) is
	1332	+ {
	1333	+ error(msg) then error(msg),
	1334	+ ok(c) then
	1335	+ if c = '\"'
	1336	+ then read_string(connection,dead_line,[],dos)
	1337	+ else read_word_aux(connection,dead_line,[c],dos)
	1338	+ }
	1339	+ }.
	1340	+
	1341	+
	1342	+
	1343	+
	1344	+
	1345	+
	1346	+
	1347	+
	1348	+ *** [4.4] Separating the URI from the query string.
	1349	+
	1350	+ A 'query string' may be postfixed to the URI, just after a question mark. For example,
	1351	+ the client may send the following request:
	1352	+
	1353	+ GET /catalog.awp?item=3&color=blue
	1354	+
	1355	+ We separate this into an URI: "/catalog.awp" and the string: "item=3&color=blue" which
	1356	+ will be later transformed into the list:
	1357	+
	1358	+ [web_arg("item","3"),web_arg("color","blue")]
	1359	+
	1360	+
	1361	+define (String,String)
	1362	+ separate_uri_from_query_string
	1363	+ (
	1364	+ String uri_and_query_string,
	1365	+ Int n
	1366	+ ) =
	1367	+ if nth(n,uri_and_query_string) is
	1368	+ {
	1369	+ failure then (uri_and_query_string,""),
	1370	+ success(c) then
	1371	+ if c = '?'
	1372	+ then (substr(uri_and_query_string,0,n),
	1373	+ substr(uri_and_query_string,n+1,length(uri_and_query_string)-(n+1)))
	1374	+ else separate_uri_from_query_string(uri_and_query_string,n+1)
	1375	+ }.
	1376	+
	1377	+
	1378	+
	1379	+
	1380	+
	1381	+
	1382	+
	1383	+
	1384	+
	1385	+ *** [4.5] Reading the web arguments.
	1386	+
	1387	+ HTTP/HTTPS requests are sent in one of two formats:
	1388	+
	1389	+ (1) www-url encoded
	1390	+ (2) multipart/form-data encoded
	1391	+
	1392	+ The first one is the normal (historical) way of encoding. The second one is required
	1393	+ for uploading files. A server which is supposed to accept upload of files must handle
	1394	+ both formats. The first thing to do is to decide the format of the request. This is
	1395	+ easily done by examining the HTTP headers. If we find the header:
	1396	+
	1397	+ Content-Type: multipart/form-data
	1398	+
	1399	+ the request is multipart/form-data encoded. Otherwise, it is 'www-url' encoded. We
	1400	+ first consider 'www-url' encoded requests.
	1401	+
	1402	+ For a 'www-url' encoded request, the web argument are either in the query string or in
	1403	+ the body of the request, or both. The format is the same for both:
	1404	+
	1405	+ name=value&name=value&...
	1406	+
	1407	+ However, we may also have
	1408	+
	1409	+ name
	1410	+ name=
	1411	+ name=&...
	1412	+ name&...
	1413	+
	1414	+ i.e. some parts may be missing. Hence, we must be careful.
	1415	+
	1416	+ Furthermore, web arguments must be translated from web to ASCII when www-url encoded.
	1417	+
	1418	+define Bool
	1419	+ is_ampersand_or_equal
	1420	+ (
	1421	+ Word8 c
	1422	+ ) =
	1423	+ if c = '&' then true else c = '='.
	1424	+
	1425	+
	1426	+
	1427	+ The function 'read_name_or_value' reads the string 's' starting at position 'n' until
	1428	+ either the end of the string or the first '&' or '='.
	1429	+
	1430	+define String
	1431	+ read_name_or_value
	1432	+ (
	1433	+ String s,
	1434	+ Int start,
	1435	+ Int i
	1436	+ ) =
	1437	+ if nth(i,s) is
	1438	+ {
	1439	+ failure then substr(s,start,i - start),
	1440	+ success(c) then
	1441	+ if is_ampersand_or_equal(c)
	1442	+ then substr(s,start,i-start) // the separator is not included
	1443	+ else read_name_or_value(s,start,i+1)
	1444	+ }.
	1445	+
	1446	+
	1447	+define List(Web_arg)
	1448	+ read_www_url_encoded_web_args
	1449	+ (
	1450	+ String s,
	1451	+ Int start,
	1452	+ ) =
	1453	+ with first = read_name_or_value(s,start,start),
	1454	+ if first = ""
	1455	+ then []
	1456	+ else with i = start+length(first),
	1457	+ if nth(i,s) is
	1458	+ {
	1459	+ failure then [web_arg(first,"")],
	1460	+ success(c) then
	1461	+ if c = '&'
	1462	+ then [web_arg(first,"") . read_www_url_encoded_web_args(s,i+1)]
	1463	+ else if c = '='
	1464	+ then with second1 = read_name_or_value(s,i+1,i+1),
	1465	+ // print("\""+second1+"\"\n");
	1466	+ with second = web_to_ascii(second1,0,[]),
	1467	+ [web_arg(first,second) . read_www_url_encoded_web_args(s,i+length(second1)+2)]
	1468	+ else print("** ALERT ** badly formatted argument [" + s + "]!!!\n");
	1469	+ []
	1470	+ }.
	1471	+
	1472	+
	1473	+
	1474	+
	1475	+
	1476	+ *** [4.7] Reading the request line.
	1477	+
	1478	+ 'read_request_line' reads three words and a new line from the connection. It tries to
	1479	+ recognize "get" or "post" in the first word, separates the URI from the query string in
	1480	+ the second word, transforms the query string into a list of 'Web_arg', and finally
	1481	+ returns a datum of type 'HTTP_RequestLine' if no error arose.
	1482	+
	1483	+
	1484	+define Result(Error,HTTP_RequestType)
	1485	+ identify_get_or_post
	1486	+ (
	1487	+ String s
	1488	+ ) =
	1489	+ with ls = to_lower(s),
	1490	+ if ls = "get" then ok(get) else
	1491	+ if ls = "post" then ok(post) else
	1492	+ error(not_get_or_post_request(ls)).
	1493	+
	1494	+define Result(Error,HTTP_RequestLine)
	1495	+ read_request_line
	1496	+ (
	1497	+ BufferedConnection connection,
	1498	+ Int dead_line,
	1499	+ DenialOfService dos
	1500	+ ) =
	1501	+ if read_word(connection,dead_line,dos) is
	1502	+ {
	1503	+ error(msg) then error(msg),
	1504	+ ok(get_or_post) then if read_word(connection,dead_line,dos) is
	1505	+ {
	1506	+ error(msg) then error(msg),
	1507	+ ok(uri_and_query_string) then if read_word(connection,dead_line,dos) is
	1508	+ {
	1509	+ error(msg) then error(msg),
	1510	+ ok(http_version) then if read_new_line(connection,dead_line,dos) is
	1511	+ {
	1512	+ error(msg) then error(msg),
	1513	+ ok(_) then if separate_uri_from_query_string(uri_and_query_string,0) is
	1514	+ (uri,query_string) then if identify_get_or_post(get_or_post) is
	1515	+ {
	1516	+ error(msg) then error(msg),
	1517	+ ok(request_type) then
	1518	+ ok(request_line(request_type,uri,read_www_url_encoded_web_args(query_string,0)))
	1519	+ }
	1520	+ }
	1521	+ }
	1522	+ }
	1523	+ }.
	1524	+
	1525	+
	1526	+
	1527	+
	1528	+
	1529	+
	1530	+
	1531	+ *** [4.8] Reading the HTTP headers.
	1532	+
	1533	+ Each header is made of a name (containing only letters, the underscore, digits and the
	1534	+ minus sign), a colon, a value, and a new line. The first empty line ends the headers.
	1535	+
	1536	+
	1537	+ The next function tests characters acceptable in a header name.
	1538	+
	1539	+define Bool
	1540	+ is_header_name_char
	1541	+ (
	1542	+ Word8 c
	1543	+ ) =
	1544	+ if ('a' +=< c & c +=< 'z') then true else
	1545	+ if ('A' +=< c & c +=< 'Z') then true else
	1546	+ if ('0' +=< c & c +=< '9') then true else
	1547	+ if c = '-' then true else
	1548	+ c = '_'.
	1549	+
	1550	+define Result(Error,String)
	1551	+ read_header_name
	1552	+ (
	1553	+ BufferedConnection connection,
	1554	+ Int dead_line,
	1555	+ List(Word8) so_far,
	1556	+ DenialOfService dos
	1557	+ ) =
	1558	+ if next_char(connection,dead_line,dos) is
	1559	+ {
	1560	+ error(msg) then error(msg),
	1561	+ ok(c) then
	1562	+ if is_header_name_char(c)
	1563	+ then read_header_name(connection,dead_line,[to_lower(c) . so_far],dos)
	1564	+ else unput(c); ok(implode(reverse(so_far)))
	1565	+ }.
	1566	+
	1567	+define Result(Error,One)
	1568	+ skip_colon
	1569	+ (
	1570	+ BufferedConnection connection,
	1571	+ Int dead_line,
	1572	+ DenialOfService dos
	1573	+ ) =
	1574	+ if skip_http_blanks(connection,dead_line,dos) is
	1575	+ {
	1576	+ error(msg) then error(msg),
	1577	+ ok(_) then
	1578	+ if next_char(connection,dead_line,dos) is
	1579	+ {
	1580	+ error(msg) then error(msg),
	1581	+ ok(c) then
	1582	+ if c = ':'
	1583	+ then ok(unique)
	1584	+ else error(colon_expected)
	1585	+ }}.
	1586	+
	1587	+
	1588	+define Result(Error,String)
	1589	+ read_header_value
	1590	+ (
	1591	+ BufferedConnection connection,
	1592	+ Int dead_line,
	1593	+ List(Word8) so_far,
	1594	+ DenialOfService dos
	1595	+ ) =
	1596	+ if next_char(connection,dead_line,dos) is
	1597	+ {
	1598	+ error(msg) then error(msg),
	1599	+ ok(c) then
	1600	+ if c = 13
	1601	+ then if next_char(connection,dead_line,dos) is
	1602	+ {
	1603	+ error(msg) then error(msg),
	1604	+ ok(d) then
	1605	+ if d = 10
	1606	+ then if next_char(connection,dead_line,dos) is
	1607	+ {
	1608	+ error(msg) then error(msg),
	1609	+ ok(e) then
	1610	+ if is_strict_blank(e)
	1611	+ then read_header_value(connection,dead_line,[e . so_far],dos)
	1612	+ else (unput(e); ok(implode(reverse(so_far))))
	1613	+ }
	1614	+ else read_header_value(connection,dead_line,[d, c . so_far],dos)
	1615	+ }
	1616	+ else read_header_value(connection,dead_line,[c . so_far],dos)
	1617	+ }.
	1618	+
	1619	+
	1620	+ Reading a single header.
	1621	+
	1622	+define Result(Error,Maybe(HTTP_header))
	1623	+ read_header
	1624	+ (
	1625	+ BufferedConnection connection,
	1626	+ Int dead_line,
	1627	+ DenialOfService dos
	1628	+ ) =
	1629	+ if read_header_name(connection,dead_line,[],dos) is
	1630	+ {
	1631	+ error(msg) then error(msg),
	1632	+ ok(name) then
	1633	+ if name = "" then
	1634	+ if read_and_ignore(connection,dead_line,2,dos) /* 13 and 10 */ is
	1635	+ {
	1636	+ error(msg) then error(msg),
	1637	+ ok(_) then // this is the blank line
	1638	+ ok(failure) // end of headers
	1639	+ }
	1640	+ else if skip_colon(connection,dead_line,dos) is
	1641	+ {
	1642	+ error(msg) then error(msg),
	1643	+ ok(_) then if skip_http_blanks(connection,dead_line,dos) is
	1644	+ {
	1645	+ error(msg) then error(msg),
	1646	+ ok(_) then if read_header_value(connection,dead_line,[],dos) is
	1647	+ {
	1648	+ error(msg) then error(msg),
	1649	+ ok(value) then
	1650	+ ok(success(http_header(name,value)))
	1651	+ }
	1652	+ }
	1653	+ }
	1654	+ }.
	1655	+
	1656	+
	1657	+
	1658	+ Reading all the headers.
	1659	+
	1660	+define Result(Error,List(HTTP_header))
	1661	+ read_http_headers
	1662	+ (
	1663	+ BufferedConnection connection,
	1664	+ Int dead_line,
	1665	+ DenialOfService dos
	1666	+ ) =
	1667	+ if read_header(connection,dead_line,dos) is
	1668	+ {
	1669	+ error(msg) then error(msg),
	1670	+ ok(mbh) then if mbh is
	1671	+ {
	1672	+ failure then ok([ ]),
	1673	+ success(header) then
	1674	+ if read_http_headers(connection,dead_line,dos) is
	1675	+ {
	1676	+ error(msg) then error(msg),
	1677	+ ok(others) then ok([header . others])
	1678	+ }
	1679	+ }
	1680	+ }.
	1681	+
	1682	+
	1683	+
	1684	+
	1685	+
	1686	+
	1687	+
	1688	+ *** [4.9] Getting the size of the request's body.
	1689	+
	1690	+ The size of the body of the request is given under the 'Content-Length' header. If this
	1691	+ header is not present, the size is assumed to be zero.
	1692	+
	1693	+define Result(Error,Int)
	1694	+ get_body_size
	1695	+ (
	1696	+ List(HTTP_header) headers
	1697	+ ) =
	1698	+ if headers is
	1699	+ {
	1700	+ [ ] then ok(0),
	1701	+ [h . t] then if h is http_header(name,value) then
	1702	+ if name = "content-length"
	1703	+ then if decimal_scan(value) is
	1704	+ {
	1705	+ failure then error(incorrect_content_length_value),
	1706	+ success(n) then ok(n)
	1707	+ }
	1708	+ else get_body_size(t)
	1709	+ }.
	1710	+
	1711	+
	1712	+
	1713	+
	1714	+
	1715	+
	1716	+
	1717	+
	1718	+
	1719	+
	1720	+ *** [4.10] Reading the body of the request.
	1721	+
	1722	+ The body of the request may be very big (it contains uploaded files, if any). We read
	1723	+ it using the primitive 'read', which returns the number of bytes read, which may be
	1724	+ less than the number of bytes we wanted to read. This is not an error, but simply due
	1725	+ to the fact the buffer associated with the connection in the Linux (or MS-Windows)
	1726	+ kernel has a limited size. Hence, we must read bytes again until we have read the
	1727	+ required number of bytes. However, if the number of bytes read is zero, the connection
	1728	+ may be broken. In that case, we must not try to read indefinitely. On the contrary, we
	1729	+ make at most 10 retries, with a small sleeping time between any two of them.
	1730	+
	1731	+define Result(Error,ByteArray)
	1732	+ read_http_body
	1733	+ (
	1734	+ BufferedConnection connection,
	1735	+ Int body_size,
	1736	+ ByteArray so_far, // when calling this function, 'so_far' is the empty byte array
	1737	+ Int retries // this function is called with retries = 10
	1738	+ ) =
	1739	+ if body_size = 0 then ok(constant_byte_array(0,0)) else
	1740	+ if retries =< 0 then error(cannot_read_from_connection) else
	1741	+ if read_from_connexion(connection,body_size,60,constant_byte_array(body_size,0),0) is
	1742	+ {
	1743	+ error then error(cannot_read_from_connection),
	1744	+ timeout then error(timeout(60)),
	1745	+ ok(new_bytes) then with
	1746	+ ba = so_far + new_bytes, // contains all the bytes read so far
	1747	+ nr = length(ba), // total read since the beginning
	1748	+ nn = length(new_bytes), // number of bytes just read
	1749	+ if nr < body_size // must read more bytes
	1750	+ then if nn > 0 // if connection seems to work
	1751	+ then read_http_body(connection,body_size,ba,1000) // continue reading
	1752	+ else sleep(100); // otherwise, sleep 1/10 of second
	1753	+ read_http_body(connection,body_size,ba, // and retry reading
	1754	+ retries-1) // but no more than 10 times
	1755	+ else ok(ba) // required number of bytes has been read
	1756	+ }.
	1757	+
	1758	+
	1759	+ Note: During sleeping, 'anbexec' runs other machines. Actually, calling 'sleep', even
	1760	+ for one millisecond, is some way of giving up explicitly, so that other virtual
	1761	+ machines may work.
	1762	+
	1763	+
	1764	+
	1765	+
	1766	+
	1767	+
	1768	+
	1769	+
	1770	+
	1771	+
	1772	+
	1773	+
	1774	+ *** [5] Making the HTTP answer.
	1775	+
	1776	+ At that point we have read the request line, the headers and the body of the
	1777	+ request, and we must decide what to do.
	1778	+
	1779	+ Actually, we can do one of the following:
	1780	+
	1781	+ - send a file,
	1782	+ - execute 'tickets_and_web_page' in case of an ".awp" URI.
	1783	+
	1784	+ The uploaded file (which are in the body of the request) are saved into temporary files
	1785	+ below.
	1786	+
	1787	+
	1788	+
	1789	+
	1790	+
	1791	+ *** [5.1] Avoiding illegal URIs.
	1792	+
	1793	+ For security reasons, we must avoid illegal URIs, for example those which may climb up
	1794	+ in the file hierarchy. First we accept only few characters in URIs.
	1795	+
	1796	+define Bool
	1797	+ is_legal_uri_char
	1798	+ (
	1799	+ Word8 c
	1800	+ ) =
	1801	+ if ('a' +=< c & c +=< 'z') then true else // accept 'a' to 'z'
	1802	+ if ('A' +=< c & c +=< 'Z') then true else // accept 'A' to 'Z'
	1803	+ if ('0' +=< c & c +=< '9') then true else // accept '0' to '9'
	1804	+ if c = '.' then true else // accept '.' '-' '/' and '_'
	1805	+ if c = '-' then true else
	1806	+ if c = '/' then true else
	1807	+ c = '_'.
	1808	+
	1809	+ We do not accept ~ which is some way of climbing. Of course, we cannot disallow single
	1810	+ dots, which are most often present in legal URIs, but we must avoid double dots ..
	1811	+ which mean 'climb up'.
	1812	+
	1813	+define Bool
	1814	+ is_illegal_uri
	1815	+ (
	1816	+ String uri,
	1817	+ Int n
	1818	+ ) =
	1819	+ if nth(n,uri) is
	1820	+ {
	1821	+ failure then false,
	1822	+ success(c) then
	1823	+ if c = '.' // first dot
	1824	+ then if nth(n+1,uri) is
	1825	+ {
	1826	+ failure then false,
	1827	+ success(d) then
	1828	+ if d = '.' // second dot
	1829	+ then true
	1830	+ else is_illegal_uri(uri,n+1)
	1831	+ }
	1832	+ else is_illegal_uri(uri,n+1)
	1833	+ }.
	1834	+
	1835	+
	1836	+
	1837	+
	1838	+
	1839	+
	1840	+ *** [5.2] Managing authorizations for downloading private files.
	1841	+
	1842	+ Computing the authorization and making the authorization file (containing the absolute
	1843	+ path of the file on the server).
	1844	+
	1845	+
	1846	+define String
	1847	+ compute_authorization
	1848	+ (
	1849	+ String authorization_secret,
	1850	+ String absolute_path
	1851	+ ) =
	1852	+ to_ascii(sha1((authorization_secret,
	1853	+ absolute_path))).
	1854	+
	1855	+
	1856	+public define String
	1857	+ make_authorization
	1858	+ (
	1859	+ String site_directory,
	1860	+ String authorization_secret,
	1861	+ String absolute_path
	1862	+ ) =
	1863	+ with private_download_dir = site_directory+"/private_download",
	1864	+ auth = compute_authorization(authorization_secret,
	1865	+ absolute_path),
	1866	+ forget(save(absolute_path,
	1867	+ private_download_dir+"/z"+auth));
	1868	+ auth.
	1869	+
	1870	+
	1871	+ The function 'send_file' defined below handles the recognition of authorizations.
	1872	+
	1873	+
	1874	+
	1875	+
	1876	+
	1877	+ *** [5.3] Recognizing MIME types.
	1878	+
	1879	+ The extension of the (redirected) URI must be either ".awp" or recognized as associated
	1880	+ to a MIME type. Otherwise, the server will not send the file. This is for security, but
	1881	+ also because, we must generate a 'Content-Type' header in the answer, with the right
	1882	+ MIME type.
	1883	+
	1884	+define String
	1885	+ get_uri_extension_aux
	1886	+ (
	1887	+ String uri,
	1888	+ Int n // used for searching backwards
	1889	+ ) =
	1890	+ if nth(n,uri) is
	1891	+ {
	1892	+ failure then "",
	1893	+ success(c) then
	1894	+ if c = '.' then substr(uri,n,length(uri)-n)
	1895	+ else if c = '/' then ""
	1896	+ else get_uri_extension_aux(uri,n-1)
	1897	+ }.
	1898	+
	1899	+public define String
	1900	+ get_uri_extension
	1901	+ (
	1902	+ String uri
	1903	+ ) =
	1904	+ get_uri_extension_aux(uri,
	1905	+ length(uri)-1). // search starts at the right end
	1906	+
	1907	+
	1908	+
	1909	+define Maybe(String)
	1910	+ recognize_mime_type_from_ext
	1911	+ (
	1912	+ String ext,
	1913	+ List(MIME) l
	1914	+ ) =
	1915	+ if l is
	1916	+ {
	1917	+ [ ] then success("application/octet-stream"), // failure,
	1918	+ [h . t] then if h is mime(mime_type,extension) then
	1919	+ if ext = extension
	1920	+ then success(mime_type)
	1921	+ else recognize_mime_type_from_ext(ext,t)
	1922	+ }.
	1923	+
	1924	+define Maybe(String)
	1925	+ recognize_mime_type_from_uri
	1926	+ (
	1927	+ Web_Site_Description desc,
	1928	+ String uri
	1929	+ ) =
	1930	+ recognize_mime_type_from_ext(get_uri_extension(uri),known_mime_types(desc)).
	1931	+
	1932	+
	1933	+
	1934	+
	1935	+
	1936	+
	1937	+
	1938	+
	1939	+ *** [5.4] Formating HTTP headers.
	1940	+
	1941	+ This is the formating for sending to the client (hence, it has nothing to do with the
	1942	+ component 'journal_headers' in the web site description).
	1943	+
	1944	+public define Printable_tree
	1945	+ format_headers
	1946	+ (
	1947	+ List(HTTP_header) headers
	1948	+ ) =
	1949	+ if headers is
	1950	+ {
	1951	+ [ ] then [ ],
	1952	+ [h . t] then if h is http_header(name,value) then
	1953	+ [name,": ",value,crlf . format_headers(t)]
	1954	+ }.
	1955	+
	1956	+
	1957	+
	1958	+define String
	1959	+ month_abrv
	1960	+ (
	1961	+ Date_and_Time d
	1962	+ ) =
	1963	+ if d.month = 1 then "Jan"
	1964	+ else if d.month = 2 then "Feb"
	1965	+ else if d.month = 3 then "Mar"
	1966	+ else if d.month = 4 then "Apr"
	1967	+ else if d.month = 5 then "May"
	1968	+ else if d.month = 6 then "Jun"
	1969	+ else if d.month = 7 then "Jul"
	1970	+ else if d.month = 8 then "Aug"
	1971	+ else if d.month = 9 then "Sep"
	1972	+ else if d.month = 10 then "Oct"
	1973	+ else if d.month = 11 then "Nov"
	1974	+ else if d.month = 12 then "Dec"
	1975	+ else
	1976	+ println("Bad month value [" + d.month + "] on Date_and_Time");
	1977	+ "XXX".
	1978	+
	1979	+define String
	1980	+ weekday_abrv
	1981	+ (
	1982	+ Date_and_Time d
	1983	+ ) =
	1984	+ if d.week_day = 0 then "Sun"
	1985	+ else if d.week_day = 1 then "Mon"
	1986	+ else if d.week_day = 2 then "Tue"
	1987	+ else if d.week_day = 3 then "Wed"
	1988	+ else if d.week_day = 4 then "Thu"
	1989	+ else if d.week_day = 5 then "Fri"
	1990	+ else if d.week_day = 6 then "Sat"
	1991	+ else
	1992	+ println("Bad weekday value [" + d.week_day + "] on Date_and_Time");
	1993	+ "XXX".
	1994	+
	1995	+/**
	1996	+ * Format a date with the followin format : "Mon, 23 Jul 2007 11:33:43 GMT"
	1997	+ * Currently, this function can't output a GMT time, but only local time.
	1998	+ * So the final GMT is totally fake, but needed by protocol.
	1999	+ */
	2000	+public define String
	2001	+ format_http_date
	2002	+ (
	2003	+ Date_and_Time d
	2004	+ ) =
	2005	+ weekday_abrv(d) + ", " + zero_pad_n(2,day(d)) + " " + month_abrv(d) + " " + year(d)
	2006	+ + " " + zero_pad_n(2,hour(d)) + ":" + zero_pad_n(2,minute(d)) + ":" + zero_pad_n(2,second(d)) + " GMT".
	2007	+
	2008	+/**
	2009	+ * Same as previous format_http_date() function, but with seconds count from the UNIX epoch as input.
	2010	+ */
	2011	+public define String
	2012	+ format_http_date
	2013	+ (
	2014	+ Int date
	2015	+ ) =
	2016	+ format_http_date(convert_time(date)).
	2017	+
	2018	+
	2019	+ *** [5.5] Sending a file.
	2020	+
	2021	+ We send 2 headers 'Content-Type' and 'Content-Length'.
	2022	+
	2023	+define List(HTTP_header)
	2024	+ headers_for_send_file
	2025	+ (
	2026	+ String mime_type,
	2027	+ Int size,
	2028	+ String etag,
	2029	+ Maybe(FileTimes) mb_ftimes,
	2030	+ ) =
	2031	+ with headers = (List(HTTP_header))
	2032	+ [
	2033	+ http_header("Content-Type",mime_type),
	2034	+ http_header("Etag", etag),
	2035	+ http_header("Content-Length",to_decimal(size)),
	2036	+ ],
	2037	+ if mb_ftimes is
	2038	+ {
	2039	+ failure then headers,
	2040	+ success(ftimes) then [http_header("Last-Modified", format_http_date(to_Int(ftimes.last_modified))) . headers]
	2041	+ }
	2042	+ .
	2043	+
	2044	+
	2045	+
	2046	+ Sending the body of the answer (i.e. the file itself).
	2047	+
	2048	+define One
	2049	+ send_file_body
	2050	+ (
	2051	+ Web_Site_Description desc,
	2052	+ Connection connection, // connection with the client
	2053	+ Connection file, // file to be sent already opened
	2054	+ Int size, // size of file
	2055	+ Int sent, // bytes already sent
	2056	+ String filename // name of file
	2057	+ ) =
	2058	+ if sent >= size then unique else
	2059	+ if read(file,min(10000,size-sent),60) is
	2060	+ {
	2061	+ error then log_journal_msg(desc,"Cannot read from file '"+filename+"'.\n"),
	2062	+ timeout then log_journal_msg(desc,"Cannot read from file timeoput'"+filename+"'.\n"),
	2063	+ ok(ba) then
	2064	+ with nr = length(ba), // get the number of bytes read
	2065	+ if reliable_write(connection,ba) is
	2066	+ {
	2067	+ failure then log_journal_msg(desc,"Cannot write into connection delirering '"+filename+"' (sent="+sent+"; size="+size+"; current="+nr+").\n"),
	2068	+ success(nw) then
	2069	+ send_file_body(desc,connection,file,size,sent+nw,filename)
	2070	+ }
	2071	+ }.
	2072	+
	2073	+
	2074	+define String
	2075	+ compute_etag
	2076	+ (
	2077	+ String filename,
	2078	+ Maybe(FileTimes) mb_ftimes,
	2079	+ Int size,
	2080	+ ) =
	2081	+ if mb_ftimes is
	2082	+ {
	2083	+ failure then println("Warning: no file times for '" + filename + "', etag won't be very accurate."); to_ascii(sha1((filename, size))),
	2084	+ success(ftimes) then to_ascii(md5((filename, ftimes, size)))
	2085	+ }.
	2086	+
	2087	+define Bool
	2088	+ are_same_etag
	2089	+ (
	2090	+ Maybe(String) input_etag,
	2091	+ String current_etag
	2092	+ ) =
	2093	+ if input_etag is
	2094	+ {
	2095	+ failure then false,
	2096	+ success(etag) then etag = current_etag
	2097	+ }.
	2098	+
	2099	+ Sending the answer line, the headers and the body.
	2100	+
	2101	+define One
	2102	+ send_file
	2103	+ (
	2104	+ Web_Site_Description desc,
	2105	+ Connection connection,
	2106	+ List(HTTP_header) input_headers,
	2107	+ List(HTTP_header) headers,
	2108	+ Int size,
	2109	+ Connection file,
	2110	+ String filename,
	2111	+ String full_path,
	2112	+ String mime_type,
	2113	+ One -> One action_before_send_file
	2114	+ ) =
	2115	+ action_before_send_file(unique);
	2116	+ with input_etag = http_header_value(input_headers, "If-None-Match"),
	2117	+ mb_ftimes = get_file_times(full_path),
	2118	+ current_etag = compute_etag(full_path, mb_ftimes, size),
	2119	+ if are_same_etag(input_etag, current_etag) is
	2120	+ {
	2121	+ false then
	2122	+ forget(reliable_write(connection,to_byte_array("HTTP/1.1 200 OK"+crlf)));
	2123	+ forget(reliable_write(connection,[format_headers(headers + headers_for_send_file(mime_type, size, current_etag, mb_ftimes)) , crlf]));
	2124	+ //forget(copy_file_to_Connection(file, connection, size)),
	2125	+ send_file_body(desc,connection,file,size,0,filename),
	2126	+ true then
	2127	+ forget(reliable_write(connection,to_byte_array("HTTP/1.1 304 Not Modified"+crlf)));
	2128	+ forget(reliable_write(connection,[format_headers([http_header("Etag", current_etag) . headers]) , crlf]))
	2129	+ //send_file_body(desc,connection,file,size,0,filename)
	2130	+ }.
	2131	+
	2132	+
	2133	+
	2134	+ Checking if a connection is under SSL.
	2135	+
	2136	+define Bool
	2137	+ is_SSL
	2138	+ (
	2139	+ Connection c
	2140	+ ) =
	2141	+ if c is
	2142	+ {
	2143	+ file_r(_) then false,
	2144	+ file_w(_) then false,
	2145	+ file_rw(_) then false,
	2146	+ tcp(_) then false,
	2147	+ ssl(_) then true
	2148	+ }.
	2149	+
	2150	+
	2151	+
	2152	+ Before opening and sending a file, we check the MIME type. It must be recognized,
	2153	+ except if there is a valid authorization for private download.
	2154	+
	2155	+define One
	2156	+ send_file
	2157	+ (
	2158	+ Web_Site_Description desc,
	2159	+ Connection connection,
	2160	+ String uri,
	2161	+ List(HTTP_header) input_headers,
	2162	+ List(HTTP_header) output_headers,
	2163	+ Maybe(String) mbauthorization,
	2164	+ One -> One action_before_send_file
	2165	+ ) =
	2166	+ if mbauthorization is
	2167	+ {
	2168	+ //--- file without authorization: take it from public ---
	2169	+ failure then if recognize_mime_type_from_uri(desc,uri) is
	2170	+ {
	2171	+ failure then log_journal_msg(desc,"No MIME type found for '"+uri+"'.\n"),
	2172	+ success(mime_type) then
	2173	+ with path = site_directory(desc)+"/public"+uri,
	2174	+ if (Maybe(RStream))connect to file path is
	2175	+ {
	2176	+ failure then log_journal_msg(desc,"Cannot find file '"+path+"'.\n"),
	2177	+ success(f) then with size = file_size(f),
	2178	+ send_file(desc,
	2179	+ connection,
	2180	+ input_headers,
	2181	+ output_headers,
	2182	+ size,
	2183	+ file(f),
	2184	+ uri,
	2185	+ path,
	2186	+ mime_type,
	2187	+ action_before_send_file)
	2188	+ }
	2189	+ },
	2190	+
	2191	+ //--- file with authorization: apply 'private download' mecanism ---
	2192	+ success(authorization) then
	2193	+ with private_download_dir = site_directory(desc)+"/private_download",
	2194	+ if (RetrieveResult(String))retrieve(private_download_dir+"/z"+authorization)
	2195	+ is ok(absolute_path)
	2196	+ then (
	2197	+ with new_hash = compute_authorization(authorization_secret(desc),
	2198	+ absolute_path),
	2199	+ if (Maybe(RStream))connect to file absolute_path is
	2200	+ {
	2201	+ failure then log_journal_msg(desc,"Cannot find file '"+absolute_path+"'.\n"),
	2202	+ success(f) then with size = file_size(f),
	2203	+ mime_type = if recognize_mime_type_from_uri(desc,uri) is
	2204	+ {
	2205	+ failure then "application/octet-stream"
	2206	+ success(mime_type) then mime_type
	2207	+ },
	2208	+ send_file(desc,
	2209	+ connection,
	2210	+ input_headers,
	2211	+ output_headers,
	2212	+ size,
	2213	+ file(f),
	2214	+ uri,
	2215	+ absolute_path,
	2216	+ mime_type,
	2217	+ action_before_send_file)
	2218	+ }
	2219	+ )
	2220	+ else log_journal_msg(desc,"Cannot find or read authorization file.\n")
	2221	+ }.
	2222	+
	2223	+
	2224	+
	2225	+
	2226	+
	2227	+
	2228	+
	2229	+
	2230	+ *** [5.6] Answering a www-url encoded request.
	2231	+
	2232	+ Standard headers are for answering ".awp" requests.
	2233	+
	2234	+public define List(HTTP_header)
	2235	+ standard_headers
	2236	+ =
	2237	+ [
	2238	+ http_header("Date", format_http_date(now)),
	2239	+ http_header("Server", "Anubis Embedded Server v" + major_version_number + "." + minor_version_number)
	2240	+ ].
	2241	+
	2242	+public define List(HTTP_header)
	2243	+ standard_headers_for
	2244	+ (
	2245	+ String mime_type,
	2246	+ Int answer_body_size,
	2247	+ Maybe(String) mb_charset,
	2248	+ ) =
	2249	+ [
	2250	+ http_header("Content-Type", mime_type + if mb_charset is success(charset) then "; charset="+charset else ""),
	2251	+ http_header("Content-length", to_decimal(answer_body_size))
	2252	+ ].
	2253	+
	2254	+
	2255	+define One
	2256	+ www_url_answer
	2257	+ (
	2258	+ String host_name,
	2259	+ Web_Site_Description desc,
	2260	+ Connection connection, // with the client
	2261	+ Word32 ip_addr, // of the client
	2262	+ HTTP_RequestLine request_line,
	2263	+ List(HTTP_header) headers,
	2264	+ ByteArray body,
	2265	+ One -> String generate_tt // trust ticket generation
	2266	+ ) =
	2267	+ with all_web_args = query_string(request_line) +
	2268	+ read_www_url_encoded_web_args(to_string(body),0),
	2269	+ uri = uri(request_line),
	2270	+ ext = get_uri_extension(uri),
	2271	+ (if member(journal_extensions(desc),ext)
	2272	+ then log_journal_msg(desc,
	2273	+ format_request(desc,connection,request_line,headers,all_web_args))
	2274	+ else unique);
	2275	+ if is_illegal_uri(uri,0)
	2276	+ then log_journal_msg(desc,"Received illegal URI: "+uri+"\n")
	2277	+ else (if (ext = ".awp" \| ext = "")
	2278	+ then (with answer_headers_body = awp_handler(desc)(host_name,
	2279	+ http_info(ip_addr,uri,headers,generate_tt),
	2280	+ all_web_args,
	2281	+ is_SSL(connection)),
	2282	+ //print_delta("After page generation");
	2283	+ forget(reliable_write(connection, answer_headers_body))
	2284	+ //print_delta("After sending page")
	2285	+ )
	2286	+ else (send_file(desc,
	2287	+ connection,
	2288	+ uri,
	2289	+ headers,
	2290	+ standard_headers,
	2291	+ if web_arg_value(all_web_args,"zauth") is
	2292	+ {
	2293	+ not_found then failure,
	2294	+ found(v) then success(v)
	2295	+ },
	2296	+ (One u) \|-> before_send_file(desc)(all_web_args))
	2297	+ //print_delta("After sending file")
	2298	+ )).
	2299	+
	2300	+
	2301	+
	2302	+
	2303	+
	2304	+
	2305	+
	2306	+ *** [5.7] Answering a multipart/form-data encoded request.
	2307	+
	2308	+ In order to support upload of files, we must be able to read web arguments which are
	2309	+ encoded in a multipart/form-data body. The first thing to do is to find the
	2310	+ boundary. The boundary is a special string which delimits the various parts of the
	2311	+ 'multipart' body. It is found within the value of the 'Content-Type' HTTP header, as
	2312	+ the value of the 'boundary' attribute.
	2313	+
	2314	+
	2315	+
	2316	+
	2317	+
	2318	+ *** [5.7.1] Finding the boundary.
	2319	+
	2320	+ Hence, we just have to find the string 'boundary=' within the value of the
	2321	+ 'Content-Type' header, and read the value of the boundary from there.
	2322	+
	2323	+define Bool
	2324	+ delimits_boundary
	2325	+ (
	2326	+ Word8 c
	2327	+ ) =
	2328	+ if c = ' ' then true else
	2329	+ if c = 13 then true else
	2330	+ if c = 10 then true else
	2331	+ if c = 0 then true else
	2332	+ if c = ',' then true else
	2333	+ c = ';'.
	2334	+
	2335	+
	2336	+define Maybe(String)
	2337	+ get_boundary_value_3
	2338	+ (
	2339	+ String s,
	2340	+ Int i,
	2341	+ List(Word8) so_far
	2342	+ ) =
	2343	+ if nth(i,s) is
	2344	+ {
	2345	+ failure then success(implode(reverse(so_far))),
	2346	+ success(c) then
	2347	+ if delimits_boundary(c)
	2348	+ then success(implode(reverse(so_far)))
	2349	+ else get_boundary_value_3(s,i+1,[c . so_far])
	2350	+ }.
	2351	+
	2352	+
	2353	+
	2354	+define Maybe(String)
	2355	+ get_boundary_value_2
	2356	+ (
	2357	+ String s,
	2358	+ Int i,
	2359	+ ) =
	2360	+ if nth(i,s) is
	2361	+ {
	2362	+ failure then failure,
	2363	+ success(c) then
	2364	+ if is_blank(c)
	2365	+ then get_boundary_value_2(s,i+1)
	2366	+ else get_boundary_value_3(s,i+1,[c])
	2367	+ }.
	2368	+
	2369	+define Maybe(String)
	2370	+ get_boundary_value_1
	2371	+ (
	2372	+ String s, // string into which we must find '= ...'
	2373	+ Int i // position of start of search
	2374	+ ) =
	2375	+ if nth(i,s) is
	2376	+ {
	2377	+ failure then failure,
	2378	+ success(c) then
	2379	+ if is_blank(c)
	2380	+ then get_boundary_value_1(s,i+1)
	2381	+ else if c = '='
	2382	+ then get_boundary_value_2(s,i+1)
	2383	+ else failure
	2384	+ }.
	2385	+
	2386	+
	2387	+define Maybe(String)
	2388	+ get_boundary
	2389	+ (
	2390	+ String content_type_header_value
	2391	+ ) =
	2392	+ if find("boundary",content_type_header_value,0) is
	2393	+ {
	2394	+ failure then failure,
	2395	+ success(n) then // 'boundary' has been found at position n
	2396	+ get_boundary_value_1(content_type_header_value,n+8)
	2397	+ }.
	2398	+
	2399	+define Maybe(String)
	2400	+ get_boundary
	2401	+ (
	2402	+ List(HTTP_header) headers
	2403	+ ) =
	2404	+ if headers is
	2405	+ {
	2406	+ [ ] then failure,
	2407	+ [h . t] then if h is http_header(name,value) then
	2408	+ if name = "content-type"
	2409	+ then get_boundary(value)
	2410	+ else get_boundary(t)
	2411	+ }.
	2412	+
	2413	+
	2414	+
	2415	+
	2416	+
	2417	+
	2418	+
	2419	+
	2420	+ *** [5.7.2] Reading attributes from a multipart entity.
	2421	+
	2422	+ Entities in a multipart/form-data body are separated by instances of the string:
	2423	+
	2424	+ --bbbbb
	2425	+
	2426	+ where bbbbb is the boundary computed above. Actually, the body has the form:
	2427	+
	2428	+ --bbbbb
	2429	+ <entity 1>
	2430	+ --bbbbb
	2431	+ <entity 2>
	2432	+ --bbbbb
	2433	+ ...
	2434	+ --bbbbb
	2435	+ <last entity>
	2436	+ --bbbbb
	2437	+
	2438	+
	2439	+ We have to extract an entity which is in the body between offsets 'start' and 'end'
	2440	+ (computed when boundaries have been localized). The entity itself is made of two parts:
	2441	+ headers and body. The body is separated from the headers by a blank line. This blank
	2442	+ line (a double crlf) marks the beginning of the body of the entity. Within the headers
	2443	+ of the entity, we look for a 'Content-Disposition' header, which should look like this:
	2444	+
	2445	+ Content-Disposition: form-data; name="..."; filename="..." crlf
	2446	+
	2447	+ We are just interested in the name and the file name. Hence we first search
	2448	+ 'Content-Disposition', then we search 'name' and read the value, and we do the same for
	2449	+ 'filename'.
	2450	+
	2451	+ If the 'filename' attribute is not present, the web arg is an ordinary one, otherwise,
	2452	+ it is an uploaded file.
	2453	+
	2454	+
	2455	+ Below is a variant of 'find' (see 'tools/findstring.anubis'), with an extra 'end'
	2456	+ argument.
	2457	+
	2458	+define Maybe(Int)
	2459	+ find
	2460	+ (
	2461	+ String what,
	2462	+ ByteArray where,
	2463	+ Int start,
	2464	+ Int end
	2465	+ ) =
	2466	+ if find(to_byte_array(what),where,start) is
	2467	+ {
	2468	+ failure then failure,
	2469	+ success(n) then
	2470	+ if n+length(what) >= end
	2471	+ then failure
	2472	+ else success(n)
	2473	+ }.
	2474	+
	2475	+
	2476	+define String
	2477	+ read_attribute_value
	2478	+ (
	2479	+ ByteArray where,
	2480	+ Int start,
	2481	+ Int end,
	2482	+ List(Word8) so_far
	2483	+ ) =
	2484	+ if start >= end then implode(reverse(so_far)) else
	2485	+ if nth(start,where) is
	2486	+ {
	2487	+ failure then implode(reverse(so_far)),
	2488	+ success(c) then
	2489	+ if c = '\"'
	2490	+ then implode(reverse(so_far))
	2491	+ else read_attribute_value(where,start+1,end,[c . so_far])
	2492	+ }.
	2493	+
	2494	+define Maybe(String)
	2495	+ find_attribute
	2496	+ (
	2497	+ String name,
	2498	+ ByteArray where,
	2499	+ Int start,
	2500	+ Int end
	2501	+ ) =
	2502	+ with prefix = name+"=\"",
	2503	+ if find(to_byte_array(prefix),where,start) is
	2504	+ {
	2505	+ failure then failure,
	2506	+ success(n) then
	2507	+ if n+length(prefix) >= end
	2508	+ then failure
	2509	+ else success(read_attribute_value(where,n+length(prefix),end,[]))
	2510	+ }.
	2511	+
	2512	+
	2513	+
	2514	+define Maybe((String,Maybe(String)))
	2515	+ find_name_and_filename
	2516	+ (
	2517	+ ByteArray body,
	2518	+ Int start,
	2519	+ Int end
	2520	+ ) =
	2521	+ if find(to_byte_array("Content-Disposition"),body,start) is
	2522	+ {
	2523	+ failure then failure,
	2524	+ success(n) then
	2525	+ if find_attribute("name",body,n+19,end) is
	2526	+ {
	2527	+ failure then failure,
	2528	+ success(name_value) then if find_attribute("filename",body,n+19,end) is
	2529	+ {
	2530	+ failure then success((name_value,failure)),
	2531	+ success(filename_value) then success((name_value,success(filename_value)))
	2532	+ }
	2533	+ }
	2534	+ }.
	2535	+
	2536	+
	2537	+
	2538	+
	2539	+
	2540	+
	2541	+
	2542	+
	2543	+
	2544	+
	2545	+ *** [5.7.3] Creating a temporary filename for an uploaded file.
	2546	+
	2547	+variable Int uploaded_file_count = 0.
	2548	+
	2549	+ This variable is local to the virtual machine. Hence, its value is 0 each time a new
	2550	+ requests arrives. Temporary uploaded files are stored in the directory represented by
	2551	+ 'upload_temporary_directory'. The filenames have the form:
	2552	+
	2553	+ _m_n
	2554	+
	2555	+ where 'm' is the number of the virtual machine, and 'n' a number obtained by
	2556	+ incrementing 'uploaded_file_count'. Notice that the program must do something with this
	2557	+ file (move it to some directory/name), otherwise, it will probably be overwritten the
	2558	+ next time the same machine works.
	2559	+
	2560	+
	2561	+
	2562	+
	2563	+
	2564	+
	2565	+ *** [5.7.4] Saving an uploaded file under a temporary filename.
	2566	+
	2567	+define Maybe(String) // returns the temporary file name
	2568	+ save_uploaded_file
	2569	+ (
	2570	+ Web_Site_Description desc,
	2571	+ ByteArray body,
	2572	+ Int start,
	2573	+ Int end
	2574	+ ) =
	2575	+ uploaded_file_count <- 1 + *uploaded_file_count;
	2576	+ with tfn = "_"+to_decimal(virtual_machine_id)+"_"+to_decimal(*uploaded_file_count),
	2577	+ if (Maybe(WStream))connect to file site_directory(desc)+"/upload_temporary/"+tfn is
	2578	+ {
	2579	+ failure then failure,
	2580	+ success(f) then
	2581	+ if reliable_write(file(f),extract(body,start,end)) is
	2582	+ {
	2583	+ failure then failure,
	2584	+ success(nw) then
	2585	+ if nw = end - start
	2586	+ then success(tfn)
	2587	+ else failure
	2588	+ }
	2589	+ }.
	2590	+
	2591	+
	2592	+
	2593	+
	2594	+
	2595	+
	2596	+
	2597	+
	2598	+ *** [5.7.5] Removing the path from a file name.
	2599	+
	2600	+ When a file is uploaded, the browser sends the complete path of the file on the client
	2601	+ machine as the file name. Actually, this is not quite normal. Nevertheless, we need to
	2602	+ remove the path, and keep only the file name. This is achieved by 'remove_path' below.
	2603	+
	2604	+define Int
	2605	+ file_name_begin
	2606	+ (
	2607	+ String full_name,
	2608	+ Int i
	2609	+ ) =
	2610	+ if nth(i,full_name) is
	2611	+ {
	2612	+ failure then 0,
	2613	+ success(c) then
	2614	+ if c = '/' then i+1 else
	2615	+ if c = '\\' then i+1 else
	2616	+ file_name_begin(full_name,i-1)
	2617	+ }.
	2618	+
	2619	+define String
	2620	+ remove_path
	2621	+ (
	2622	+ String full_name
	2623	+ ) =
	2624	+ with l = length(full_name),
	2625	+ b = file_name_begin(full_name,l-1),
	2626	+ substr(full_name,b,l-b).
	2627	+
	2628	+
	2629	+
	2630	+
	2631	+
	2632	+ *** [5.7.6] Reading a multipart entity.
	2633	+
	2634	+define Maybe(Web_arg)
	2635	+ get_multipart_entity
	2636	+ (
	2637	+ Web_Site_Description desc,
	2638	+ ByteArray body,
	2639	+ Int start,
	2640	+ Int end
	2641	+ ) =
	2642	+ if find(to_byte_array(crlf+crlf),body,start) is
	2643	+ {
	2644	+ failure then failure,
	2645	+ success(k) then
	2646	+ if k >= end // must be within this entity, not the next one
	2647	+ then failure
	2648	+ else if find_name_and_filename(body,start,k) is
	2649	+ {
	2650	+ failure then failure,
	2651	+ success(n_mbfn) then if n_mbfn is (name,mbfn) then
	2652	+ if mbfn is
	2653	+ {
	2654	+ failure then
	2655	+ success(web_arg(name,to_string(extract(body,k+4,end-2)))),
	2656	+ // we must substract 2 to end because of crlf just before the boundary
	2657	+
	2658	+ success(fn) then
	2659	+ if save_uploaded_file(desc,body,k+4,end-2) is
	2660	+ {
	2661	+ failure then failure,
	2662	+ success(tfn) then
	2663	+ success(upload(name,remove_path(fn),
	2664	+ site_directory(desc)+"/upload_temporary/"+tfn))
	2665	+
	2666	+ }
	2667	+ }
	2668	+ }
	2669	+ }.
	2670	+
	2671	+
	2672	+
	2673	+define List(Web_arg)
	2674	+ read_multipart_form_data_encoded_web_args
	2675	+ (
	2676	+ Web_Site_Description desc,
	2677	+ ByteArray body,
	2678	+ ByteArray __boundary,
	2679	+ Int i,
	2680	+ ) =
	2681	+ if find(__boundary,body,i) is
	2682	+ {
	2683	+ failure then [ ],
	2684	+ success(n) then
	2685	+ if find(__boundary,body,n+length(__boundary)) is
	2686	+ {
	2687	+ failure then [ ],
	2688	+ success(m) then
	2689	+ if get_multipart_entity(desc,body,n+length(__boundary),m) is
	2690	+ {
	2691	+ failure then [ ],
	2692	+ success(wa) then
	2693	+ [wa . read_multipart_form_data_encoded_web_args(desc,body,__boundary,m)]
	2694	+ }
	2695	+ }
	2696	+ }.
	2697	+
	2698	+
	2699	+
	2700	+define One
	2701	+ multipart_form_data_answer
	2702	+ (
	2703	+ String host_name,
	2704	+ Web_Site_Description desc,
	2705	+ Connection connection,
	2706	+ Word32 ip_addr,
	2707	+ HTTP_RequestLine request_line,
	2708	+ List(HTTP_header) headers,
	2709	+ ByteArray body,
	2710	+ One -> String generate_tt
	2711	+ ) =
	2712	+ if get_boundary(headers) is
	2713	+ {
	2714	+ failure then unique,
	2715	+ success(boundary) then
	2716	+ with all_web_args = query_string(request_line) +
	2717	+ read_multipart_form_data_encoded_web_args(desc,
	2718	+ body,
	2719	+ to_byte_array("--"+boundary),
	2720	+ 0),
	2721	+ uri = uri(request_line),
	2722	+ ext = get_uri_extension(uri),
	2723	+ log_journal_msg(desc,
	2724	+ format_request(desc,connection,request_line,headers,all_web_args));
	2725	+ if is_illegal_uri(uri,0)
	2726	+ then log_journal_msg(desc,"Received illegal URI: "+uri+"\n")
	2727	+ else
	2728	+ if (ext = ".awp" \| ext = "") then
	2729	+ (with answer_headers_body = awp_handler(desc)(host_name,
	2730	+ http_info(ip_addr,uri,headers,generate_tt),
	2731	+ all_web_args,
	2732	+ is_SSL(connection)),
	2733	+ forget(reliable_write(connection, answer_headers_body)))
	2734	+ else unique
	2735	+ }.
	2736	+
	2737	+
	2738	+
	2739	+
	2740	+
	2741	+
	2742	+
	2743	+
	2744	+ *** [5.8] Handling redirections.
	2745	+
	2746	+ 'redirections' (of type 'List(Redirection)') contains redirection directives. Each one
	2747	+ has the form:
	2748	+
	2749	+ redirect(required_uri,required_host,corresponding_uri).
	2750	+
	2751	+ The host required by the client may be found in the 'Host' HTTP header. The URI
	2752	+ required by the client is given below as 'uri'. We just have to find the required host
	2753	+ in the headers, and to find the corresponding redirection directive.
	2754	+
	2755	+
	2756	+ In the next fonction, the required host and URI are known. We just have to search in
	2757	+ the 'redirections' list.
	2758	+
	2759	+define String
	2760	+ handle_redirection
	2761	+ (
	2762	+ String required_uri,
	2763	+ String required_host,
	2764	+ List(Redirection) redirections
	2765	+ ) =
	2766	+ if redirections is
	2767	+ {
	2768	+ [ ] then required_uri,
	2769	+ [h . t] then if h is redirect(uri,host,target) then
	2770	+ if host = required_host
	2771	+ then if uri = required_uri
	2772	+ then target
	2773	+ else handle_redirection(required_uri,required_host,t)
	2774	+ else handle_redirection(required_uri,required_host,t)
	2775	+ }.
	2776	+
	2777	+
	2778	+
	2779	+ The host name may be encumbered by a port number, like
	2780	+
	2781	+ www.our-business.com:1607
	2782	+
	2783	+ We must remove this port number, otherwise the host name may not be recognized.
	2784	+
	2785	+define String
	2786	+ strip_port
	2787	+ (
	2788	+ String name,
	2789	+ Int i
	2790	+ ) =
	2791	+ if nth(i,name) is
	2792	+ {
	2793	+ failure then name,
	2794	+ success(c) then
	2795	+ if c = ':'
	2796	+ then substr(name,0,i)
	2797	+ else strip_port(name,i+1)
	2798	+ }.
	2799	+
	2800	+
	2801	+
	2802	+
	2803	+
	2804	+ Finding the 'Host' header. No redirection is performed if this header is not found.
	2805	+
	2806	+define String
	2807	+ handle_redirection // returns the redirected URI
	2808	+ (
	2809	+ Redirections redirections,
	2810	+ String uri, // original URI
	2811	+ List(HTTP_header) headers
	2812	+ )=
	2813	+ if get_host_header_value(headers) is
	2814	+ {
	2815	+ failure then uri,
	2816	+ success(host) then
	2817	+ if redirections is
	2818	+ {
	2819	+ redirection_list(l) then handle_redirection(uri, host, l)
	2820	+ redirection_fn(f) then f(uri, host)
	2821	+ }
	2822	+ }.
	2823	+
	2824	+
	2825	+
	2826	+
	2827	+
	2828	+
	2829	+ *** [5.9] Answering both sorts of requests.
	2830	+
	2831	+ We must decide if the request is www-url encoded or multipart/form-data encoded. This
	2832	+ is achieved through the header 'Content-Type'.
	2833	+
	2834	+define EncodingType
	2835	+ get_encoding_type
	2836	+ (
	2837	+ List(HTTP_header) headers
	2838	+ ) =
	2839	+ if headers is
	2840	+ {
	2841	+ [ ] then www_url, // this is the default
	2842	+ [h . t] then if h is http_header(name,value) then
	2843	+ if name = "content-type"
	2844	+ then if find("multipart/form-data",value,0) is
	2845	+ {
	2846	+ failure then www_url,
	2847	+ success(_) then multipart_form_data
	2848	+ }
	2849	+ else get_encoding_type(t)
	2850	+ }.
	2851	+
	2852	+
	2853	+
	2854	+define One
	2855	+ send_answer
	2856	+ (
	2857	+ String host_name,
	2858	+ Web_Site_Description desc,
	2859	+ Connection connection,
	2860	+ HTTP_RequestLine rqline,
	2861	+ List(HTTP_header) headers,
	2862	+ ByteArray body,
	2863	+ One -> String generate_tt
	2864	+ ) =
	2865	+ if rqline is request_line(type,uri,qstring) then
	2866	+ with rqline2 = request_line(type,handle_redirection(redirections(desc),uri,headers),qstring),
	2867	+ if remote_IP_address_and_port(connection) is (ip_addr,_) then
	2868	+ if get_encoding_type(headers) is
	2869	+ {
	2870	+ www_url then
	2871	+ www_url_answer(host_name,desc,connection,ip_addr,rqline2,headers,body,generate_tt),
	2872	+ multipart_form_data then
	2873	+ multipart_form_data_answer(host_name,desc,connection,ip_addr,rqline2,headers,body,generate_tt)
	2874	+ }.
	2875	+
	2876	+
	2877	+
	2878	+
	2879	+
	2880	+
	2881	+
	2882	+ *** [6] The HTTP/HTTPS server.
	2883	+
	2884	+ The command 'start_server' (declared in 'predefined.anubis') starts a virtual machine
	2885	+ which opens a server TCP/IP connection, and which continuously listens to this
	2886	+ connection. When a request arrives, this machine delegates the work of deciphering and
	2887	+ answering the request to another virtual machine, and continues to listen. The job of
	2888	+ the delegated machine is defined by the HTTP request handler below.
	2889	+
	2890	+
	2891	+
	2892	+
	2893	+
	2894	+ *** [6.1] Determining the requested host.
	2895	+
	2896	+ When a request arrives to one of our two servers, we must decide which site (host) is
	2897	+ requested.
	2898	+
	2899	+define Maybe(String)
	2900	+ get_host_header_value
	2901	+ (
	2902	+ List(HTTP_header) headers
	2903	+ ) =
	2904	+ if headers is
	2905	+ {
	2906	+ [ ] then failure,
	2907	+ [h . t] then if h is http_header(name,value) then
	2908	+ if name = "host"
	2909	+ then success(strip_port(value,0))
	2910	+ else get_host_header_value(t)
	2911	+ }.
	2912	+
	2913	+define Maybe((String,Web_Site_Description))
	2914	+ get_site
	2915	+ (
	2916	+ String requested_host,
	2917	+ List(Web_Site_Description) sites
	2918	+ ) =
	2919	+ if sites is
	2920	+ {
	2921	+ [ ] then print("Requested host '"+requested_host+"' does not exist.\n"); failure,
	2922	+ [site1 . others] then
	2923	+ if site1 is web_site_description(common_names,_,_,_,_,_,_,_,_,_) then
	2924	+ if member(common_names,requested_host)
	2925	+ then success((requested_host,site1))
	2926	+ else get_site(requested_host,others)
	2927	+ }.
	2928	+
	2929	+
	2930	+define Maybe((String,Web_Site_Description))
	2931	+ get_site
	2932	+ (
	2933	+ List(HTTP_header) headers,
	2934	+ List(Web_Site_Description) sites
	2935	+ ) =
	2936	+ if get_host_header_value(headers) is
	2937	+ {
	2938	+ failure then print("No 'Host' HTTP header.\n"); failure,
	2939	+ success(requested_host) then
	2940	+ //here we treat the case with only one site. hence we accept any host request
	2941	+ //print("*** there is " +length(sites) + " sites \n");
	2942	+ if length(sites) = 1 then
	2943	+ //with site = force_nth(0, sites),
	2944	+ if sites is
	2945	+ {
	2946	+ [] then get_site(requested_host,sites),
	2947	+ [site . t] then success((requested_host, site))
	2948	+ }
	2949	+ else
	2950	+ get_site(requested_host,sites)
	2951	+ }.
	2952	+
	2953	+
	2954	+
	2955	+
	2956	+
	2957	+ *** [6.2] The HTTP request handler.
	2958	+
	2959	+ Here is the HTTP/HTTPS handler. It is called at each new request in a separate virtual
	2960	+ machine. It reads the headers of the HTTP request, determines the host, determines body
	2961	+ size, reads the body of the HTTP request, and answers the request.
	2962	+
	2963	+
	2964	+
	2965	+define One -> String make_generate_trust_ticket(DenialOfService dos).
	2966	+
	2967	+define One
	2968	+ http_https_handler
	2969	+ (
	2970	+ List(Web_Site_Description) sites,
	2971	+ BufferedConnection connection,
	2972	+ Bool is_https,
	2973	+ DenialOfService dos
	2974	+ ) =
	2975	+ //t0 <- (UTime)unow;
	2976	+ with start_time = (Int)now,
	2977	+ sttm <- start_time;
	2978	+ //println("Request time: " + format_http_date(start_time));
	2979	+ if dos is denial_of_service(mc_v,rld_v,hd_v,ad_v,ld_v,ra_v) then
	2980	+ if remote_IP_address_and_port(connection.conn) is (ip_addr,port) then
	2981	+ if read_request_line(connection,start_time+*rld_v,dos) is
	2982	+ {
	2983	+ error(msg) then print(format(msg)),
	2984	+ ok(request_line) then
	2985	+ //print_delta("read_request_line");
	2986	+ if read_http_headers(connection,start_time+*hd_v,dos) is
	2987	+ {
	2988	+ error(msg) then print(format(msg)),
	2989	+ ok(headers) then //print_delta("read_http_headers");
	2990	+ if get_site(headers,sites) is
	2991	+ {
	2992	+ failure then unique,
	2993	+ success(p) then if p is (host_name,desc) then
	2994	+ //print_delta("get_site");
	2995	+ if get_body_size(headers) is
	2996	+ {
	2997	+ error(msg) then log_journal_msg(desc,format(msg)),
	2998	+ ok(body_size) then
	2999	+ //print_delta("get_body_size");
	3000	+ if read_http_body(connection,body_size,constant_byte_array(0,0),1000) is
	3001	+ {
	3002	+ error(msg) then log_journal_msg(desc,format(msg)),
	3003	+ ok(body) then
	3004	+ //print_delta("before send_answer");
	3005	+ send_answer(host_name, desc,connection.conn, request_line, headers, body,
	3006	+ make_generate_trust_ticket(dos))
	3007	+ //with duration = (UTime) unow - *t0,
	3008	+ //println("Request duration: " + utime_to_string(duration))
	3009	+ //println("BufferRead duration: " + utime_to_string(*t1));
	3010	+ //println("next_char duration: " + utime_to_string(*t2))
	3011	+ }
	3012	+ }
	3013	+ }
	3014	+ }
	3015	+ }.
	3016	+
	3017	+
	3018	+ Below are the two tools for constructing the handlers required by 'start_server' and
	3019	+ 'start_ssl_server' (see 'predefined.anubis').
	3020	+
	3021	+define Bool is_dubious_IP(Word32 ip, DenialOfService dos).
	3022	+
	3023	+define Server -> ((RWStream) -> One)
	3024	+ make_http_handler
	3025	+ (
	3026	+ List(Web_Site_Description) sites,
	3027	+ DenialOfService dos
	3028	+ ) =
	3029	+ (Server server) \|-> (RWStream conn) \|->
	3030	+ if remote_IP_address_and_port(conn) is (addr,_) then
	3031	+ if is_dubious_IP(addr,dos)
	3032	+ then print("Rejecting dubious IP address "+ip_addr_to_string(addr)+"\n")
	3033	+ else
	3034	+ with connection = buffered_connection(tcp(conn), var(constant_byte_array(0, 0)), var(0)),
	3035	+ http_https_handler(sites, connection, false, dos).
	3036	+
	3037	+define Server -> (SSL_Connection -> One)
	3038	+ make_https_handler
	3039	+ (
	3040	+ List(Web_Site_Description) sites,
	3041	+ DenialOfService dos
	3042	+ ) =
	3043	+ (Server server) \|-> (SSL_Connection conn) \|->
	3044	+ with connection = buffered_connection(ssl(conn), var(constant_byte_array(0, 0)), var(0)),
	3045	+ http_https_handler(sites, connection, true, dos).
	3046	+
	3047	+
	3048	+
	3049	+
	3050	+ *** [6.3] Server's tasks.
	3051	+
	3052	+ Some tasks must be executed periodically, for example for cleaning up directories from
	3053	+ short life time files.
	3054	+
	3055	+ The next function removes from the given directory (and recursively from its
	3056	+ subdirectories) all the files which are more than 10 minutes old.
	3057	+
	3058	+define One
	3059	+ cleanup_directory_10mn
	3060	+ (
	3061	+ String dir // path of private download directory (or subdirectory) with trailing slash
	3062	+ ) =
	3063	+ forget(map((FileDescription fd) \|-> if fd is
	3064	+ {
	3065	+ no_info(name) then forget(remove(dir+name)),
	3066	+ file(name,_,_,d) then if to_Int(d)+600 < now then forget(remove(dir+name)) else unique,
	3067	+ link(name,_,_,d) then if to_Int(d)+600 < now then forget(remove(dir+name)) else unique,
	3068	+ directory(name,_,_) then cleanup_directory_10mn(dir+name+"/"),
	3069	+ },
	3070	+ directory_full_list(dir,"","","*"))).
	3071	+
	3072	+
	3073	+define One
	3074	+ http_servers_tasks
	3075	+ (
	3076	+ List(Web_Site_Description) sites,
	3077	+ List(Server) servers,
	3078	+ Int period,
	3079	+ Int next_time,
	3080	+ ) =
	3081	+ if mapand(is_down,servers)
	3082	+ then unique
	3083	+ else if now > next_time
	3084	+ then
	3085	+ (
	3086	+ /*
	3087	+ forget(map((Web_Site_Description wsd) \|->
	3088	+ cleanup_directory_10mn(site_directory(wsd)+"/private_download/"),
	3089	+ sites));
	3090	+ */
	3091	+ http_servers_tasks(sites,servers,period,next_time+period)
	3092	+ )
	3093	+ else
	3094	+ (
	3095	+ sleep(1000);
	3096	+ http_servers_tasks(sites,servers,period,next_time)
	3097	+ ).
	3098	+
	3099	+
	3100	+public define One
	3101	+ start_http_servers_tasks
	3102	+ (
	3103	+ List(Web_Site_Description) sites,
	3104	+ List(Server) servers,
	3105	+ Int period
	3106	+ ) =
	3107	+ delegate http_servers_tasks(sites,servers,period,now),
	3108	+ unique.
	3109	+
	3110	+
	3111	+
	3112	+
	3113	+ *** [6.4] Protection against 'denial of service' attacks.
	3114	+
	3115	+
	3116	+ *** [6.4.1] Counting connections.
	3117	+
	3118	+define Bool // returns false if the counter cannot be incremented (too many connections)
	3119	+ increment_connections_counter
	3120	+ (
	3121	+ Var(Int) counter
	3122	+ ) =
	3123	+ protect with n = *counter,
	3124	+ if n >= 100
	3125	+ then false
	3126	+ else (counter <- (*counter)+1); true.
	3127	+
	3128	+define One
	3129	+ decrement_connections_counter
	3130	+ (
	3131	+ Var(Int) counter
	3132	+ ) =
	3133	+ protect counter <- (*counter)-1.
	3134	+
	3135	+
	3136	+
	3137	+
	3138	+
	3139	+ *** [6.4.2] Recording dubious IP addresses.
	3140	+
	3141	+
	3142	+define List(DubiousIP)
	3143	+ record_dubious_IP
	3144	+ (
	3145	+ Word32 ip,
	3146	+ List(DubiousIP) l
	3147	+ ) =
	3148	+ if l is
	3149	+ {
	3150	+ [ ] then [dubious_ip(ip,now)],
	3151	+ [h . t] then if h is dubious_ip(addr,time) then
	3152	+ if addr = ip
	3153	+ then [dubious_ip(addr,now) . t]
	3154	+ else [h . record_dubious_IP(ip,t)]
	3155	+ }.
	3156	+
	3157	+
	3158	+define One
	3159	+ record_dubious_IP
	3160	+ (
	3161	+ Word32 dubious_IP,
	3162	+ Var(List(DubiousIP)) v
	3163	+ ) =
	3164	+ protect v <- record_dubious_IP(dubious_IP,*v).
	3165	+
	3166	+
	3167	+define One
	3168	+ record_dubious_IP
	3169	+ (
	3170	+ Word32 addr,
	3171	+ DenialOfService dos
	3172	+ ) =
	3173	+ record_dubious_IP(addr,list_of_dubious(dos)).
	3174	+
	3175	+
	3176	+public define DenialOfService
	3177	+ load_denial_of_service_info
	3178	+ =
	3179	+ if (RetrieveResult(DenialOfService))retrieve(my_anubis_directory+"/web_sites/dos_info") is
	3180	+ ok(dos) then dos else denial_of_service(
	3181	+ var(100),
	3182	+ var(1000),
	3183	+ var(1500),
	3184	+ var(2000),
	3185	+ var([]),
	3186	+ var([])).
	3187	+
	3188	+
	3189	+
	3190	+
	3191	+ *** [6.4.3] Testing if an address is dubious.
	3192	+
	3193	+define Bool
	3194	+ is_dubious_IP
	3195	+ (
	3196	+ Word32 ip,
	3197	+ List(DubiousIP) l
	3198	+ ) =
	3199	+ if l is
	3200	+ {
	3201	+ [ ] then false,
	3202	+ [h . t] then if h is dubious_ip(addr,time) then
	3203	+ if ip = addr
	3204	+ then true
	3205	+ else is_dubious_IP(ip,t)
	3206	+ }.
	3207	+
	3208	+
	3209	+define Bool
	3210	+ is_dubious_IP
	3211	+ (
	3212	+ Word32 ip,
	3213	+ DenialOfService dos
	3214	+ ) =
	3215	+ if dos is
	3216	+ {
	3217	+ denial_of_service(mc_v,rld_v,hd_v,ad_v,ld_v,ra_v) then
	3218	+ if member(*ra_v,ip) then false else
	3219	+ is_dubious_IP(ip,*ld_v)
	3220	+ }.
	3221	+
	3222	+
	3223	+
	3224	+
	3225	+ *** [6.4.4] Removing inactive dubious IP addresses.
	3226	+
	3227	+define List(DubiousIP)
	3228	+ remove_inactive_dubious_IP
	3229	+ (
	3230	+ List(DubiousIP) l,
	3231	+ Int ref_time,
	3232	+ ) =
	3233	+ if l is
	3234	+ {
	3235	+ [ ] then [ ],
	3236	+ [h . t] then if h is dubious_ip(addr,time) then
	3237	+ if time < ref_time
	3238	+ then (print(ip_addr_to_string(addr)+" removed from dubious addresses list.\n");
	3239	+ remove_inactive_dubious_IP(t,ref_time))
	3240	+ else [h . remove_inactive_dubious_IP(t,ref_time)]
	3241	+ }.
	3242	+
	3243	+define One
	3244	+ remove_inactive_dubious_IP
	3245	+ (
	3246	+ Var(List(DubiousIP)) v
	3247	+ ) =
	3248	+ protect
	3249	+ with ref_time = (Int)now - 600, // 10 minutes
	3250	+ v <- remove_inactive_dubious_IP(*v,ref_time).
	3251	+
	3252	+
	3253	+ The above function will be executed periodically by the servers's tasks machine.
	3254	+
	3255	+
	3256	+
	3257	+ *** [6.4.5] Making the function for generating trust tickets.
	3258	+
	3259	+define One -> String
	3260	+ make_generate_trust_ticket
	3261	+ (
	3262	+ DenialOfService dos
	3263	+ ) =
	3264	+ (One _) \|-> "".
	3265	+
	3266	+
	3267	+
	3268	+
	3269	+
	3270	+
	3271	+
	3272	+ *** [6.5] Starting the HTTP/HTTPS server.
	3273	+
	3274	+
	3275	+ The next function creates the directories for all sites (if they don't already exist).
	3276	+
	3277	+define One
	3278	+ create_directories
	3279	+ (
	3280	+ List(Web_Site_Description) sites
	3281	+ ) =
	3282	+ if sites is
	3283	+ {
	3284	+ [ ] then unique,
	3285	+ [s1 . others] then
	3286	+ with site_dir = site_directory(s1),
	3287	+ forget(make_directory(site_dir+"/public",default_directory_mode));
	3288	+ forget(make_directory(site_dir+"/upload_temporary",default_directory_mode));
	3289	+ forget(make_directory(site_dir+"/private_download",default_directory_mode));
	3290	+ forget(make_directory(site_dir+"/journal",default_directory_mode));
	3291	+ create_directories(others)
	3292	+ }.
	3293	+
	3294	+
	3295	+
	3296	+
	3297	+
	3298	+ Below are the commands for starting an HTTP server and an HTTPS server.
	3299	+
	3300	+
	3301	+define StartServerResult
	3302	+ start_http_server
	3303	+ (
	3304	+ Word32 ip_address,
	3305	+ Word32 port,
	3306	+ Server -> ((RWStream) -> One) handler,
	3307	+ Int retries,
	3308	+ DenialOfService dos
	3309	+ ) =
	3310	+ if start_server(ip_address,
	3311	+ port,
	3312	+ handler,
	3313	+ identity) is ok(server)
	3314	+ then print(" \r");
	3315	+ ok(server)
	3316	+ else print("Port "+port+": retry number "+retries+"\r");
	3317	+ sleep(1000);
	3318	+ start_http_server(ip_address,port,handler,retries+1,dos).
	3319	+
	3320	+public define StartServerResult
	3321	+ start_http_server
	3322	+ (
	3323	+ Word32 ip_address,
	3324	+ Word32 port,
	3325	+ List(Web_Site_Description) sites,
	3326	+ DenialOfService dos
	3327	+ ) =
	3328	+ create_directories(sites);
	3329	+ start_http_server(ip_address,port,
	3330	+ make_http_handler(sites,dos),
	3331	+ 0,
	3332	+ dos).
	3333	+
	3334	+
	3335	+ For the HTTPS server, we have a problem which is due to the fact that 'anbexec' is not
	3336	+ yet able to manipulate several SSL server certificates. 'anbexec' and
	3337	+ 'predefined.anubis' must be changed. Sorry ! This will be done as soon as possible. The
	3338	+ 'solution' for the time being is to provide the common name of the unique SSL server
	3339	+ certificate.
	3340	+
	3341	+
	3342	+define StartServerResult
	3343	+ start_https_server
	3344	+ (
	3345	+ Word32 ip_address,
	3346	+ Word32 port,
	3347	+ String certificate_common_name,
	3348	+ Server -> (SSL_Connection -> One) handler,
	3349	+ Int retries,
	3350	+ DenialOfService dos
	3351	+ ) =
	3352	+ if start_ssl_server(ip_address,
	3353	+ port,
	3354	+ certificate_common_name,
	3355	+ handler,
	3356	+ identity) is ok(server)
	3357	+ then print(" \r");
	3358	+ ok(server)
	3359	+ else print("Port "+port+": retry number "+retries+"\r");
	3360	+ sleep(1000);
	3361	+ start_https_server(ip_address,port,
	3362	+ certificate_common_name,
	3363	+ handler,retries+1,
	3364	+ dos).
	3365	+
	3366	+
	3367	+public define StartServerResult
	3368	+ start_https_server
	3369	+ (
	3370	+ Word32 ip_address,
	3371	+ Word32 port,
	3372	+ String certificate_common_name, // of SSL server certificate
	3373	+ List(Web_Site_Description) sites,
	3374	+ DenialOfService dos
	3375	+ ) =
	3376	+ create_directories(sites);
	3377	+ start_https_server(ip_address,port,certificate_common_name,
	3378	+ make_https_handler(sites,dos),
	3379	+ 0,dos).
	3380	+
	3381	+
	3382	+
	3383	+
	3384	+
	3385	+
	3386	+
	3387	+
	3388	+
	3389	+ *** [7] The web dispatcher.
	3390	+
	3391	+
	3392	+ *** [7.1] The dispatcher server.
	3393	+
	3394	+define One
	3395	+ send_dispatching_page
	3396	+ (
	3397	+ RWStream conn,
	3398	+ String common_name,
	3399	+ Word32 port
	3400	+ ) =
	3401	+ print("Dispatching '"+common_name+"' to port "+port+"\n");
	3402	+ forget(reliable_write(conn,to_byte_array(
	3403	+ "<html><head><meta http-equiv=\"Refresh\" content=\"0;URL="+
	3404	+ "http://"+common_name+":"+port+"/"+
	3405	+ "\"></head><body></body></html>"
	3406	+ ))).
	3407	+
	3408	+
	3409	+
	3410	+define Maybe(DispatcherInfo)
	3411	+ find_host
	3412	+ (
	3413	+ List(DispatcherInfo) l,
	3414	+ String host
	3415	+ ) =
	3416	+ if l is
	3417	+ {
	3418	+ [ ] then failure,
	3419	+ [h . t] then if h is site(name,port) then
	3420	+ if name = host
	3421	+ then success(h)
	3422	+ else find_host(t,host)
	3423	+ }.
	3424	+
	3425	+
	3426	+
	3427	+define Server -> ((RWStream) -> One)
	3428	+ make_dispatcher_handler
	3429	+ (
	3430	+ Var(List(DispatcherInfo)) info_v,
	3431	+ DenialOfService dos
	3432	+ ) =
	3433	+ (Server server) \|-> (RWStream conn) \|->
	3434	+ with start_time = (Int)now,
	3435	+ connection = buffered_connection(tcp(conn), var(constant_byte_array(0, 0)), var(0)),
	3436	+ if read_request_line(connection, start_time+*request_line_delay(dos), dos) is
	3437	+ {
	3438	+ error(msg) then print(format(msg)),
	3439	+ ok(request_line) then
	3440	+ if read_http_headers(connection, start_time+*headers_delay(dos), dos) is
	3441	+ {
	3442	+ error(msg) then print(format(msg)),
	3443	+ ok(headers) then if get_host_header_value(headers) is
	3444	+ {
	3445	+ failure then print("No 'HOST' HTTP header.\n"),
	3446	+ success(host) then
	3447	+ if find_host(*info_v,host) is
	3448	+ {
	3449	+ failure then print("Host: '"+host+"' not registered.\n"),
	3450	+ success(s) then if s is site(common_name,ip_port) then
	3451	+ send_dispatching_page(conn,common_name,ip_port)
	3452	+ }
	3453	+ }
	3454	+ }
	3455	+ }.
	3456	+
	3457	+
	3458	+define One
	3459	+ dispatcher_update_error
	3460	+ (
	3461	+ String file_path
	3462	+ ) =
	3463	+ print("web_dispatcher: unable to reread file: '"+file_path+"'.\n").
	3464	+
	3465	+
	3466	+define Bool
	3467	+ dispatcher_update_data
	3468	+ (
	3469	+ String info_file_path,
	3470	+ Var(List(DispatcherInfo)) info_v,
	3471	+ Var(Int) info_date_v
	3472	+ ) =
	3473	+ if directory_full_list(my_anubis_directory+"/web_sites","dispatcher.info","","") is
	3474	+ {
	3475	+ [ ] then false,
	3476	+ [h . t] then if h is
	3477	+ {
	3478	+ no_info(n) then false,
	3479	+ file(n,_,_,d) then if n = "dispatcher.info"
	3480	+ then (info_date_v <- to_Int(d);
	3481	+ if (RetrieveResult(List(DispatcherInfo)))retrieve(info_file_path) is
	3482	+ {
	3483	+ cannot_find_file then false,
	3484	+ read_error then false,
	3485	+ type_error then false,
	3486	+ ok(info) then info_v <- info; true
	3487	+ })
	3488	+ else false,
	3489	+ link(_,_,_,_) then false,
	3490	+ directory(_,_,_) then false
	3491	+ }
	3492	+ }.
	3493	+
	3494	+
	3495	+
	3496	+ The loop within which the dispatcher updates its data every 3 seconds:
	3497	+
	3498	+define One
	3499	+ dispatcher_update_task
	3500	+ (
	3501	+ String info_file_path,
	3502	+ Var(List(DispatcherInfo)) info_v,
	3503	+ Var(Int) info_date_v
	3504	+ ) =
	3505	+ sleep(3000);
	3506	+ (if dispatcher_update_data(info_file_path,info_v,info_date_v)
	3507	+ then unique
	3508	+ else dispatcher_update_error(info_file_path));
	3509	+ dispatcher_update_task(info_file_path,info_v,info_date_v).
	3510	+
	3511	+
	3512	+public define One
	3513	+ start_web_dispatcher
	3514	+ (
	3515	+ Word32 ip_address, // address for listening (typically 0: listen on all interfaces)
	3516	+ Word32 http_port, // typically 80
	3517	+ DenialOfService dos
	3518	+ ) =
	3519	+ with info_file_path = my_anubis_directory+"/web_sites/dispatcher.info",
	3520	+ info_v = var((List(DispatcherInfo))[]),
	3521	+ info_date_v = var((Int)0),
	3522	+ if dispatcher_update_data(info_file_path,info_v,info_date_v)
	3523	+ then if start_server(ip_address,
	3524	+ http_port,
	3525	+ make_dispatcher_handler(info_v,dos),
	3526	+ (One u)\|->u) is
	3527	+ {
	3528	+ cannot_create_the_socket then
	3529	+ print("Cannot create the socket for HTTP server.\n"),
	3530	+ cannot_bind_to_port then
	3531	+ print("Cannot bind HTTP server to port "+http_port+".\n"),
	3532	+ cannot_listen_on_port then
	3533	+ print("HTTP server cannot listen on port "+http_port+".\n"),
	3534	+ ok(http_server) then
	3535	+ dispatcher_update_task(info_file_path,info_v,info_date_v)
	3536	+ }
	3537	+ else dispatcher_update_error(info_file_path).
	3538	+
	3539	+
	3540	+
	3541	+ *** [7.2] The dispatcher web site.
	3542	+
	3543	+ global define One
	3544	+ web_dispatcher
	3545	+ (
	3546	+ List(String) args
	3547	+ ) =
	3548	+ start_web_dispatcher(0,80,load_denial_of_service_info).
	3549	+
	3550	+
	3551	+
	3552	+
	3553	+
	3554	+
	3555	+ *** [7.3] Managing the info file.
	3556	+
	3557	+define Word32
	3558	+ register_ip_address
	3559	+ =
	3560	+ if ip_address(prompt(" numerical IP address (for HTTP): ")) is
	3561	+ {
	3562	+ failure then print(" *** Error: incorrect IP address.\n");
	3563	+ register_ip_address,
	3564	+ success(n) then n
	3565	+ }.
	3566	+
	3567	+
	3568	+define Word32
	3569	+ register_ip_port
	3570	+ =
	3571	+ if decimal_scan(prompt(" IP port (for HTTP): ")) is
	3572	+ {
	3573	+ failure then print(" *** Error: incorrect IP port.\n");
	3574	+ register_ip_port,
	3575	+ success(p) then if (0 =< p & p =< 65535)
	3576	+ then truncate_to_Word32(p)
	3577	+ else print(" *** Error: IP port out of bounds.\n");
	3578	+ register_ip_port
	3579	+ }.
	3580	+
	3581	+
	3582	+define One
	3583	+ register_new_site
	3584	+ (
	3585	+ Var(List(DispatcherInfo)) info_v
	3586	+ ) =
	3587	+ print("\n");
	3588	+ print(" Registering a new site:\n");
	3589	+ with name = prompt(" Site name: "),
	3590	+ with addr = register_ip_address,
	3591	+ with port = register_ip_port,
	3592	+ (protect info_v <- [site(name,port) . *info_v]);
	3593	+ print(" Site "+name+" at "+ip_addr_to_string(addr)+":"+port+" added\n (but not saved to disk).\n").
	3594	+
	3595	+
	3596	+define List(DispatcherInfo)
	3597	+ find_sites
	3598	+ (
	3599	+ List(DispatcherInfo) l,
	3600	+ String name
	3601	+ ) =
	3602	+ if l is
	3603	+ {
	3604	+ [ ] then [ ],
	3605	+ [h . t] then if h is site(n,_) then
	3606	+ if find(name,n,0) is
	3607	+ {
	3608	+ failure then find_sites(t,name),
	3609	+ success(_) then [h . find_sites(t,name)]
	3610	+ }
	3611	+ }.
	3612	+
	3613	+
	3614	+define String
	3615	+ pad
	3616	+ (
	3617	+ String s,
	3618	+ Int l
	3619	+ ) =
	3620	+ if length(s) >= l
	3621	+ then s
	3622	+ else s+constant_string(l-length(s),' ').
	3623	+
	3624	+
	3625	+
	3626	+define One
	3627	+ show_sites_1
	3628	+ (
	3629	+ List(DispatcherInfo) l,
	3630	+ Int i
	3631	+ ) =
	3632	+ if l is
	3633	+ {
	3634	+ [ ] then unique,
	3635	+ [h . t] then if h is site(name,port) then
	3636	+ print(" ["+i+"] "+pad(name,40)+" "+" "+port+"\n");
	3637	+ show_sites_1(t,i+1)
	3638	+ }.
	3639	+
	3640	+
	3641	+define One
	3642	+ show_sites
	3643	+ (
	3644	+ List(DispatcherInfo) l,
	3645	+ Int i
	3646	+ ) =
	3647	+ print(" Name Port\n");
	3648	+ print(" --------------------------------------------------------\n");
	3649	+ show_sites_1(l,i).
	3650	+
	3651	+define List(DispatcherInfo)
	3652	+ replace_info
	3653	+ (
	3654	+ List(DispatcherInfo) l,
	3655	+ String site_name,
	3656	+ Word32 new_port
	3657	+ ) =
	3658	+ if l is
	3659	+ {
	3660	+ [ ] then print("ALERT: Empty list into replace_info() [" + __FILE__ + "]\n"); [],
	3661	+ [h . t] then if h is site(n,_) then
	3662	+ if n = site_name
	3663	+ then [site(n,new_port) . t]
	3664	+ else [h . replace_info(t,site_name,new_port)]
	3665	+ }.
	3666	+
	3667	+define List(DispatcherInfo)
	3668	+ delete_info
	3669	+ (
	3670	+ List(DispatcherInfo) l,
	3671	+ String site_name,
	3672	+ ) =
	3673	+ if l is
	3674	+ {
	3675	+ [ ] then print("ALERT: Empty list into delete_info() [" + __FILE__ + "]\n"); [],
	3676	+ [h . t] then if h is site(n,_) then
	3677	+ if n = site_name
	3678	+ then t
	3679	+ else [h . delete_info(t,site_name)]
	3680	+ }.
	3681	+
	3682	+
	3683	+define One
	3684	+ update_site
	3685	+ (
	3686	+ Var(List(DispatcherInfo)) info_v,
	3687	+ String site_name,
	3688	+ Word32 old_port
	3689	+ ) =
	3690	+ print("\n");
	3691	+ print(" Updating site '"+site_name+"': (currently: "+old_port+")\n");
	3692	+ with new_port = register_ip_port,
	3693	+ answer = prompt(" Update '"+site_name+"' as: "+new_port+" [Y/N] ? "),
	3694	+ if (answer = "Y" \| answer = "y")
	3695	+ then info_v <- replace_info(*info_v,site_name,new_port)
	3696	+ else unique.
	3697	+
	3698	+
	3699	+
	3700	+define Bool
	3701	+ compare
	3702	+ (
	3703	+ DispatcherInfo d1,
	3704	+ DispatcherInfo d2
	3705	+ ) =
	3706	+ if d1 is site(n1,_) then
	3707	+ if d2 is site(n2,_) then
	3708	+ string_less(n1,n2).
	3709	+
	3710	+
	3711	+
	3712	+define One
	3713	+ update_site
	3714	+ (
	3715	+ Var(List(DispatcherInfo)) info_v
	3716	+ ) =
	3717	+ print("\n");
	3718	+ with prefix = prompt(" Search for site to update: "),
	3719	+ if find_sites(*info_v,prefix) is
	3720	+ {
	3721	+ [ ] then print(" No site found.\n");
	3722	+ update_site(info_v),
	3723	+ [h . t] then
	3724	+ show_sites(qsort([h . t],compare),1);
	3725	+ with i1 = prompt(" Choose a site to update [1/.../"+(length(t)+1)+"]: "),
	3726	+ if decimal_scan(i1) is
	3727	+ {
	3728	+ failure then print(" *** Error: site number not recognized.\n");
	3729	+ update_site(info_v),
	3730	+ success(ii1) then if nth(ii1-1,*info_v) is
	3731	+ {
	3732	+ failure then print(" *** Error: site number "+i1+" does not exist.\n");
	3733	+ update_site(info_v),
	3734	+ success(site_info) then if site_info is site(name,old_port) then
	3735	+ update_site(info_v,name,old_port)
	3736	+ }
	3737	+ }
	3738	+ }.
	3739	+
	3740	+
	3741	+define One
	3742	+ delete_site
	3743	+ (
	3744	+ Var(List(DispatcherInfo)) info_v,
	3745	+ String site_name,
	3746	+ Word32 old_port
	3747	+ ) =
	3748	+ print("\n");
	3749	+ print(" Deleting site '"+site_name+"': (currently: "+old_port+")\n");
	3750	+ with answer = prompt(" Are you sure you want to delete site: '"+site_name+"' [Y/N] ? "),
	3751	+ if (answer = "Y" \| answer = "y")
	3752	+ then info_v <- delete_info(*info_v,site_name)
	3753	+ else print(" Site '"+site_name+"' not deleted.\n").
	3754	+
	3755	+
	3756	+define One
	3757	+ delete_site
	3758	+ (
	3759	+ Var(List(DispatcherInfo)) info_v
	3760	+ ) =
	3761	+ print("\n");
	3762	+ with prefix = prompt(" Search for site to delete: "),
	3763	+ if find_sites(*info_v,prefix) is
	3764	+ {
	3765	+ [ ] then print(" No site found.\n");
	3766	+ delete_site(info_v),
	3767	+ [h . t] then
	3768	+ show_sites(qsort([h . t],compare),1);
	3769	+ with i1 = prompt(" Choose a site to delete [1/.../"+(length(t)+1)+"]: "),
	3770	+ if decimal_scan(i1) is
	3771	+ {
	3772	+ failure then print(" *** Error: site number not recognized.\n");
	3773	+ delete_site(info_v),
	3774	+ success(ii1) then if nth(ii1-1,*info_v) is
	3775	+ {
	3776	+ failure then print(" *** Error: site number "+i1+" does not exist.\n");
	3777	+ delete_site(info_v),
	3778	+ success(site_info) then if site_info is site(name,old_port) then
	3779	+ delete_site(info_v,name,old_port)
	3780	+ }
	3781	+ }
	3782	+ }.
	3783	+
	3784	+
	3785	+define One
	3786	+ manager
	3787	+ (
	3788	+ Var(List(DispatcherInfo)) info_v,
	3789	+ String file_path
	3790	+ ) =
	3791	+ print("\n");
	3792	+ print(" --- Welcome to the Web Dispatcher Manager ---\n");
	3793	+ with l = length(*info_v),
	3794	+ print(" "+l+" site"+(if l>1 then "s" else "")+" currently registred.\n");
	3795	+ print(" [L] List registered sites.\n");
	3796	+ print(" [R] Register a new site.\n");
	3797	+ print(" [U] Update a registred site.\n");
	3798	+ print(" [D] Delete a registred site.\n");
	3799	+ with propose_write_v = var((Bool)true),
	3800	+ action = prompt(" Choose an action [L/R/U/D]: "),
	3801	+ (if (action = "L" \| action = "l") then (show_sites(*info_v,1); propose_write_v <- false) else
	3802	+ if (action = "R" \| action = "r") then register_new_site(info_v) else
	3803	+ if (action = "U" \| action = "u") then update_site(info_v) else
	3804	+ if (action = "D" \| action = "d") then delete_site(info_v) else
	3805	+ print("Action not recognized.\n"));
	3806	+ print("\n");
	3807	+ if *propose_write_v then
	3808	+ with result = prompt(" Write modifications to data base [Y/N] ?"),
	3809	+ if (result = "Y" \| result = "y")
	3810	+ then if save(*info_v,file_path) is
	3811	+ {
	3812	+ cannot_open_file then print(" File '"+file_path+"' not found.\n"),
	3813	+ write_error then print(" Error while writing file '"+file_path+"'.\n"),
	3814	+ ok then print(" Data base has been modified.\n")
	3815	+ }
	3816	+ else print(" Data base not modified.\n")
	3817	+ else unique.
	3818	+
	3819	+
	3820	+
	3821	+global define One
	3822	+ manage_web_dispatcher
	3823	+ (
	3824	+ List(String) args
	3825	+ ) =
	3826	+ with info_v = var((List(DispatcherInfo))[]),
	3827	+ with file_path = my_anubis_directory+"/web_sites/dispatcher.info",
	3828	+ if (RetrieveResult(List(DispatcherInfo)))retrieve(file_path) is
	3829	+ {
	3830	+ cannot_find_file then print("File '"+file_path+"' does not exist.\n");
	3831	+ with answer = prompt("Create it [Y/N] ? "),
	3832	+ if (answer = "Y" \| answer = "y")
	3833	+ then if save((List(DispatcherInfo))[],file_path) is
	3834	+ {
	3835	+ cannot_open_file then
	3836	+ print("Cannot create file '"+file_path+"'.\n"),
	3837	+ write_error then
	3838	+ print("Error while creating file '"+file_path+"'.\n"),
	3839	+ ok then manager(info_v,file_path)
	3840	+ }
	3841	+ else unique,
	3842	+ read_error then print("Error while reading file '"+file_path+"'.\n"),
	3843	+ type_error then print("File '"+file_path+"' is corrupted.\n"),
	3844	+ ok(info) then info_v <- info;
	3845	+ manager(info_v,file_path)
	3846	+ }.
	3847	+
	3848	+
	3849	+
	3850	+
	3851	+
...	...

MF_1_1/web/CXM_web_arg_encode.anubis 0 → 100644

Wrap text Show/Hide comments View file @9ca943b

	1	+
	2	+ Project The Anubis Project
	3	+
	4	+ Title Encoding data for web argument values.
	5	+
	6	+ Copyright Copyright (c) Alain Prouté 2002.
	7	+
	8	+
	9	+ Author Alain Prouté
	10	+
	11	+
	12	+
	13	+ Overview
	14	+ This file contains encoding and decoding functions which allow to put any serializable
	15	+ datum as the value of a web argument. The datum is serialized, and the result of
	16	+ serialization (a byte array) is encoded in such a way that it can safely be used as the
	17	+ value of a web argument. The encoding process is similar to the standard process
	18	+ 'base64', but nevertheless different, because base64 is not suitable for that purpose.
	19	+
	20	+
	21	+public define String
	22	+ web_arg_encode
	23	+ (
	24	+ $T datum
	25	+ ).
	26	+
	27	+public define Maybe($T)
	28	+ web_arg_decode
	29	+ (
	30	+ String encoded_value
	31	+ ).
	32	+
	33	+ Of course, since the type of the datum is not available from 'encoded_value', a term
	34	+ like 'web_arg_decode(my_string)' must generally be explicitly typed, like this:
	35	+
	36	+ (Maybe(MyType))web_arg_decode(my_string)
	37	+
	38	+
	39	+ These functions are used for example in 'anubis/library/web/kernel.anubis'.
	40	+
	41	+
	42	+
	43	+
	44	+
	45	+ --- That's all for the public part. ---------------------------------------------------
	46	+
	47	+read tools/basis.anubis
	48	+read system/convert.anubis
	49	+
	50	+ Our algorithms are copy-pasted from 'base64.anubis' and slightly modified. The point is
	51	+ twofold:
	52	+
	53	+ (1) base64 encoding inserts carriage return (CR) and line feed (LF) characters every
	54	+ 76 character, but CR and LF are not suitable in the values of a web argument,
	55	+
	56	+ (2) the base64 alphabet uses '+' and '/', which are also not suitable in the value of
	57	+ a web argument, because they have special meanings.
	58	+
	59	+ Hence, we just have to modify the base64 algorithms, so as not to generate any CR or
	60	+ LF, and use '-' and '_' instead of '+' and '/'. Also, we do not use padding characters
	61	+ '=', which are needless (as remarked in 'anubis/library/tools/base64.anubis').
	62	+
	63	+
	64	+
	65	+ * Encoding. ***********************************************************************
	66	+
	67	+ Translate an index into a wa64 character.
	68	+
	69	+define Word8
	70	+ wa64_alphabet
	71	+ (
	72	+ Word32 index // the index is assumed to be >= 0 and < 64
	73	+ ) =
	74	+ if index -< 0 then print("Bad index [" + index + "] in wa64_alphabet()\n"); '_' else
	75	+ if index -< 26 then truncate_to_Word8(index+'A') else
	76	+ if index -< 52 then truncate_to_Word8(index-26+'a') else
	77	+ if index -< 62 then truncate_to_Word8(index-52+'0') else
	78	+ if index = 62 then '-' else
	79	+ if index = 63 then '_' else
	80	+ print("Bad index [" + index + "] in wa64_alphabet()\n"); '_'.
	81	+
	82	+
	83	+
	84	+ Transform a group of 3 bytes into a group of 4 wa64 letters.
	85	+
	86	+
	87	+define Word32
	88	+ to_word32
	89	+ (
	90	+ Word8 x
	91	+ ) =
	92	+ word32(word16(x,0),0).
	93	+
	94	+define (Word8,Word8,Word8,Word8)
	95	+ transform_group
	96	+ (
	97	+ Word8 byte1,
	98	+ Word8 byte2,
	99	+ Word8 byte3
	100	+ ) =
	101	+ with n1 = to_word32(byte1),
	102	+ n2 = to_word32(byte2),
	103	+ n3 = to_word32(byte3),
	104	+ (
	105	+ wa64_alphabet(n1>>2),
	106	+ wa64_alphabet(((n1&3)<<4)\|(n2>>4)),
	107	+ wa64_alphabet(((n2&15)<<2)\|(n3>>6)),
	108	+ wa64_alphabet(n3&63)
	109	+ ).
	110	+
	111	+
	112	+ Transform a group of two bytes.
	113	+
	114	+define ByteArray
	115	+ two_mod_three
	116	+ (
	117	+ ByteArray result,
	118	+ Int result_index,
	119	+ Word8 byte1,
	120	+ Word8 byte2
	121	+ ) =
	122	+ with n1 = to_word32(byte1),
	123	+ n2 = to_word32(byte2),
	124	+ forget(put(result,result_index ,wa64_alphabet(n1>>2)));
	125	+ forget(put(result,result_index+1,wa64_alphabet(((n1&3)<<4)\|(n2>>4))));
	126	+ forget(put(result,result_index+2,wa64_alphabet((n2&15)<<2)));
	127	+ forget(put(result,result_index+4,0));
	128	+ result.
	129	+
	130	+
	131	+
	132	+ Transform a 'group of one byte'.
	133	+
	134	+define ByteArray
	135	+ one_mod_three
	136	+ (
	137	+ ByteArray result,
	138	+ Int result_index,
	139	+ Word8 byte1
	140	+ ) =
	141	+ with n1 = to_word32(byte1),
	142	+ forget(put(result,result_index ,wa64_alphabet(n1>>2)));
	143	+ forget(put(result,result_index+1,wa64_alphabet((n1&3)<<4)));
	144	+ forget(put(result,result_index+4,0));
	145	+ result.
	146	+
	147	+
	148	+
	149	+define ByteArray
	150	+ wa64_encode
	151	+ (
	152	+ ByteArray ba,
	153	+ Int ba_index, // index into byte array
	154	+ ByteArray result,
	155	+ Int result_index
	156	+ ) =
	157	+ if nth(ba_index,ba) is
	158	+ {
	159	+ failure then forget(put(result,result_index,0)); result, // no new block of 3 bytes
	160	+ success(byte1) then
	161	+ if nth(ba_index+1,ba) is
	162	+ {
	163	+ failure then one_mod_three(result,result_index,byte1),
	164	+ success(byte2) then
	165	+ if nth(ba_index+2,ba) is
	166	+ {
	167	+ failure then two_mod_three(result,result_index,byte1,byte2),
	168	+ success(byte3) then
	169	+ if transform_group(byte1,byte2,byte3) is (c1,c2,c3,c4) then
	170	+ (
	171	+ forget(put(result,result_index,c1));
	172	+ forget(put(result,result_index+1,c2));
	173	+ forget(put(result,result_index+2,c3));
	174	+ forget(put(result,result_index+3,c4));
	175	+ wa64_encode(ba,
	176	+ ba_index+3,
	177	+ result,
	178	+ result_index+4)
	179	+ )
	180	+ }
	181	+ }
	182	+ }.
	183	+
	184	+
	185	+
	186	+define ByteArray
	187	+ wa64_encode
	188	+ (
	189	+ ByteArray ba
	190	+ ) =
	191	+ with l = length(ba),
	192	+ wa64_encode(ba,0,
	193	+ constant_byte_array((((l\57)+1)*76)+10,0),0).
	194	+
	195	+
	196	+public define String
	197	+ web_arg_encode
	198	+ (
	199	+ $T datum
	200	+ ) =
	201	+ to_string(wa64_encode(serialize(datum))).
	202	+
	203	+
	204	+
	205	+
	206	+
	207	+ * Decoding. ***********************************************************************
	208	+
	209	+ See the comments in 'anubis/library/tools/base64.anubis'.
	210	+
	211	+ Checking if a character belongs to the wa64 alphabet. If true, the function returns the
	212	+ index of the character in the alphabet.
	213	+
	214	+define Maybe(Word32)
	215	+ is_wa64_char
	216	+ (
	217	+ Word8 c
	218	+ ) =
	219	+ with n = to_word32(c),
	220	+ if ('A' +=< n & n +=< 'Z') then success(n - 'A') else
	221	+ if ('a' +=< n & n +=< 'z') then success(n - 'a' + 26) else
	222	+ if ('0' +=< n & n +=< '9') then success(n - '0' + 52) else
	223	+ if n = '-' then success(62) else
	224	+ if n = '_' then success(63) else
	225	+ failure.
	226	+
	227	+
	228	+
	229	+ Getting the next wa64 character from the input. The function returns the next position
	230	+ for reading. The function does not return the character itself, but its index in the
	231	+ alphabet.
	232	+
	233	+define Maybe((Int, // next position for reading
	234	+ Word32)) // index of character in wa64 alphabet
	235	+ get_next_character
	236	+ (
	237	+ ByteArray ba,
	238	+ Int n
	239	+ ) =
	240	+ if nth(n,ba) is
	241	+ {
	242	+ failure then failure,
	243	+ success(c) then
	244	+ if is_wa64_char(c) is
	245	+ {
	246	+ failure then failure,
	247	+ success(i) then success((n+1,i))
	248	+ }
	249	+ }.
	250	+
	251	+
	252	+ Translating a group of characters into a group of bytes.
	253	+
	254	+type TranslateGroupResult:
	255	+ three_bytes (Int new_pos, Word8 b1, Word8 b2, Word8 b3),
	256	+ two_bytes ( Word8 b1, Word8 b2 ),
	257	+ one_byte ( Word8 b1 ),
	258	+ zero_bytes,
	259	+ error.
	260	+
	261	+
	262	+define TranslateGroupResult
	263	+ translate_group
	264	+ (
	265	+ ByteArray ba,
	266	+ Int n
	267	+ ) =
	268	+ if get_next_character(ba,n) is
	269	+ {
	270	+ failure then zero_bytes,
	271	+ success(p1) then if p1 is (n1,i1) then
	272	+ if get_next_character(ba,n1) is
	273	+ {
	274	+ failure then error,
	275	+ success(p2) then if p2 is (n2,i2) then
	276	+ if get_next_character(ba,n2) is
	277	+ {
	278	+ failure then // we don't check the padding characters
	279	+ one_byte(truncate_to_Word8((i1<<2)\|(i2>>4))),
	280	+ success(p3) then if p3 is (n3,i3) then
	281	+ if get_next_character(ba,n3) is
	282	+ {
	283	+ failure then
	284	+ two_bytes(truncate_to_Word8((i1<<2)\|(i2>>4)),
	285	+ truncate_to_Word8(((i2&15)<<4)\|(i3>>2))),
	286	+ success(p4) then if p4 is (n4,i4) then
	287	+ three_bytes(n4,truncate_to_Word8((i1<<2)\|(i2>>4)),
	288	+ truncate_to_Word8(((i2&15)<<4)\|(i3>>2)),
	289	+ truncate_to_Word8(((i3&3)<<6)\|i4))
	290	+ }
	291	+ }
	292	+ }
	293	+ }.
	294	+
	295	+
	296	+define Int // returns the size of the decoded array of bytes
	297	+ translate_groups
	298	+ (
	299	+ ByteArray source,
	300	+ Int n, // position in source
	301	+ ByteArray target,
	302	+ Int m // position in target
	303	+ ) =
	304	+ if translate_group(source,n) is
	305	+ {
	306	+ three_bytes(n1,b1,b2,b3) then
	307	+ forget(put(target,m,b1));
	308	+ forget(put(target,m+1,b2));
	309	+ forget(put(target,m+2,b3));
	310	+ translate_groups(source,n1,target,m+3),
	311	+
	312	+ two_bytes(b1,b2) then
	313	+ forget(put(target,m,b1));
	314	+ forget(put(target,m+1,b2));
	315	+ m+2,
	316	+
	317	+ one_byte(b1) then
	318	+ forget(put(target,m,b1));
	319	+ m+1,
	320	+
	321	+ zero_bytes then
	322	+ m,
	323	+
	324	+ error then
	325	+ m
	326	+ }.
	327	+
	328	+
	329	+define ByteArray
	330	+ wa64_decode
	331	+ (
	332	+ ByteArray ba
	333	+ ) =
	334	+ with l = length(ba),
	335	+ result = constant_byte_array(l,'0'),
	336	+ truncate(result,translate_groups(ba,0,result,0));
	337	+ result.
	338	+
	339	+public define Maybe($T)
	340	+ web_arg_decode
	341	+ (
	342	+ String encoded_datum
	343	+ ) =
	344	+ (Maybe($T))unserialize(wa64_decode(to_byte_array(encoded_datum))).
	345	+
	346	+
	347	+
	348	+
	349	+
...	...

MF_1_1/web/counter.anubis 0 → 100644

Wrap text Show/Hide comments View file @9ca943b

	1	+
	2	+ Project Anubis
	3	+
	4	+
	5	+ A counter for web pages.
	6	+
	7	+
	8	+
	9	+read tools/basis.anubis
	10	+read web/making_a_web_site.anubis
	11	+
	12	+
	13	+
	14	+ Public
	15	+
	16	+
	17	+
	18	+ This is the counter to be inserted into a web page:
	19	+
	20	+public define HTML_Off_Form
	21	+ web_counter
	22	+ (
	23	+ String directory, // where the counter file will be located
	24	+ String name, // name of counter
	25	+ Int text_size // size of characters of counter
	26	+ ).
	27	+
	28	+
	29	+ Below is the function to call to increment the counter.
	30	+
	31	+public define One
	32	+ increment_web_counter
	33	+ (
	34	+ String directory, // where the counter file will be located
	35	+ String name // name of counter
	36	+ ).
	37	+
	38	+
	39	+ In order to reset the counter to 0, just delete the file:
	40	+
	41	+ directory+"/"+name+".counter"
	42	+
	43	+
	44	+
	45	+
	46	+ Private
	47	+
	48	+
	49	+define List(Word8)
	50	+ zero_pad
	51	+ (
	52	+ List(Word8) l,
	53	+ Int n
	54	+ ) =
	55	+ if length(l) < to_Int(n)
	56	+ then zero_pad(['0' . l],n)
	57	+ else l.
	58	+
	59	+
	60	+define HTML_Off_Form
	61	+ web_counter
	62	+ (
	63	+ Int n, // value of counter
	64	+ Int text_size // size of text
	65	+ ) =
	66	+ with black = rgb(0,0,0),
	67	+ white = rgb(255,255,255),
	68	+ table([border(1,0,1,black)],[row(
	69	+ table([border(0,1,0,black),background_color(black)],[row(
	70	+ [cell([background_color(black),width(2)],text([],"")) .
	71	+ map((Word8 c) \|-> cell([background_color(black),width(8),h_center],
	72	+ text([size(text_size),color(white),bold],""+(to_Word32(c)-'0'))),
	73	+ zero_pad(explode(to_decimal(n)),8))]
	74	+ )])
	75	+ )]).
	76	+
	77	+
	78	+
	79	+public define HTML_Off_Form
	80	+ web_counter
	81	+ (
	82	+ String directory, // where the counter file will be located
	83	+ String name, // name of counter
	84	+ Int text_size // size of characters of counter
	85	+ ) =
	86	+ if (RetrieveResult(Int))retrieve(directory+"/"+name+".counter") is
	87	+ {
	88	+ cannot_find_file then web_counter(0,text_size),
	89	+ read_error then web_counter(0,text_size),
	90	+ type_error then web_counter(0,text_size),
	91	+ ok(n) then web_counter(n,text_size),
	92	+ }.
	93	+
	94	+
	95	+
	96	+public define One
	97	+ increment_web_counter
	98	+ (
	99	+ String directory,
	100	+ String name,
	101	+ ) =
	102	+ with path = directory+"/"+name+".counter",
	103	+ protect
	104	+ if (RetrieveResult(Int))retrieve(path) is
	105	+ {
	106	+ cannot_find_file then forget(save((Int)1,path)),
	107	+ read_error then unique,
	108	+ type_error then unique,
	109	+ ok(n) then forget(save((Int)(n+1),path))
	110	+ }.
	111	+
	112	+
	113	+
0	114	\ No newline at end of file
...	...