From 4cc8efb4b1cb90723200e7c065a4c9095fd37da0 Mon Sep 17 00:00:00 2001 From: totoro Date: Mon, 15 Feb 2021 14:59:42 +0900 Subject: [PATCH] start refactoring filename without CXM prefix --- mail/send_mail.anubis | 12 ++++++------ net_services/CXM_generic_client.anubis | 438 ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ net_services/CXM_generic_protocol.anubis | 247 ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- net_services/CXM_net_services.anubis | 227 ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- net_services/generic_client.anubis | 438 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ net_services/generic_protocol.anubis | 247 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ net_services/get_file.anubis | 6 +++--- net_services/net_services.anubis | 228 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ net_services/send_file.anubis | 6 +++--- net_services_protocols/ftp_client.anubis | 6 +++--- net_services_protocols/logger_server.anubis | 2 +- unit_test/xml_rpc.unit_test.anubis | 8 ++++---- web/CXM_dojo.anubis | 828 ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ web/CXM_dropzone.anubis | 59 ----------------------------------------------------------- web/CXM_generic_form.anubis | 471 --------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- web/CXM_generic_login.anubis | 116 -------------------------------------------------------------------------------------------------------------------- web/CXM_generic_table.anubis | 786 ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ web/CXM_http_get.anubis | 318 ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ web/CXM_https_get.anubis | 390 ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ web/CXM_mime.anubis | 70 ---------------------------------------------------------------------- web/CXM_style_tools.anubis | 18 ------------------ web/CXM_web_arg_encode.anubis | 349 ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- web/CXM_xml_rpc.anubis | 418 ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- web/CXM_xml_rpc_parser.anubis | 481 ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- web/CXM_xml_rpc_types.anubis | 113 ----------------------------------------------------------------------------------------------------------------- web/XL_web_stepper.anubis | 339 --------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- web/common.anubis | 2 +- web/controllers_web_site.anubis | 2 +- web/dojo.anubis | 828 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ web/dropzone.anubis | 59 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ web/fonts/awesome.anubis | 2 +- web/generic_form.anubis | 471 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ web/generic_login.anubis | 116 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ web/generic_table.anubis | 786 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ web/http_get.anubis | 318 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ web/https_get.anubis | 390 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ web/jQuery/jq_animate.anubis | 14 +++++++------- web/jQuery/jq_button.anubis | 8 ++++---- web/jQuery/jq_dialog.anubis | 4 ++-- web/jQuery/jq_flot.anubis | 2 +- web/jQuery/jq_radio.anubis | 8 ++++---- web/jQuery/jq_tabs.anubis | 4 ++-- web/jquery.anubis | 6 +++--- web/js/cxm_jquery_animate.js | 116 -------------------------------------------------------------------------------------------------------------------- web/js/jquery_animate.js | 116 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ web/load_content.anubis | 6 +++--- web/making_a_web_site.anubis | 4 ++-- web/mime.anubis | 70 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ web/multihost_http_server.anubis | 2 +- web/piwik/CXM_piwik.anubis | 43 ------------------------------------------- web/piwik/piwik.anubis | 43 +++++++++++++++++++++++++++++++++++++++++++ web/style_tools.anubis | 18 ++++++++++++++++++ web/types/XL_web_stepper.anubis | 89 ----------------------------------------------------------------------------------------- web/types/web_stepper.anubis | 89 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ web/web_arg_encode.anubis | 349 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ web/web_stepper.anubis | 339 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ web/widgets/button.anubis | 5 +++-- web/widgets/dashboard.anubis | 4 ++-- web/widgets/fisheye_menu.anubis | 6 +++--- web/widgets/icon.anubis | 2 +- web/widgets/left_menu_html.anubis | 6 +++--- web/widgets/menu.anubis | 4 ++-- web/widgets/pager.anubis | 6 +++--- web/xml_rpc.anubis | 418 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ web/xml_rpc_parser.anubis | 481 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ web/xml_rpc_types.anubis | 113 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 66 files changed, 5986 insertions(+), 5984 deletions(-) delete mode 100644 net_services/CXM_generic_client.anubis delete mode 100644 net_services/CXM_generic_protocol.anubis delete mode 100644 net_services/CXM_net_services.anubis create mode 100644 net_services/generic_client.anubis create mode 100644 net_services/generic_protocol.anubis create mode 100644 net_services/net_services.anubis delete mode 100644 web/CXM_dojo.anubis delete mode 100644 web/CXM_dropzone.anubis delete mode 100644 web/CXM_generic_form.anubis delete mode 100644 web/CXM_generic_login.anubis delete mode 100644 web/CXM_generic_table.anubis delete mode 100644 web/CXM_http_get.anubis delete mode 100644 web/CXM_https_get.anubis delete mode 100644 web/CXM_mime.anubis delete mode 100644 web/CXM_style_tools.anubis delete mode 100644 web/CXM_web_arg_encode.anubis delete mode 100644 web/CXM_xml_rpc.anubis delete mode 100644 web/CXM_xml_rpc_parser.anubis delete mode 100644 web/CXM_xml_rpc_types.anubis delete mode 100644 web/XL_web_stepper.anubis create mode 100644 web/dojo.anubis create mode 100644 web/dropzone.anubis create mode 100644 web/generic_form.anubis create mode 100644 web/generic_login.anubis create mode 100644 web/generic_table.anubis create mode 100644 web/http_get.anubis create mode 100644 web/https_get.anubis delete mode 100644 web/js/cxm_jquery_animate.js create mode 100644 web/js/jquery_animate.js create mode 100644 web/mime.anubis delete mode 100644 web/piwik/CXM_piwik.anubis create mode 100644 web/piwik/piwik.anubis create mode 100644 web/style_tools.anubis delete mode 100644 web/types/XL_web_stepper.anubis create mode 100644 web/types/web_stepper.anubis create mode 100644 web/web_arg_encode.anubis create mode 100644 web/web_stepper.anubis create mode 100644 web/xml_rpc.anubis create mode 100644 web/xml_rpc_parser.anubis create mode 100644 web/xml_rpc_types.anubis diff --git a/mail/send_mail.anubis b/mail/send_mail.anubis index dc63587..4481792 100644 --- a/mail/send_mail.anubis +++ b/mail/send_mail.anubis @@ -25,7 +25,7 @@ read authentication.anubis read smtp_client.anubis public define String send_mail_log = "SendMail". -public define String cxm_lib = "cxm_lib". +public define String xlib = "Xlib". public define LogMask send_mail_mask = logMask("send_mail"). @@ -214,8 +214,8 @@ public define Result(SmtpClientResult, One) param, prepare_mail_callback, (Int _) |-> unique, - (LogLevel level, String txt) |-> if level is logTrace then log(cxm_lib, logDebug, send_mail_log, txt) - else log(cxm_lib, level, send_mail_log, txt), + (LogLevel level, String txt) |-> if level is logTrace then log(xlib, logDebug, send_mail_log, txt) + else log(xlib, level, send_mail_log, txt), handle_result ). @@ -243,17 +243,17 @@ public define Result(SmtpClientResult, One) { failure then //println("IP address NOT found for Mail server ["+server+"]"); - logWarning(cxm_lib, send_mail_log,"IP address NOT found for Mail server ["+server+"]"); + logWarning(xlib, send_mail_log,"IP address NOT found for Mail server ["+server+"]"); error(error), success(ip_addr) then with ip_txt = ip_addr_to_string(ip_addr), - logTrace(cxm_lib, send_mail_log, send_mail_mask, "send_mail: Trying to connect to "+ip_txt); + logTrace(xlib, send_mail_log, send_mail_mask, "send_mail: Trying to connect to "+ip_txt); //println("send_mail: Trying to connect to "+ip_txt); if (Result(NetworkConnectError,RWStream))connect(ip_addr, port) is { error(e) then - logWarning(cxm_lib, send_mail_log, "send_mail: Can't connect to "+ip_txt); + logWarning(xlib, send_mail_log, "send_mail: Can't connect to "+ip_txt); error(error), ok(server_conn) then diff --git a/net_services/CXM_generic_client.anubis b/net_services/CXM_generic_client.anubis deleted file mode 100644 index 4d52d37..0000000 --- a/net_services/CXM_generic_client.anubis +++ /dev/null @@ -1,438 +0,0 @@ -/* - * Created by PyramIDE. - * User: ricard - * Date: 02/02/2008 - * Time: 11:47 - * - * - */ - -transmit system/message_transceiver.anubis -transmit system/logger.anubis -read network/dns.anubis - -//transmit xlib/net_services_protocols/logger_service.anubis - -transmit xlib/message_constants.anubis -transmit xlib/net_services/net_services.anubis -transmit xlib/net_services/generic_protocol.anubis - -// --Generic types--------------------------------------------------------------------- -public type NetServiceAnswer: - netservice_error (Word32 cmd, - Word32 result_code, - String result_string), - netservice_ok (Word32 cmd, - Maybe(Message) result_msg). - -// --Generic functions--------------------------------------------------------------------- - -/** - * Sends the message to the server then parses the answer and returns the RESULT message on CMD success. - */ -public define Maybe(NetServiceAnswer) - generic_send_message - ( - MessageQueue queue, - Message msg_to_send, - Int timeout, - (String) -> One logger - )= - queue.add_Message_to_send(msg_to_send); - if queue.get_next_received_Message(timeout) is - { - timeout then logger("["+queue.get_name(unique)+"]: receive timeout");failure, - closed then logger("["+queue.get_name(unique)+"]: socket closed");failure, - msg(msg) then - if find_int32(msg, "CMD") is - { - failure then logger("["+queue.get_name(unique)+"]: CMD field not found"); failure, - success(cmd) then - if find_int32(msg, "STATUS") is - { - failure then logger("["+queue.get_name(unique)+"]: STATUS field not found"); failure, - success(v) then - if v = _CXM_OK then - success(netservice_ok(cmd, find_message(msg, "RESULT"))) - else - with error_string = if find_string(msg, "STATUS_MSG") is success(s) then s else "", - success(netservice_error(cmd, v, error_string)) - } - } - }. - - -public define Maybe(NetServiceAnswer) -/** - * Sends the message to the server then parses the answer and returns the RESULT message on CMD success. - * - */ - generic_send_message - ( - MessageQueue queue, - Message msg_to_send, - Int timeout, - (LogLevel, String) -> One logger - )= - queue.add_Message_to_send(msg_to_send); - if queue.get_next_received_Message(timeout) is - { - timeout then logger(logError, "["+queue.get_name(unique)+"]: receive timeout");failure, - closed then logger(logError, "["+queue.get_name(unique)+"]: socket closed");failure, - msg(msg) then - if find_int32(msg, "CMD") is - { - failure then logger(logError, "["+queue.get_name(unique)+"]: CMD field not found"); failure, - success(cmd) then - if find_int32(msg, "STATUS") is - { - failure then logger(logError, "["+queue.get_name(unique)+"]: STATUS field not found"); failure, - success(v) then - if v = _CXM_OK then - success(netservice_ok(cmd, find_message(msg, "RESULT"))) - else - with error_string = if find_string(msg, "STATUS_MSG") is success(s) then s else "", - success(netservice_error(cmd, v, error_string)) - } - } - }. - -public define Maybe($T) - simple_handler - ( - MessageQueue queue, - String timestamp, - Int timeout, - Message msg_to_send, - (Message, MessageQueue, String) -> Maybe($T) handler, - (LogLevel, String) -> One logger - ) = - if generic_send_message(queue, msg_to_send, timeout, logger) is - { - failure then failure, - success(net_result) then - if net_result is - { - netservice_error(cmd, err_code, err_str) then - logger(logError, "["+queue.get_name(unique)+"]: message status ERROR [0x" + to_hexa(err_code) + ", '" + err_str + "']"); - failure, - netservice_ok(cmd, mb_msg) then - if mb_msg is - { - failure then logger(logError,"["+queue.get_name(unique)+"]: can't find RESULT message."); failure, - success(result) then handler(result, queue, timestamp) - } - } - }. - -public define Maybe(One) - no_result_handler - ( - MessageQueue queue, - Int timeout, - Message msg_to_send, - (LogLevel, String) -> One logger - ) = - if generic_send_message(queue, msg_to_send, timeout, logger) is - { - failure then failure, - success(net_result) then - if net_result is - { - netservice_error(cmd, err_code, err_str) then - logger(logError, "["+queue.get_name(unique)+"]: message status ERROR [0x" + to_hexa(err_code) + ", '" + err_str + "']"); - failure, - netservice_ok(cmd, mb_msg) then - if mb_msg is - { - failure then unique, - success(result) then logger(logError, "An unattended RESULT msg was found. Ignoring it...") - }; - success(unique) - } - }. - -public define (MessageQueue, String) -> Maybe($T) - make_generic_handler - ( - Int timeout, - Message msg_to_send, - (Message, MessageQueue, String) -> Maybe($T) handler, - (LogLevel, String) -> One logger - ) = - (MessageQueue queue, String timestamp) |-> - simple_handler(queue, timestamp, timeout, msg_to_send, handler, logger). - -define Maybe($T) - generic_request_for_service - ( - MessageQueue queue, - Word32 service_id, - Word32 service_version, - String domain, - (MessageQueue, String) -> Maybe($T) handler, - (LogLevel, String) -> One logger - )= - with test_msg = message(_CXM_REQUEST_FOR_SERVICE), - forget(add_int32(test_msg, "SERVICE", service_id)); - forget(add_int32(test_msg, "VERSION", service_version)); - forget(add_string(test_msg, "DOMAIN", domain)); - queue.add_Message_to_send(test_msg); - if queue.get_next_received_Message(10) is - { - timeout then logger(logError, "["+queue.get_name(unique)+"]: requesting service receive timeout");failure, - closed then logger(logError, "["+queue.get_name(unique)+"]: requesting service socket closed");failure, - msg(msg) then - if find_int32(msg, "STATUS") is - { - failure then logger(logError, "["+queue.get_name(unique)+"]: requesting service STATUS not found");failure, - success(v) then - if v = _CXM_OK then - if find_message(msg, "RESULT") is - { - failure then logger(logError, "["+queue.get_name(unique)+"]: requesting service RESULT not found");failure, - success(result) then - with timestamp = if find_string(result, "TIMESTAMP") is - { - failure then logger(logError, "["+queue.get_name(unique)+"]: requesting service TIMESTAMP not found"); "", - success(timestamp) then timestamp - }, - handler(queue, timestamp) - } - else - logger(logError, "["+queue.get_name(unique)+"]: the requested service is not available on server.");failure - } - }. - -// define Maybe($T) -// generic_request_for_service -// ( -// MessageQueue queue, -// Word32 service_id, -// Word32 service_version, -// String domain, -// (MessageQueue, String) -> Maybe($T) handler, -// (LogLevel, String) -> One logger -// )= -// with test_msg = message(_CXM_REQUEST_FOR_SERVICE), -// forget(add_int32(test_msg, "SERVICE", service_id)); -// forget(add_int32(test_msg, "VERSION", service_version)); -// forget(add_string(test_msg, "DOMAIN", domain)); -// queue.add_Message_to_send(test_msg); -// if queue.get_next_received_Message(10) is -// { -// timeout then logger(logError, "["+queue.get_name(unique)+"]: requesting service receive timeout");failure, -// closed then logger(logError, "["+queue.get_name(unique)+"]: requesting service socket closed");failure, -// msg(msg) then -// if find_int32(msg, "STATUS") is -// { -// failure then logger(logError, "["+queue.get_name(unique)+"]: requesting service STATUS not found");failure, -// success(v) then -// if v = _CXM_OK then -// if find_message(msg, "RESULT") is -// { -// failure then logger(logError, "["+queue.get_name(unique)+"]: requesting service RESULT not found");failure, -// success(result) then -// with timestamp = if find_string(result, "TIMESTAMP") is -// { -// failure then logger(logError, "["+queue.get_name(unique)+"]: requesting service TIMESTAMP not found"); "", -// success(timestamp) then timestamp -// }, -// handler(queue, timestamp) -// } -// else -// logger(logError, "["+queue.get_name(unique)+"]: the requested service is not available on server.");failure -// } -// }. -// -public define Maybe(MessageQueue) - get_message_queue_to_net_service - ( - String queue_name, - Word32 server, - Word32 port, - Word32 service_id, - Word32 service_version, - String domain, - (MessageQueue, String) -> Maybe(One) handler, //1st function to apply if need (i.e authentication to remote service) - (LogLevel, String) -> One logger - ) - = - if connect( server, port) is - { - error(_) then logger(logError, queue_name + ": Can't connect to service ["+ip_addr_to_string(server)+":"+port+"]");failure, - ok(conn) then -// println("[" + virtual_machine_id + "] netservices create queue"); - with queue = create_MessageQueue(queue_name, tcp(conn)), - message_transceiver(/*tcp(conn),*/ queue); -// println("[" + virtual_machine_id + "] netservices generic_request_for_service()"); - if generic_request_for_service(queue, service_id, service_version, domain, handler, logger) is - { - failure then - //we can't apply first function correctly, so we ask to Message Queue to quit and return failure - logger(logError, "can't apply first function correctly"); - queue.quit(unique); - failure, - success(_) then success(queue) - } - }. - - -public define Maybe($T) - generic_connect_to_net_service - ( - String queue_name, - Word32 server, - Word32 port, - Word32 service_id, - Word32 service_version, - String domain, - (MessageQueue, String) -> Maybe($T) handler, - (LogLevel, String) -> One logger - ) - = - if connect( server, port) is - { - error(_) then logger(logError, queue_name + ": Can't connect to service ["+ip_addr_to_string(server)+":"+port+"]");failure, - ok(conn) then -// println("[" + virtual_machine_id + "] netservices create queue"); - with queue = create_MessageQueue(queue_name, tcp(conn)), - message_transceiver(queue); -// println("[" + virtual_machine_id + "] netservices generic_request_for_service()"); - with result = generic_request_for_service(queue, service_id, service_version, domain, handler, logger), -// println("[" + virtual_machine_id + "] netservices client quit"); - queue.quit(unique); - result - }. - - //legacy version which not handle the domain - -public define Maybe($T) - generic_connect_to_net_service - ( - String queue_name, - Word32 server, - Word32 port, - Word32 service_id, - Word32 service_version, - (MessageQueue, String) -> Maybe($T) handler, - (LogLevel, String) -> One logger - ) - = - generic_connect_to_net_service(queue_name, server, port, service_id, service_version, "", handler, logger). - -public define Word32 - get_ip - ( - String url_or_ip, - (LogLevel, String) -> One logger - ) = - logger(logTrace, "Try to resolve URL [" + url_or_ip+ "]."); - if resolve_address(url_or_ip) is success(ip_adr) then - logger(logTrace, "Try to resolve URL OK dns"+ip_adr); - ip_adr - else - logger(logError, "Can't resolve URL [" + url_or_ip+ "]. Using localhost (127.0.0.1) ."); - ip_address((127,0,0,1)). - - -public define Maybe(Word32) - mb_get_ip - ( - String url_or_ip, - (LogLevel, String) -> One logger - ) = - logger(logTrace, "Try to resolve URL [" + url_or_ip+ "]."); - if resolve_address(url_or_ip) is success(ip_adr) then - logger(logTrace, "Try to resolve URL OK dns"+ip_adr); - success(ip_adr) - else - logger(logError, "Can't resolve URL [" + url_or_ip+ "]."); - failure. - - public define Word32 - get_ip - ( - String url_or_ip - ) = - if ip_address(url_or_ip) is success(ip) then ip - else if dns(url_or_ip) is ok(ip_adr) then ip_adr - else - println("Can't resolve URL [" + url_or_ip+ "]. Using localhost."); - ip_address((127,0,0,1)). - - /* Same version as above, but server is string containing IP or URL - * It's resolve by get_ip and call generic_connect_to_net_service with IP - */ - -public define Maybe($T) - generic_connect_to_net_service - ( - String queue_name, - String server, - Word32 port, - Word32 service_id, - Word32 service_version, - String domain, - (MessageQueue, String) -> Maybe($T) handler, - (LogLevel, String) -> One logger - ) - = generic_connect_to_net_service(queue_name, get_ip(server, logger), port, service_id, service_version, domain, handler, logger). - -public define Maybe($T) - generic_connect_to_net_service - ( - String queue_name, - String server, - Word32 port, - Word32 service_id, - Word32 service_version, - (MessageQueue, String) -> Maybe($T) handler, - (LogLevel, String) -> One logger - ) - = generic_connect_to_net_service(queue_name, server, port, service_id, service_version, "", handler, logger). - -public define Maybe($T) - generic_connect_to_net_service_SSL - ( - String queue_name, - String server_name, - Word32 server_ip, - Word32 port, - (Maybe(X509)) -> Bool accept_policy, // your policy for accepting the server certificate in - // case of an invalid, non trusted or missing certificate - Word32 service_id, - Word32 service_version, - String domain, - (MessageQueue, String) -> Maybe($T) handler, - (LogLevel, String) -> One logger - ) - = - if open_SSL_connection( server_name, server_ip, port, accept_policy) is - { - error(_) then logger(logError, queue_name + ": Can't connect to domain manager ["+ip_addr_to_string(server_ip)+":"+port+"]");failure, - ok(conn) then - with queue = create_MessageQueue(queue_name, ssl(conn)), - message_transceiver(/*ssl(conn),*/ queue); - with result = generic_request_for_service(queue, service_id, service_version, domain, handler, logger), - queue.quit(unique); - //logInfo(debug_log,"domain_manager client quit"); - result - }. - -public define Maybe($T) - generic_connect_to_net_service_SSL - ( - String queue_name, - String server_name, - Word32 server_ip, - Word32 port, - (Maybe(X509)) -> Bool accept_policy, // your policy for accepting the server certificate in - // case of an invalid, non trusted or missing certificate - Word32 service_id, - Word32 service_version, - (MessageQueue, String) -> Maybe($T) handler, - (LogLevel, String) -> One logger - ) - = generic_connect_to_net_service_SSL(queue_name, server_name, server_ip, port, accept_policy, service_id, service_version, "", handler, logger). - diff --git a/net_services/CXM_generic_protocol.anubis b/net_services/CXM_generic_protocol.anubis deleted file mode 100644 index acf9d87..0000000 --- a/net_services/CXM_generic_protocol.anubis +++ /dev/null @@ -1,247 +0,0 @@ -/* - * - * User: David RENE - * Date: 25/04/2007 - * Time: 16:20 - * (c) Calexium - * - */ - -read system/muscle.anubis -read system/data_io.anubis -read system/string.anubis -read system/files.anubis -read tools/basis.anubis -read system/message_queue.anubis -read xlib/CXM_message_constants.anubis -read xlib/types/generated/file_ref.anubis - - -public define Word32 _CXM_OK = 0. -public define Word32 _CXM_ERROR = 1. -public define Word32 _CXM_UNKNOW_CMD = 2. -public define Word32 _CXM_UNKNOW_SERVICE = 3. -public define Word32 _CXM_MISSING_REQUIRED_FIELD = 4. -public define Word32 _CXM_FORBIDDEN = 5. -public define Word32 _CXM_BAD_AUTHENTICATION = 6. -public define Word32 _CXM_TEMPORARY_ERROR = 7. // When received, the client should try later - -public type ProtocolResult: - failure, - timeout, - unknow_cmd, - error, - error(Word32, String), - ok, - ok_msg(Message). - -public define One - send_ACK_error - ( - MessageQueue queue, - Word32 cmd_id, - Word32 error_code, - String error_string, - )= - with err_msg = message(_CXM_ACK), - forget(add_int32(err_msg, "CMD", cmd_id)); - forget(add_int32(err_msg, "STATUS", error_code)); - (if error_string /= "" then forget(add_string(err_msg, "STATUS_MSG", error_string)) - else unique); - forget(queue.add_Message_to_send(err_msg)). - -public define One - send_ACK_error - ( - MessageQueue queue, - Word32 cmd_id - )= - send_ACK_error(queue, cmd_id, _CXM_ERROR, ""). - -public define One - send_ACK_ok - ( - MessageQueue queue, - Word32 cmd_id - )= - with ok_msg = message(_CXM_ACK), - forget(add_int32(ok_msg, "CMD", cmd_id)); - forget(add_int32(ok_msg, "STATUS", _CXM_OK)); - forget(queue.add_Message_to_send(ok_msg)) - . - -public define One - send_ACK_ok - ( - MessageQueue queue, - Word32 cmd_id, - Message result - )= - with ok_msg = message(_CXM_ACK), - forget(add_int32(ok_msg, "CMD", cmd_id)); - forget(add_int32(ok_msg, "STATUS", _CXM_OK)); - forget(add_message(ok_msg, "RESULT", result)); - forget(queue.add_Message_to_send(ok_msg)) - . - -public define One - send_result - ( - MessageQueue queue, - Word32 cmd_id, - Maybe(Message) mb_msg - )= - if mb_msg is - { - failure then send_ACK_error(queue, cmd_id), - success(msg) then send_ACK_ok(queue, cmd_id, msg) - }. - -public define One - send_result - ( - MessageQueue queue, - Word32 cmd_id, - Result((Word32, String), Message) mb_msg - )= - if mb_msg is - { - error(err) then - if err is (err_code, err_string) then - send_ACK_error(queue, cmd_id, err_code, err_string), - ok(msg) then send_ACK_ok(queue, cmd_id, msg) - }. - -public define One - send_result - ( - MessageQueue queue, - Word32 cmd_id, - Bool result - )= - if result then - send_ACK_ok(queue, cmd_id) - else - send_ACK_error(queue, cmd_id). - -public define ProtocolResult - wait_for_reply - ( - MessageQueue mQ, - Word32 wait_cmd, - Int t_out - ) = - if mQ.get_next_received_Message(t_out) is - { - timeout then timeout, - closed then failure, //println("wait_for_reply closed"); - - msg(_msg) then - if *_msg.what = _CXM_ACK then - if find_int32(_msg, "CMD") is - { - failure then failure, //println("wait_for_reply CMD"); - success(cmd) then -// println("wait_for_reply CMD="+to_hexa(cmd)); - if find_int32(_msg, "STATUS") is - { - failure then failure, //println("wait_for_reply STATUS"); - success(status) then - if cmd = wait_cmd then - ( - if status = _CXM_OK then - if find_message(_msg, "RESULT") is - { - failure then ok, - success(ok_message) then ok_msg(ok_message) - } - else if status = _CXM_ERROR then - error - else if status = _CXM_UNKNOW_CMD then - unknow_cmd - else - error(status, if find_string(_msg, "STATUS_MSG") is success(txt) then txt else "") - ) - else - failure //println("wait_for_reply "); - } - } - else - failure //println("wait_for_reply not ACK"); - }. - -public define Bool - simple_wait_for_reply - ( - MessageQueue mQ, - Word32 wait_cmd, - Int t_out - ) = - if wait_for_reply(mQ, wait_cmd, t_out) is - { - failure then false, - timeout then false, - unknow_cmd then false, - error then false, - error(_, _) then false, - ok then true, - ok_msg(msg) then true - }. - - public define Bool - get_file_ref - ( - MessageQueue mQ, - File_ref f_ref, - String tmp_path - )= - //create the target - with target_file = tmp_path + "/" + f_ref.name, - //println("NET_SERVICE get_file_ref for "+target_file); - with msg = message(_CXM_GET_FILE_REF), - forget(add_message(msg, "GET_FILE_REF", to_Message(f_ref))); - forget(mQ.add_Message_to_send(msg)); - - if wait_for_reply(mQ, _CXM_GET_FILE_REF, 30) is - { - failure then false, - timeout then false, - unknow_cmd then false, - error then false, - error(_, _) then false, - ok then false, //false because OK without result message is not allowed - ok_msg(rmsg) then - //println("get_file_ref wait_for_reply _CXM_GET_FILE_REF OK"); - with size = if find_string(rmsg, "SIZE") is {failure then f_ref.size, success(size_str) then if decimal_scan(size_str) is { failure then should_not_happen(0), success(_size_) then _size_}}, - with mode = find_string(rmsg, "MODE", "NEW"), - if mode = "APPEND" then - if (Maybe(RWStream))file(target_file, append) is - { - failure then println("can't create target file"+target_file);false, //nothing to write - success(target) then - with buffer = mQ.raw_mode_on(size), - println("raw_mode ON buffer len "+length(buffer)+" buffer ["+to_string(buffer)+"]"); - forget(flush(buffer, weaken(target))); - if copy_file_to_Connection(mQ.get_connection(unique), file(target), size - length(buffer)) is - { - failure then mQ.raw_mode_off(unique);false, - success(_) then mQ.raw_mode_off(unique);true - } - } - else //by default the mode is new - if (Maybe(RWStream))file(target_file, new) is - { - failure then println("can't create target file"+target_file);false, //nothing to write - success(target) then - with buffer = mQ.raw_mode_on(size), - println("raw_mode ON buffer len "+length(buffer)+" buffer ["+to_string(buffer)+"]"); - forget(flush(buffer, weaken(target))); - if copy_file_to_Connection(mQ.get_connection(unique), file(target), size - length(buffer)) is - { - failure then mQ.raw_mode_off(unique);false, - success(_) then mQ.raw_mode_off(unique);true - } - } - } -. - diff --git a/net_services/CXM_net_services.anubis b/net_services/CXM_net_services.anubis deleted file mode 100644 index 2cda865..0000000 --- a/net_services/CXM_net_services.anubis +++ /dev/null @@ -1,227 +0,0 @@ -/* - * - * User: David RENE - * Date: 25/04/2007 - * Time: 11:01 - * (c) Calexium - * - */ -read tools/basis.anubis -read system/convert.anubis -read system/string.anubis -read system/muscle.anubis -read system/data_io.anubis -read system/message_queue.anubis -read system/message_transceiver.anubis -read system/logger.anubis -read CXM_generic_protocol.anubis -read xlib/CXM_message_constants.anubis - -public type NetService: - net_service( - Word32 version, - Word32 id, - String name, - List(String) domains, - (MessageQueue, String, String, (LogLevel, String) -> One ) -> One handler // Parameters are MessageQueue, peer IP and timestamp string, logger - ) -. - -define String - dump_services - ( - List(NetService) net_services - ) = - join("\n", map((NetService net_s) - |-> - if net_s is net_service(version, id, name, domains, _) then - " id : 0x"+ to_hexa(id)+"\n"+ - " version : " + to_String(version)+"\n"+ - " name : "+ name +"\n"+ - " domains : "+"\n"+ - join("\n",map((String domain) |-> " : "+domain, domains))+"\n"+ - "----------------------------------------\n" - ,net_services) - ) -. - - /** Try to find the service_id in services_list. If the service is found in that list - * the corresponding NetService object is return - */ -define Maybe(NetService) - find_service - ( - List(NetService) services_list, //List of all available NetService - Word32 service_id, //requested service ID - Word32 service_version, //requested service Version - String domain //requested domain for above resquested service ID/version - )= - if services_list is - { - [] then failure, - [h . t] then - if h.id = service_id & h.version >=+ service_version then - if domain = "" then - success(h) - else if domain:h.domains then //this writing (a:b) means, is a belonging to b where b is list of type a - success(h) - else - find_service(t, service_id, service_version, domain) - else - find_service(t, service_id, service_version, domain) - } -. - - /** Check if the muscle message msg has the correct fields for requesting a net_services - * if we found "service" and "version" fields on the message, we try to find if the service - * referenced in "service" is available in net_services list - */ -define Maybe(NetService) - has_service - ( - MessageQueue queue, - Message msg, - List(NetService) net_services - )= - if find_int32(msg, "SERVICE") is - { - failure then //send_ACK_error(queue, _CXM_REQUEST_FOR_SERVICE); failure, - // old names... should be removed soon - if find_int32(msg, "service") is - { - failure then send_ACK_error(queue, _CXM_REQUEST_FOR_SERVICE); failure, - success(service_id) then - if find_int32(msg, "version") is - { - failure then send_ACK_error(queue, _CXM_REQUEST_FOR_SERVICE);failure, - success(service_version) then - //if DOMAIN field exists, this mean we want to target only this domain - if find_string(msg, "DOMAIN") is - { - failure then find_service(net_services, service_id, service_version,""), - success(domain) then find_service(net_services, service_id, service_version, domain) - } - } - } - - success(service_id) then - if find_int32(msg, "VERSION") is - { - failure then send_ACK_error(queue, _CXM_REQUEST_FOR_SERVICE);failure, - success(service_version) then - //if DOMAIN field exists, this mean we want to target only this domain - if find_string(msg, "DOMAIN") is - { - failure then find_service(net_services, service_id, service_version,""), - success(domain) then find_service(net_services, service_id, service_version, domain) - } - } - } -. - -define String - get_time_stamp - = - with time = (UTime) unow, - "<"+virtual_machine_id+"@"+time.seconds+">". - - /** This message_received function just handle the negociation process the available net_services. - * In other words, it only recognize the _CXM_REQUEST_FOR_SERVICE message and try to launch the - * corresponding servcice - */ - -define One - service_negociation - ( - MessageQueue queue, - Message msg, - List(NetService) net_services, - String peer, - (LogLevel, String) -> One logger - )= - logger(logTrace, "Service NEGOCIATION [" + to_hexa(*msg.what) + "] received"); - if * msg.what = _CXM_REQUEST_FOR_SERVICE then - if has_service(queue, msg, net_services) is - { - failure then - logger(logError, "Unknown service"); - send_ACK_error(queue, _CXM_REQUEST_FOR_SERVICE, _CXM_UNKNOW_SERVICE, "Unknown service") - - success(net_service) then - with result = message(0), - timestamp = get_time_stamp, - forget(add_string(result, "TIMESTAMP", timestamp)); - send_ACK_ok(queue, _CXM_REQUEST_FOR_SERVICE, result); - net_service.handler(queue, peer, timestamp, logger) - } - else - send_ACK_error(queue, *msg.what, _CXM_UNKNOW_CMD, "Unknown command [" + (*msg.what) + "]") - . - - /** - * this function unflatten muscle message and give the correct message to service_negociation function - */ -public define One - message_receiver - ( - MessageQueue queue, - List(NetService) net_services, - String peer, - (LogLevel, String) -> One logger - ) = - if queue.quit_requested(unique) then - unique - else - logger(logTrace,"PRE SERVICE message_receiver ["+virtual_machine_id + "]"); - if queue.get_next_received_Message(1) is - { - timeout then //println("PRE timeout"); - message_receiver(queue, net_services, peer, logger), - closed then - logger(logTrace,"PRE SERVICE message_receiver ["+virtual_machine_id + "] closed"); - unique, - msg(msg) then unique; //println("PRE negociation"); - service_negociation(queue, msg, net_services, peer, logger); - message_receiver(queue, net_services, peer, logger) - }. - -define Server -> (RWStream) -> One - net_services_handler - ( - List(NetService) net_services, - (LogLevel, String) -> One logger - ) = - (Server server) |-> (RWStream conn) |-> - if remote_IP_address_and_port(conn) is (num_peer,_) then - //convert IP address of the client to string - with peer = ip_addr_to_string(num_peer), - logger(logInfo,"NET SERVICES Accepting connection with "+peer); - - //now managing the list of SERVICES - with queue = create_MessageQueue("CXM Net Services", tcp(conn)), - message_transceiver(queue); - message_receiver(queue, net_services, peer, logger). - - -public define Maybe(Server) - start_net_services - ( - List(NetService) net_services, - Word32 network_port, - (LogLevel, String) -> One logger - )= - if start_server(0, - network_port, - net_services_handler(net_services, logger), - (One u) |-> unique) is - { - cannot_create_the_socket then logger(logError, "Cannot create the listening socket."); failure, - cannot_bind_to_port then logger(logError, "Cannot bind to port " + network_port); failure, - cannot_listen_on_port then logger(logError, "Cannot listen on port " + network_port); failure, - ok(server) then - logger(logInfo, "Net services started on port " + network_port); - logger(logInfo, "------ Available services ------"); - logger(logInfo, dump_services(net_services)); - success(server) - } -. diff --git a/net_services/generic_client.anubis b/net_services/generic_client.anubis new file mode 100644 index 0000000..4d52d37 --- /dev/null +++ b/net_services/generic_client.anubis @@ -0,0 +1,438 @@ +/* + * Created by PyramIDE. + * User: ricard + * Date: 02/02/2008 + * Time: 11:47 + * + * + */ + +transmit system/message_transceiver.anubis +transmit system/logger.anubis +read network/dns.anubis + +//transmit xlib/net_services_protocols/logger_service.anubis + +transmit xlib/message_constants.anubis +transmit xlib/net_services/net_services.anubis +transmit xlib/net_services/generic_protocol.anubis + +// --Generic types--------------------------------------------------------------------- +public type NetServiceAnswer: + netservice_error (Word32 cmd, + Word32 result_code, + String result_string), + netservice_ok (Word32 cmd, + Maybe(Message) result_msg). + +// --Generic functions--------------------------------------------------------------------- + +/** + * Sends the message to the server then parses the answer and returns the RESULT message on CMD success. + */ +public define Maybe(NetServiceAnswer) + generic_send_message + ( + MessageQueue queue, + Message msg_to_send, + Int timeout, + (String) -> One logger + )= + queue.add_Message_to_send(msg_to_send); + if queue.get_next_received_Message(timeout) is + { + timeout then logger("["+queue.get_name(unique)+"]: receive timeout");failure, + closed then logger("["+queue.get_name(unique)+"]: socket closed");failure, + msg(msg) then + if find_int32(msg, "CMD") is + { + failure then logger("["+queue.get_name(unique)+"]: CMD field not found"); failure, + success(cmd) then + if find_int32(msg, "STATUS") is + { + failure then logger("["+queue.get_name(unique)+"]: STATUS field not found"); failure, + success(v) then + if v = _CXM_OK then + success(netservice_ok(cmd, find_message(msg, "RESULT"))) + else + with error_string = if find_string(msg, "STATUS_MSG") is success(s) then s else "", + success(netservice_error(cmd, v, error_string)) + } + } + }. + + +public define Maybe(NetServiceAnswer) +/** + * Sends the message to the server then parses the answer and returns the RESULT message on CMD success. + * + */ + generic_send_message + ( + MessageQueue queue, + Message msg_to_send, + Int timeout, + (LogLevel, String) -> One logger + )= + queue.add_Message_to_send(msg_to_send); + if queue.get_next_received_Message(timeout) is + { + timeout then logger(logError, "["+queue.get_name(unique)+"]: receive timeout");failure, + closed then logger(logError, "["+queue.get_name(unique)+"]: socket closed");failure, + msg(msg) then + if find_int32(msg, "CMD") is + { + failure then logger(logError, "["+queue.get_name(unique)+"]: CMD field not found"); failure, + success(cmd) then + if find_int32(msg, "STATUS") is + { + failure then logger(logError, "["+queue.get_name(unique)+"]: STATUS field not found"); failure, + success(v) then + if v = _CXM_OK then + success(netservice_ok(cmd, find_message(msg, "RESULT"))) + else + with error_string = if find_string(msg, "STATUS_MSG") is success(s) then s else "", + success(netservice_error(cmd, v, error_string)) + } + } + }. + +public define Maybe($T) + simple_handler + ( + MessageQueue queue, + String timestamp, + Int timeout, + Message msg_to_send, + (Message, MessageQueue, String) -> Maybe($T) handler, + (LogLevel, String) -> One logger + ) = + if generic_send_message(queue, msg_to_send, timeout, logger) is + { + failure then failure, + success(net_result) then + if net_result is + { + netservice_error(cmd, err_code, err_str) then + logger(logError, "["+queue.get_name(unique)+"]: message status ERROR [0x" + to_hexa(err_code) + ", '" + err_str + "']"); + failure, + netservice_ok(cmd, mb_msg) then + if mb_msg is + { + failure then logger(logError,"["+queue.get_name(unique)+"]: can't find RESULT message."); failure, + success(result) then handler(result, queue, timestamp) + } + } + }. + +public define Maybe(One) + no_result_handler + ( + MessageQueue queue, + Int timeout, + Message msg_to_send, + (LogLevel, String) -> One logger + ) = + if generic_send_message(queue, msg_to_send, timeout, logger) is + { + failure then failure, + success(net_result) then + if net_result is + { + netservice_error(cmd, err_code, err_str) then + logger(logError, "["+queue.get_name(unique)+"]: message status ERROR [0x" + to_hexa(err_code) + ", '" + err_str + "']"); + failure, + netservice_ok(cmd, mb_msg) then + if mb_msg is + { + failure then unique, + success(result) then logger(logError, "An unattended RESULT msg was found. Ignoring it...") + }; + success(unique) + } + }. + +public define (MessageQueue, String) -> Maybe($T) + make_generic_handler + ( + Int timeout, + Message msg_to_send, + (Message, MessageQueue, String) -> Maybe($T) handler, + (LogLevel, String) -> One logger + ) = + (MessageQueue queue, String timestamp) |-> + simple_handler(queue, timestamp, timeout, msg_to_send, handler, logger). + +define Maybe($T) + generic_request_for_service + ( + MessageQueue queue, + Word32 service_id, + Word32 service_version, + String domain, + (MessageQueue, String) -> Maybe($T) handler, + (LogLevel, String) -> One logger + )= + with test_msg = message(_CXM_REQUEST_FOR_SERVICE), + forget(add_int32(test_msg, "SERVICE", service_id)); + forget(add_int32(test_msg, "VERSION", service_version)); + forget(add_string(test_msg, "DOMAIN", domain)); + queue.add_Message_to_send(test_msg); + if queue.get_next_received_Message(10) is + { + timeout then logger(logError, "["+queue.get_name(unique)+"]: requesting service receive timeout");failure, + closed then logger(logError, "["+queue.get_name(unique)+"]: requesting service socket closed");failure, + msg(msg) then + if find_int32(msg, "STATUS") is + { + failure then logger(logError, "["+queue.get_name(unique)+"]: requesting service STATUS not found");failure, + success(v) then + if v = _CXM_OK then + if find_message(msg, "RESULT") is + { + failure then logger(logError, "["+queue.get_name(unique)+"]: requesting service RESULT not found");failure, + success(result) then + with timestamp = if find_string(result, "TIMESTAMP") is + { + failure then logger(logError, "["+queue.get_name(unique)+"]: requesting service TIMESTAMP not found"); "", + success(timestamp) then timestamp + }, + handler(queue, timestamp) + } + else + logger(logError, "["+queue.get_name(unique)+"]: the requested service is not available on server.");failure + } + }. + +// define Maybe($T) +// generic_request_for_service +// ( +// MessageQueue queue, +// Word32 service_id, +// Word32 service_version, +// String domain, +// (MessageQueue, String) -> Maybe($T) handler, +// (LogLevel, String) -> One logger +// )= +// with test_msg = message(_CXM_REQUEST_FOR_SERVICE), +// forget(add_int32(test_msg, "SERVICE", service_id)); +// forget(add_int32(test_msg, "VERSION", service_version)); +// forget(add_string(test_msg, "DOMAIN", domain)); +// queue.add_Message_to_send(test_msg); +// if queue.get_next_received_Message(10) is +// { +// timeout then logger(logError, "["+queue.get_name(unique)+"]: requesting service receive timeout");failure, +// closed then logger(logError, "["+queue.get_name(unique)+"]: requesting service socket closed");failure, +// msg(msg) then +// if find_int32(msg, "STATUS") is +// { +// failure then logger(logError, "["+queue.get_name(unique)+"]: requesting service STATUS not found");failure, +// success(v) then +// if v = _CXM_OK then +// if find_message(msg, "RESULT") is +// { +// failure then logger(logError, "["+queue.get_name(unique)+"]: requesting service RESULT not found");failure, +// success(result) then +// with timestamp = if find_string(result, "TIMESTAMP") is +// { +// failure then logger(logError, "["+queue.get_name(unique)+"]: requesting service TIMESTAMP not found"); "", +// success(timestamp) then timestamp +// }, +// handler(queue, timestamp) +// } +// else +// logger(logError, "["+queue.get_name(unique)+"]: the requested service is not available on server.");failure +// } +// }. +// +public define Maybe(MessageQueue) + get_message_queue_to_net_service + ( + String queue_name, + Word32 server, + Word32 port, + Word32 service_id, + Word32 service_version, + String domain, + (MessageQueue, String) -> Maybe(One) handler, //1st function to apply if need (i.e authentication to remote service) + (LogLevel, String) -> One logger + ) + = + if connect( server, port) is + { + error(_) then logger(logError, queue_name + ": Can't connect to service ["+ip_addr_to_string(server)+":"+port+"]");failure, + ok(conn) then +// println("[" + virtual_machine_id + "] netservices create queue"); + with queue = create_MessageQueue(queue_name, tcp(conn)), + message_transceiver(/*tcp(conn),*/ queue); +// println("[" + virtual_machine_id + "] netservices generic_request_for_service()"); + if generic_request_for_service(queue, service_id, service_version, domain, handler, logger) is + { + failure then + //we can't apply first function correctly, so we ask to Message Queue to quit and return failure + logger(logError, "can't apply first function correctly"); + queue.quit(unique); + failure, + success(_) then success(queue) + } + }. + + +public define Maybe($T) + generic_connect_to_net_service + ( + String queue_name, + Word32 server, + Word32 port, + Word32 service_id, + Word32 service_version, + String domain, + (MessageQueue, String) -> Maybe($T) handler, + (LogLevel, String) -> One logger + ) + = + if connect( server, port) is + { + error(_) then logger(logError, queue_name + ": Can't connect to service ["+ip_addr_to_string(server)+":"+port+"]");failure, + ok(conn) then +// println("[" + virtual_machine_id + "] netservices create queue"); + with queue = create_MessageQueue(queue_name, tcp(conn)), + message_transceiver(queue); +// println("[" + virtual_machine_id + "] netservices generic_request_for_service()"); + with result = generic_request_for_service(queue, service_id, service_version, domain, handler, logger), +// println("[" + virtual_machine_id + "] netservices client quit"); + queue.quit(unique); + result + }. + + //legacy version which not handle the domain + +public define Maybe($T) + generic_connect_to_net_service + ( + String queue_name, + Word32 server, + Word32 port, + Word32 service_id, + Word32 service_version, + (MessageQueue, String) -> Maybe($T) handler, + (LogLevel, String) -> One logger + ) + = + generic_connect_to_net_service(queue_name, server, port, service_id, service_version, "", handler, logger). + +public define Word32 + get_ip + ( + String url_or_ip, + (LogLevel, String) -> One logger + ) = + logger(logTrace, "Try to resolve URL [" + url_or_ip+ "]."); + if resolve_address(url_or_ip) is success(ip_adr) then + logger(logTrace, "Try to resolve URL OK dns"+ip_adr); + ip_adr + else + logger(logError, "Can't resolve URL [" + url_or_ip+ "]. Using localhost (127.0.0.1) ."); + ip_address((127,0,0,1)). + + +public define Maybe(Word32) + mb_get_ip + ( + String url_or_ip, + (LogLevel, String) -> One logger + ) = + logger(logTrace, "Try to resolve URL [" + url_or_ip+ "]."); + if resolve_address(url_or_ip) is success(ip_adr) then + logger(logTrace, "Try to resolve URL OK dns"+ip_adr); + success(ip_adr) + else + logger(logError, "Can't resolve URL [" + url_or_ip+ "]."); + failure. + + public define Word32 + get_ip + ( + String url_or_ip + ) = + if ip_address(url_or_ip) is success(ip) then ip + else if dns(url_or_ip) is ok(ip_adr) then ip_adr + else + println("Can't resolve URL [" + url_or_ip+ "]. Using localhost."); + ip_address((127,0,0,1)). + + /* Same version as above, but server is string containing IP or URL + * It's resolve by get_ip and call generic_connect_to_net_service with IP + */ + +public define Maybe($T) + generic_connect_to_net_service + ( + String queue_name, + String server, + Word32 port, + Word32 service_id, + Word32 service_version, + String domain, + (MessageQueue, String) -> Maybe($T) handler, + (LogLevel, String) -> One logger + ) + = generic_connect_to_net_service(queue_name, get_ip(server, logger), port, service_id, service_version, domain, handler, logger). + +public define Maybe($T) + generic_connect_to_net_service + ( + String queue_name, + String server, + Word32 port, + Word32 service_id, + Word32 service_version, + (MessageQueue, String) -> Maybe($T) handler, + (LogLevel, String) -> One logger + ) + = generic_connect_to_net_service(queue_name, server, port, service_id, service_version, "", handler, logger). + +public define Maybe($T) + generic_connect_to_net_service_SSL + ( + String queue_name, + String server_name, + Word32 server_ip, + Word32 port, + (Maybe(X509)) -> Bool accept_policy, // your policy for accepting the server certificate in + // case of an invalid, non trusted or missing certificate + Word32 service_id, + Word32 service_version, + String domain, + (MessageQueue, String) -> Maybe($T) handler, + (LogLevel, String) -> One logger + ) + = + if open_SSL_connection( server_name, server_ip, port, accept_policy) is + { + error(_) then logger(logError, queue_name + ": Can't connect to domain manager ["+ip_addr_to_string(server_ip)+":"+port+"]");failure, + ok(conn) then + with queue = create_MessageQueue(queue_name, ssl(conn)), + message_transceiver(/*ssl(conn),*/ queue); + with result = generic_request_for_service(queue, service_id, service_version, domain, handler, logger), + queue.quit(unique); + //logInfo(debug_log,"domain_manager client quit"); + result + }. + +public define Maybe($T) + generic_connect_to_net_service_SSL + ( + String queue_name, + String server_name, + Word32 server_ip, + Word32 port, + (Maybe(X509)) -> Bool accept_policy, // your policy for accepting the server certificate in + // case of an invalid, non trusted or missing certificate + Word32 service_id, + Word32 service_version, + (MessageQueue, String) -> Maybe($T) handler, + (LogLevel, String) -> One logger + ) + = generic_connect_to_net_service_SSL(queue_name, server_name, server_ip, port, accept_policy, service_id, service_version, "", handler, logger). + diff --git a/net_services/generic_protocol.anubis b/net_services/generic_protocol.anubis new file mode 100644 index 0000000..289f1af --- /dev/null +++ b/net_services/generic_protocol.anubis @@ -0,0 +1,247 @@ +/* + * + * User: フランスのトトロ aka (David RENÉ) + * Date: 25/04/2007 + * Time: 16:20 + * © David RENÉ + * + */ + +read system/muscle.anubis +read system/data_io.anubis +read system/string.anubis +read system/files.anubis +read tools/basis.anubis +read system/message_queue.anubis +read xlib/message_constants.anubis +read xlib/types/generated/file_ref.anubis + + +public define Word32 _CXM_OK = 0. +public define Word32 _CXM_ERROR = 1. +public define Word32 _CXM_UNKNOW_CMD = 2. +public define Word32 _CXM_UNKNOW_SERVICE = 3. +public define Word32 _CXM_MISSING_REQUIRED_FIELD = 4. +public define Word32 _CXM_FORBIDDEN = 5. +public define Word32 _CXM_BAD_AUTHENTICATION = 6. +public define Word32 _CXM_TEMPORARY_ERROR = 7. // When received, the client should try later + +public type ProtocolResult: + failure, + timeout, + unknow_cmd, + error, + error(Word32, String), + ok, + ok_msg(Message). + +public define One + send_ACK_error + ( + MessageQueue queue, + Word32 cmd_id, + Word32 error_code, + String error_string, + )= + with err_msg = message(_CXM_ACK), + forget(add_int32(err_msg, "CMD", cmd_id)); + forget(add_int32(err_msg, "STATUS", error_code)); + (if error_string /= "" then forget(add_string(err_msg, "STATUS_MSG", error_string)) + else unique); + forget(queue.add_Message_to_send(err_msg)). + +public define One + send_ACK_error + ( + MessageQueue queue, + Word32 cmd_id + )= + send_ACK_error(queue, cmd_id, _CXM_ERROR, ""). + +public define One + send_ACK_ok + ( + MessageQueue queue, + Word32 cmd_id + )= + with ok_msg = message(_CXM_ACK), + forget(add_int32(ok_msg, "CMD", cmd_id)); + forget(add_int32(ok_msg, "STATUS", _CXM_OK)); + forget(queue.add_Message_to_send(ok_msg)) + . + +public define One + send_ACK_ok + ( + MessageQueue queue, + Word32 cmd_id, + Message result + )= + with ok_msg = message(_CXM_ACK), + forget(add_int32(ok_msg, "CMD", cmd_id)); + forget(add_int32(ok_msg, "STATUS", _CXM_OK)); + forget(add_message(ok_msg, "RESULT", result)); + forget(queue.add_Message_to_send(ok_msg)) + . + +public define One + send_result + ( + MessageQueue queue, + Word32 cmd_id, + Maybe(Message) mb_msg + )= + if mb_msg is + { + failure then send_ACK_error(queue, cmd_id), + success(msg) then send_ACK_ok(queue, cmd_id, msg) + }. + +public define One + send_result + ( + MessageQueue queue, + Word32 cmd_id, + Result((Word32, String), Message) mb_msg + )= + if mb_msg is + { + error(err) then + if err is (err_code, err_string) then + send_ACK_error(queue, cmd_id, err_code, err_string), + ok(msg) then send_ACK_ok(queue, cmd_id, msg) + }. + +public define One + send_result + ( + MessageQueue queue, + Word32 cmd_id, + Bool result + )= + if result then + send_ACK_ok(queue, cmd_id) + else + send_ACK_error(queue, cmd_id). + +public define ProtocolResult + wait_for_reply + ( + MessageQueue mQ, + Word32 wait_cmd, + Int t_out + ) = + if mQ.get_next_received_Message(t_out) is + { + timeout then timeout, + closed then failure, //println("wait_for_reply closed"); + + msg(_msg) then + if *_msg.what = _CXM_ACK then + if find_int32(_msg, "CMD") is + { + failure then failure, //println("wait_for_reply CMD"); + success(cmd) then +// println("wait_for_reply CMD="+to_hexa(cmd)); + if find_int32(_msg, "STATUS") is + { + failure then failure, //println("wait_for_reply STATUS"); + success(status) then + if cmd = wait_cmd then + ( + if status = _CXM_OK then + if find_message(_msg, "RESULT") is + { + failure then ok, + success(ok_message) then ok_msg(ok_message) + } + else if status = _CXM_ERROR then + error + else if status = _CXM_UNKNOW_CMD then + unknow_cmd + else + error(status, if find_string(_msg, "STATUS_MSG") is success(txt) then txt else "") + ) + else + failure //println("wait_for_reply "); + } + } + else + failure //println("wait_for_reply not ACK"); + }. + +public define Bool + simple_wait_for_reply + ( + MessageQueue mQ, + Word32 wait_cmd, + Int t_out + ) = + if wait_for_reply(mQ, wait_cmd, t_out) is + { + failure then false, + timeout then false, + unknow_cmd then false, + error then false, + error(_, _) then false, + ok then true, + ok_msg(msg) then true + }. + + public define Bool + get_file_ref + ( + MessageQueue mQ, + File_ref f_ref, + String tmp_path + )= + //create the target + with target_file = tmp_path + "/" + f_ref.name, + //println("NET_SERVICE get_file_ref for "+target_file); + with msg = message(_CXM_GET_FILE_REF), + forget(add_message(msg, "GET_FILE_REF", to_Message(f_ref))); + forget(mQ.add_Message_to_send(msg)); + + if wait_for_reply(mQ, _CXM_GET_FILE_REF, 30) is + { + failure then false, + timeout then false, + unknow_cmd then false, + error then false, + error(_, _) then false, + ok then false, //false because OK without result message is not allowed + ok_msg(rmsg) then + //println("get_file_ref wait_for_reply _CXM_GET_FILE_REF OK"); + with size = if find_string(rmsg, "SIZE") is {failure then f_ref.size, success(size_str) then if decimal_scan(size_str) is { failure then should_not_happen(0), success(_size_) then _size_}}, + with mode = find_string(rmsg, "MODE", "NEW"), + if mode = "APPEND" then + if (Maybe(RWStream))file(target_file, append) is + { + failure then println("can't create target file"+target_file);false, //nothing to write + success(target) then + with buffer = mQ.raw_mode_on(size), + println("raw_mode ON buffer len "+length(buffer)+" buffer ["+to_string(buffer)+"]"); + forget(flush(buffer, weaken(target))); + if copy_file_to_Connection(mQ.get_connection(unique), file(target), size - length(buffer)) is + { + failure then mQ.raw_mode_off(unique);false, + success(_) then mQ.raw_mode_off(unique);true + } + } + else //by default the mode is new + if (Maybe(RWStream))file(target_file, new) is + { + failure then println("can't create target file"+target_file);false, //nothing to write + success(target) then + with buffer = mQ.raw_mode_on(size), + println("raw_mode ON buffer len "+length(buffer)+" buffer ["+to_string(buffer)+"]"); + forget(flush(buffer, weaken(target))); + if copy_file_to_Connection(mQ.get_connection(unique), file(target), size - length(buffer)) is + { + failure then mQ.raw_mode_off(unique);false, + success(_) then mQ.raw_mode_off(unique);true + } + } + } +. + diff --git a/net_services/get_file.anubis b/net_services/get_file.anubis index dcdb757..2be5767 100644 --- a/net_services/get_file.anubis +++ b/net_services/get_file.anubis @@ -7,9 +7,9 @@ */ -read xlib/CXM_message_constants.anubis -read xlib/net_services/CXM_generic_protocol.anubis -read xlib/net_services/CXM_generic_client.anubis //for get_ip +read xlib/message_constants.anubis +read xlib/net_services/generic_protocol.anubis +read xlib/net_services/generic_client.anubis //for get_ip read xlib/types/generated/file_ref.anubis read system/message_queue.anubis read system/message_transceiver.anubis diff --git a/net_services/net_services.anubis b/net_services/net_services.anubis new file mode 100644 index 0000000..88db271 --- /dev/null +++ b/net_services/net_services.anubis @@ -0,0 +1,228 @@ +/* + * + * User: フランスのトトロ aka (David RENÉ) + * Date: 25/04/2007 + * Time: 11:01 + * © David RENÉ + * + */ + +read tools/basis.anubis +read system/convert.anubis +read system/string.anubis +read system/muscle.anubis +read system/data_io.anubis +read system/message_queue.anubis +read system/message_transceiver.anubis +read system/logger.anubis +read xlib/net_services/generic_protocol.anubis +read xlib/message_constants.anubis + +public type NetService: + net_service( + Word32 version, + Word32 id, + String name, + List(String) domains, + (MessageQueue, String, String, (LogLevel, String) -> One ) -> One handler // Parameters are MessageQueue, peer IP and timestamp string, logger + ) +. + +define String + dump_services + ( + List(NetService) net_services + ) = + join("\n", map((NetService net_s) + |-> + if net_s is net_service(version, id, name, domains, _) then + " id : 0x"+ to_hexa(id)+"\n"+ + " version : " + to_String(version)+"\n"+ + " name : "+ name +"\n"+ + " domains : "+"\n"+ + join("\n",map((String domain) |-> " : "+domain, domains))+"\n"+ + "----------------------------------------\n" + ,net_services) + ) +. + + /** Try to find the service_id in services_list. If the service is found in that list + * the corresponding NetService object is return + */ +define Maybe(NetService) + find_service + ( + List(NetService) services_list, //List of all available NetService + Word32 service_id, //requested service ID + Word32 service_version, //requested service Version + String domain //requested domain for above resquested service ID/version + )= + if services_list is + { + [] then failure, + [h . t] then + if h.id = service_id & h.version >=+ service_version then + if domain = "" then + success(h) + else if domain:h.domains then //this writing (a:b) means, is a belonging to b where b is list of type a + success(h) + else + find_service(t, service_id, service_version, domain) + else + find_service(t, service_id, service_version, domain) + } +. + + /** Check if the muscle message msg has the correct fields for requesting a net_services + * if we found "service" and "version" fields on the message, we try to find if the service + * referenced in "service" is available in net_services list + */ +define Maybe(NetService) + has_service + ( + MessageQueue queue, + Message msg, + List(NetService) net_services + )= + if find_int32(msg, "SERVICE") is + { + failure then //send_ACK_error(queue, _CXM_REQUEST_FOR_SERVICE); failure, + // old names... should be removed soon + if find_int32(msg, "service") is + { + failure then send_ACK_error(queue, _CXM_REQUEST_FOR_SERVICE); failure, + success(service_id) then + if find_int32(msg, "version") is + { + failure then send_ACK_error(queue, _CXM_REQUEST_FOR_SERVICE);failure, + success(service_version) then + //if DOMAIN field exists, this mean we want to target only this domain + if find_string(msg, "DOMAIN") is + { + failure then find_service(net_services, service_id, service_version,""), + success(domain) then find_service(net_services, service_id, service_version, domain) + } + } + } + + success(service_id) then + if find_int32(msg, "VERSION") is + { + failure then send_ACK_error(queue, _CXM_REQUEST_FOR_SERVICE);failure, + success(service_version) then + //if DOMAIN field exists, this mean we want to target only this domain + if find_string(msg, "DOMAIN") is + { + failure then find_service(net_services, service_id, service_version,""), + success(domain) then find_service(net_services, service_id, service_version, domain) + } + } + } +. + +define String + get_time_stamp + = + with time = (UTime) unow, + "<"+virtual_machine_id+"@"+time.seconds+">". + + /** This message_received function just handle the negociation process the available net_services. + * In other words, it only recognize the _CXM_REQUEST_FOR_SERVICE message and try to launch the + * corresponding servcice + */ + +define One + service_negociation + ( + MessageQueue queue, + Message msg, + List(NetService) net_services, + String peer, + (LogLevel, String) -> One logger + )= + logger(logTrace, "Service NEGOCIATION [" + to_hexa(*msg.what) + "] received"); + if * msg.what = _CXM_REQUEST_FOR_SERVICE then + if has_service(queue, msg, net_services) is + { + failure then + logger(logError, "Unknown service"); + send_ACK_error(queue, _CXM_REQUEST_FOR_SERVICE, _CXM_UNKNOW_SERVICE, "Unknown service") + + success(net_service) then + with result = message(0), + timestamp = get_time_stamp, + forget(add_string(result, "TIMESTAMP", timestamp)); + send_ACK_ok(queue, _CXM_REQUEST_FOR_SERVICE, result); + net_service.handler(queue, peer, timestamp, logger) + } + else + send_ACK_error(queue, *msg.what, _CXM_UNKNOW_CMD, "Unknown command [" + (*msg.what) + "]") + . + + /** + * this function unflatten muscle message and give the correct message to service_negociation function + */ +public define One + message_receiver + ( + MessageQueue queue, + List(NetService) net_services, + String peer, + (LogLevel, String) -> One logger + ) = + if queue.quit_requested(unique) then + unique + else + logger(logTrace,"PRE SERVICE message_receiver ["+virtual_machine_id + "]"); + if queue.get_next_received_Message(1) is + { + timeout then //println("PRE timeout"); + message_receiver(queue, net_services, peer, logger), + closed then + logger(logTrace,"PRE SERVICE message_receiver ["+virtual_machine_id + "] closed"); + unique, + msg(msg) then unique; //println("PRE negociation"); + service_negociation(queue, msg, net_services, peer, logger); + message_receiver(queue, net_services, peer, logger) + }. + +define Server -> (RWStream) -> One + net_services_handler + ( + List(NetService) net_services, + (LogLevel, String) -> One logger + ) = + (Server server) |-> (RWStream conn) |-> + if remote_IP_address_and_port(conn) is (num_peer,_) then + //convert IP address of the client to string + with peer = ip_addr_to_string(num_peer), + logger(logInfo,"NET SERVICES Accepting connection with "+peer); + + //now managing the list of SERVICES + with queue = create_MessageQueue("CXM Net Services", tcp(conn)), + message_transceiver(queue); + message_receiver(queue, net_services, peer, logger). + + +public define Maybe(Server) + start_net_services + ( + List(NetService) net_services, + Word32 network_port, + (LogLevel, String) -> One logger + )= + if start_server(0, + network_port, + net_services_handler(net_services, logger), + (One u) |-> unique) is + { + cannot_create_the_socket then logger(logError, "Cannot create the listening socket."); failure, + cannot_bind_to_port then logger(logError, "Cannot bind to port " + network_port); failure, + cannot_listen_on_port then logger(logError, "Cannot listen on port " + network_port); failure, + ok(server) then + logger(logInfo, "Net services started on port " + network_port); + logger(logInfo, "------ Available services ------"); + logger(logInfo, dump_services(net_services)); + success(server) + } +. diff --git a/net_services/send_file.anubis b/net_services/send_file.anubis index 96e0d1a..9972306 100644 --- a/net_services/send_file.anubis +++ b/net_services/send_file.anubis @@ -19,9 +19,9 @@ read system/files.anubis read system/logger.anubis read xlib/net_services_protocols/logger_client.anubis -read xlib/CXM_message_constants.anubis -read xlib/net_services/CXM_net_services.anubis -read xlib/net_services/CXM_generic_protocol.anubis +read xlib/message_constants.anubis +read xlib/net_services/net_services.anubis +read xlib/net_services/generic_protocol.anubis read xlib/types/generated/file_ref.anubis read app_constants.anubis diff --git a/net_services_protocols/ftp_client.anubis b/net_services_protocols/ftp_client.anubis index 5a87840..a2ba343 100644 --- a/net_services_protocols/ftp_client.anubis +++ b/net_services_protocols/ftp_client.anubis @@ -8,9 +8,9 @@ * */ -read xlib/CXM_message_constants.anubis -read xlib/net_services/CXM_generic_protocol.anubis -read xlib/net_services/CXM_generic_client.anubis //for get_ip +read xlib/message_constants.anubis +read xlib/net_services/generic_protocol.anubis +read xlib/net_services/generic_client.anubis //for get_ip read system/message_queue.anubis read system/message_transceiver.anubis read system/muscle.anubis diff --git a/net_services_protocols/logger_server.anubis b/net_services_protocols/logger_server.anubis index 87cdb84..3a2f379 100644 --- a/net_services_protocols/logger_server.anubis +++ b/net_services_protocols/logger_server.anubis @@ -13,7 +13,7 @@ read system/string.anubis read system/files.anubis read system/parameter/inifile.anubis read system/message_queue.anubis -read xlib/CXM_message_constants.anubis +read xlib/message_constants.anubis read logger_client.anubis diff --git a/unit_test/xml_rpc.unit_test.anubis b/unit_test/xml_rpc.unit_test.anubis index fe5bd54..1dda0ee 100644 --- a/unit_test/xml_rpc.unit_test.anubis +++ b/unit_test/xml_rpc.unit_test.anubis @@ -1,4 +1,4 @@ - -read web/CXM_xml_rpc.anubis -read asterisk/ami.anubis - + +read web/xml_rpc.anubis +read asterisk/ami.anubis + diff --git a/web/CXM_dojo.anubis b/web/CXM_dojo.anubis deleted file mode 100644 index 3ee66a5..0000000 --- a/web/CXM_dojo.anubis +++ /dev/null @@ -1,828 +0,0 @@ -/* - * Created by PyramIDE. - * User: Steve Marechal - * Date: 11/06/2008 - * Time: 09:54 - * - */ - -read tools/basis.anubis -read tools/base64.anubis -read locale/L3LanguageInfo.anubis -read system/string.anubis -read system/logger.anubis - -read xlib/web/CXM_common.anubis -read xlib/web/CXM_making_a_web_site.anubis -read xlib/web/CXM_multihost_http_server.anubis - read xlib/net_services_protocols/logger_service.anubis - -public type Dojo_Grid_Data : - grid_data(String). - -public type Position_Direction: - brup, - brleft, - blup, - blright, - trdown, - trleft, - tldown, - tlright. - -define String - pos_dir_to_str - ( - Position_Direction pos - )= - if pos is - { - brup then "br-up", - brleft then "br-left", - blup then "bl-up", - blright then "bl-right", - trdown then "tr-down", - trleft then "tr-left", - tldown then "tl-down", - tlright then "tl-right" - }. - - - -public define HTML_Off_Form - dojo_button - ( - String name, - String execute, - String id, - ) - = - literal(" - ") -. - -public type Dojo_Input_Type: - file, - text, - password. - -public type InputDial: - input_dial(HTML_Id id, Dojo_Input_Type input_type, String label, Maybe(String) class), - input_date(HTML_Id id, String label), - input_combo(HTML_Id id, String label, List((List(CoreAttrs), WebArgValue, String)) list_data), - input_check(HTML_Id id, String label, Bool checked), - input_hidden(HTML_Id id, WebArgValue value). - - -define List(HTML_Off_Form) - format_list_data - ( - List((List(CoreAttrs), WebArgValue, String)) list_data, - List(HTML_Off_Form) result_list - )= - if list_data is - { - [] then result_list, - [h . t] then - if h is (_, wa, label) then - format_list_data(t, [literal("") . result_list]) - }. - -public define HTML_Off_Form - dojo_combobox - ( - WebArgName the_name, - HTML_Id the_id, - String label, - List((List(CoreAttrs), WebArgValue, String)) list_data, - )= - sequence([ - literal(" - ") - ]). - -define HTML_Off_Form - _maybe_label - ( - String label_text, - HTML_Id html_id - ) = - if length(label_text) > 0 then literal("") - else literal(""). - -public define HTML_Off_Form - dojo_checkbox - ( - WebArgName the_name, - HTML_Id the_id, - String label, - WebArgValue val, - Bool checked, - )= - sequence([ - _maybe_label(label, the_id), - literal(""), - ]). - - -define HTML_Off_Form - input_in_dialog - ( - InputDial input_data - )= - if input_data is - { - input_dial(html_id, input, label, class) then - sequence([ - literal("
"), - literal("
") - ]), - - input_date(html_id, label) then - sequence([ - literal("
"), - literal("
-
" - ) - ]), - - input_combo(the_id, label, list_data) then - sequence([ - literal("
"), - dojo_combobox(wan(the_id.id), the_id, label, list_data), - literal("
") - ]), - - input_check(the_id, label, checked) then - sequence([ - literal("
"), - dojo_checkbox(wan(the_id.id), the_id, label, wav("1"), checked), - literal("
"), - ]), - - input_hidden(the_id, val) then - literal(""), - } -. - -define List(HTML_Off_Form) - inputs_in_dialog - ( - List(InputDial) inputs_data - )= - if inputs_data is - { - [] then [], - [h . t] then [input_in_dialog(h) . inputs_in_dialog(t)] - }. - -public define HTML_Off_Form - dijit_dialog - ( - String name, - String dialog_id, - String execute, - String ok_label, - Maybe(String) cancel, - List(InputDial) inputs_data, - Maybe(String) do_cancel - ) - = - sequence([ - div([attr("dojoType", "dijit.Dialog"), id(dialog_id), title(name), attr("execute", execute)], - sequence([ - sequence(inputs_in_dialog(inputs_data)), - literal("" + - if cancel is - { - failure then "", - success(cancel_label) then "" - }), - br, - ]) - ) - ]) -. - -public define HTML_Off_Form - dojo_dialog - ( - String name, - String dialog_id, - String execute, - String ok_label, - Maybe(String) cancel, - List(InputDial) inputs_data, - Maybe(String) do_cancel - ) - = - sequence[ - dojo_button(name,"dijit.byId('"+dialog_id+"').show()", dialog_id + "_button"), - dijit_dialog(name, dialog_id, execute, ok_label, cancel, inputs_data, do_cancel) - ] -. - - - - -public type DojoGridEditor: - inputEditor, - boolEditor, - selectEditor(List(String) options), - alwaysOnEditor. - -public type DojoGridDefaultColumn: - dojo_grid_default_column( - String styles, - Maybe(String) width, - Maybe(DojoGridEditor) editor). - -public type DojoGridColumn: - dojo_grid_column( String label, - String field_name, - Maybe(String) width, - Maybe(DojoGridEditor) editor). - -public type DojoGridView: - dojo_grid_view( - Maybe(DojoGridDefaultColumn) default_column, - List(DojoGridColumn) columns). - -public type DojoGridLayout: - dojo_grid_layout( - Maybe(String) selectable_row_header_width, - List(DojoGridView) views). - -define String to_String(DojoGridEditor editor) = - "editor: " + - if editor is - { - inputEditor then "dojox.grid.editors.Input", - boolEditor then "dojox.grid.editors.Bool", - selectEditor(options) then "dojox.grid.editors.Select, options: [" + join(",", map((String o) |-> "\"" + o + "\"", options)) + "]", - alwaysOnEditor then "dojox.grid.editors.AlwaysOn" - }. - -define String to_String(DojoGridView view) = - "{ " + (if view.default_column is success(col) then - (if col is dojo_grid_default_column(styles, mb_width, mb_editor) then - "defaultCell: {" - + "styles: \"" + styles + "\"" - + (if mb_width is success(w) then ", width=\"" + w + "\"" else "") - + (if mb_editor is success(e) then ", " + to_String(e) else "") - + "}, ") - else "") - + "cells: [[" + join(",", map((DojoGridColumn col) |-> - if col is dojo_grid_column(label, field, mb_width, mb_editor) then - "{" - + "name: \"" + label + "\"" - + "field: \"" + field + "\"" - + (if mb_width is success(w) then ", width=\"" + w + "\"" else "") - + (if mb_editor is success(e) then ", " + to_String(e) else "") - + "}", - view.columns)) + "]]" - +"}". - - -public define String - dojo_make_grid_script - ( - HTML_Id html_id, - DojoGridLayout layout, - String layout_name, - String store_name, - Bool can_edit - ) - = -"". - -public define HTML_Off_Form - dojo_make_grid_script - ( - HTML_Id html_id, - List(String) columns, - Bool can_edit - ) - = - literal( -""). - -public define HTML_Off_Form - dojo_grid - ( - HTML_Id html_id, - Int rowsPerPage, - List(Table_Option) attributes, - )= - table([attr("dojoType", "dojox.grid.DataGrid"), attr("id", html_id.id), attr("jsId", html_id.id), - class("soria"), attr("singleClickEdit", "true"), attr("rowsPerPage", to_decimal(rowsPerPage)) . attributes], - empty, [], empty). - - -public define HTML_Off_Form - dojo_grid - ( - HTML_Id html_id, - List(CoreAttrs) attributes, -// List(GridColumn) columns, - String colum1, - String colum2, - String colum3, - String colum4, - Bool can_edit - ) - = - sequence([ - literal( - -""), - div([id(html_id.id) . attributes /*attr("dojoType", "dojox.Grid"), */]), - ]). -//
"). - - -public define HTML_Off_Form - dojo_message_box - ( - HTML_Off_Form name1, - HTML_Off_Form name2, - )= - sequence([ - br, - div([class("message_box")], [ - div([id("node3"), class("box nopad hidden")], name1), - div([id("node4"), class("box two nopad")], name2), - ]), - br, - ]). - - - -public define HTML_Off_Form - dojo_tooltip - ( - String title, - String keyword, - ) = - actioner(same,same, link([id("dojo_tip_" + keyword),class("dojoToolTip")],title, success(title)), "show_address_mailing", [("address_mailing", keyword)], []). - //actioner(same, same, push_button([id("dojo_tip_" + keyword), class("in"), event(onclick,"new_search(this)")], keyword), "", [], []). - - -public type BorderContainerRegion: - center, - top, - bottom, - leading, - trailing, - left, - right. - -define String - to_String - ( - BorderContainerRegion region - )= - if region is - { - center then "center", - top then "top", - bottom then "bottom", - leading then "leading", - trailing then "trailing", - left then "left", - right then "right" - }. - -public type BorderContainerDesign: - headline, - sidebar. - -define String - to_String - ( - BorderContainerDesign design - )= - if design is - { - headline then "headline", - sidebar then "sidebar" - }. - - -public define HTML_Off_Form - dojo_ContentPane - ( - List(CoreAttrs) attributes, - BorderContainerRegion region, - Bool splitter, - HTML_Off_Form content - ) = - div([ attr("dojoType", "dijit.layout.ContentPane"), - attr("region", to_String(region)), - attr("splitter", if splitter then "true" else "false") . attributes ], - content). - -public define HTML_In_Form - dojo_ContentPane - ( - List(CoreAttrs) attributes, - BorderContainerRegion region, - Bool splitter, - HTML_In_Form content - ) = - div([ attr("dojoType", "dijit.layout.ContentPane"), - attr("region", to_String(region)), - attr("splitter", if splitter then "true" else "false") . attributes ], - content). - -public define HTML_Off_Form - dojo_TabContainer - ( - List(CoreAttrs) attributes, - HTML_Off_Form content - ) = - div([attr("dojoType", "dijit.layout.TabContainer") . attributes ], - content). - - -public define HTML_Off_Form - dojo_BorderContainer - ( - List(CoreAttrs) attributes, - Maybe(String) the_title, - BorderContainerDesign design, - Bool live_splitter, - Bool persist, - Bool closable, - String container, - HTML_Off_Form content - ) = - with the_attributes = (List(CoreAttrs)) [attr("dojoType", "dijit.layout.BorderContainer"), attr("dojoAttachPoint", container), - attr("design", to_String(design)), attr("liveSplitters", live_splitter), attr("persist", persist), - attr("closable",closable) . attributes ], - total_attributes = if the_title is - { - failure then the_attributes, - success(t) then [title(t) . the_attributes] - }, - div(total_attributes, content). - -public define HTML_In_Form - dojo_BorderContainer - ( - List(CoreAttrs) attributes, - Maybe(String) the_title, - BorderContainerDesign design, - Bool live_splitter, - Bool persist, - Bool closable, - String container, - HTML_In_Form content - ) = - with the_attributes = (List(CoreAttrs)) [attr("dojoType", "dijit.layout.BorderContainer"), attr("dojoAttachPoint", container), - attr("design", to_String(design)), attr("liveSplitters", live_splitter), attr("persist", persist), - attr("closable",closable) . attributes ], - total_attributes = if the_title is - { - failure then the_attributes, - success(t) then [title(t) . the_attributes] - }, - div(total_attributes, content). - -public define HTML_Off_Form - dojo_tree - ( - List(CoreAttrs) attributes, - )= - div(attributes). - - - -public define HTML_Off_Form - dojo_Toolbar - ( - List(CoreAttrs) attributes, - HTML_Off_Form content - )= - div([attr("dojoType", "dijit.Toolbar") . attributes ], - content). - - -public define HTML_Off_Form - dojo_tooltip - ( - List(CoreAttrs) attributes, -// List(Text_Option) txt_attr, - HTML_Id html_id, - String label, - HTML_Off_Form tooltip_content, - )= - sequence([ - text([id(html_id.id)], label), - div([id(html_id.id + "_tt"), attr("connectId", html_id.id), attr("dojoType", "dijit.Tooltip") . attributes], tooltip_content) - ]). - - -public define HTML_Off_Form - dojo_button - ( - HTML_Id html_id, -// Maybe(String) class, - String name, - String iconclass, - Maybe(String) tip_msg, - String execute, - )= - literal(" - " + - if tip_msg is - { - failure then "", - success(tip) then - "" + tip + "" - }). - -public define HTML_In_Form - dojo_button - ( - HTML_Id html_id, -// Maybe(String) class, - String name, - String iconclass, - Maybe(String) tip_msg, - String execute, - )= - literal(" - " + - if tip_msg is - { - failure then "", - success(tip) then - "" + tip + "" - }). - - -public define HTML_Off_Form - dojo_declaration - ( - String name, - List(CoreAttrs) attributes, - HTML_Off_Form content - )= - div([attr("dojoType", "dijit.Declaration"), attr("widgetClass", name) . attributes ], - content). - - -public define HTML_In_Form - dojo_declaration - ( - String name, - List(CoreAttrs) attributes, - HTML_In_Form content - )= - div([attr("dojoType", "dijit.Declaration"), attr("widgetClass", name) . attributes ], - content). - -public define HTML_Off_Form - dojo_editor - ( - List(CoreAttrs) attributes, - HTML_Id html_id, - WebArgName input_name, - HTML_Off_Form text, - )= - div([id(html_id.id), attr("name", input_name.name), attr("dojoType", "dijit.Editor") - ,attr("extraPlugins", "['|', 'foreColor','hiliteColor',{name:'dojox.editor.plugins.FontChoice', command:'fontName', generic:true},'fontSize','formatBlock','|','createLink','insertImage']") - . attributes], text). - - public define HTML_In_Form - dojo_button - ( - HTML_Id html_id, - String name, - String iconclass, - Maybe(String) tip_msg, - String execute, - )= - literal(" - " + - if tip_msg is - { - failure then "", - success(tip) then - "" + tip + "" - }). - -public define HTML_In_Form - dojo_checkbox - ( - List(CoreAttrs) attributes, - WebArgName name, - HTML_Id id, - String label_str, - Bool checked, - )= - check_box_r([attr("dojoType", "dijit.form.CheckBox") . attributes] , label(label_str, no_help), id, name, checked). - -public define HTML_In_Form - dojo_combobox - ( - List(CoreAttrs) attributes, - WebArgName name, - HTML_Id id, - String label_str, - List((List(CoreAttrs),WebArgValue,String)) list_data, - InitialValue selected, - )= - // selector_c([attr("dojoType", "dijit.form.ComboBox") . attributes], label, id, name, 1, list_data, selected, non_mandatory). - selector_c([attr("dojoType", "dijit.form.ComboBox") . attributes], label(label_str, no_help), id, name, 1, list_data, selected). - -public define HTML_Off_Form - dojo_toaster - ( - List(CoreAttrs) attributes, - HTML_Id html_id, - String message_topic, - Position_Direction position_direction, - Bool separator, - Maybe(Int) duration - )= - div(append(append(if separator then [attr("separator","<hr>")] - else [], - if duration is - { - failure then [], - success(dur) then [attr("duration", abs_to_decimal(dur))] - }), - [attr("dojoType", "dojox.widget.Toaster"), attr("messageTopic", message_topic), - attr("positionDirection", pos_dir_to_str(position_direction)), id(html_id.id) - . attributes ]), - literal("")). - -public define HTML_Off_Form - dojo_progressBar - ( - List(CoreAttrs) attributes, -// List(Text_Option) attributes_text, - HTML_Id html_id, - String label - )= - sequence([ - text([id("text_" + html_id.id), class("progress_bar")], label), - div([id(html_id.id), class("progress_bar"), attr("indeterminate", "true"), attr("dojoType", "dijit.ProgressBar") . attributes], literal("")) - ]). - -public define HTML_Off_Form - dojo_progressBar - ( - List(CoreAttrs) attributes, -// List(Text_Option) attributes_text, - HTML_Id html_id, - String label, - Int progress, - Int maximum - )= - sequence([ - text([id("text_" + html_id.id), class("progress_bar")], label), - div([id(html_id.id), - class("progress_bar"), - attr("maximum", abs_to_decimal(maximum)), - attr("progress", abs_to_decimal(progress)), - attr("dojoType", "dijit.ProgressBar") . attributes]) - ]). - -define Maybe(Int) - string_to_month - ( - String month_s - )= - with month = to_lower(month_s), - if month = "jan" then success(1) - else if month = "feb" then success(2) - else if month = "mar" then success(3) - else if month = "apr" then success(4) - else if month = "may" then success(5) - else if month = "jun" then success(6) - else if month = "jul" then success(7) - else if month = "aug" then success(8) - else if month = "sep" then success(9) - else if month = "oct" then success(10) - else if month = "nov" then success(11) - else if month = "dec" then success(12) - else failure - . - - -// 'Thu Jan 14 2010 00:00:00 GMT+0100' must be replaced by '2010-01-14 00:00:00' - - - -public define Maybe(String) - dojo_date_to_db_datetime - ( - String data - )= - with list_data = split_by_token(data, ' '), - if nth(2, list_data) is - { - failure then failure, - success(day) then - if nth(1, list_data) is - { - failure then failure, - success(month) then - if nth(3, list_data) is - { - failure then failure, - success(year) then - if nth(4, list_data) is - { - failure then failure, - success(hour) then - if string_to_month(month) is - { - failure then failure, - success(month_int) then - success(year+"-"+month_int+"-"+day+" "+hour) - } - } - } - } - }. - -public define List(HTML_Head_Tag) - dojo_defaults - = - [ - // js(js_file("js/dojo/dojo.js", [attr("djConfig", "parseOnLoad: true, isDebug: " + (if debug_mode then "true" else "false") + ", usePlainJson: true")])), - js(js_file("js/dojo/dojo/dojo.js", [attr("djConfig", "parseOnLoad: true, isDebug: false, usePlainJson: true")])), - js(js_file("js/dojo/dijit/dijit.js")), - //css(css_file("js/dojo/dojo/resources/dojo.css")) - ]. - - -public define List(HTML_Head_Tag) - dojo_init - ( - String web_dir, - String theme_name - ) - = - with _theme_name = if file_exists(web_dir+"/public/js/dojo/dijit/themes/"+theme_name+"/"+theme_name+".css")then theme_name else "claro", - [ css(css_file("js/dojo/dijit/themes/"+_theme_name+"/"+_theme_name+".css")) . - [ css(css_file("js/dojo/dijit/themes/"+_theme_name+"/"+_theme_name+"_rtl.css")) . dojo_defaults ] - ] - . diff --git a/web/CXM_dropzone.anubis b/web/CXM_dropzone.anubis deleted file mode 100644 index fd4c867..0000000 --- a/web/CXM_dropzone.anubis +++ /dev/null @@ -1,59 +0,0 @@ - Make use of the DropzoneJS library (www.dropzonejs.com) to build highly customizable dropzones that provides drag’n’drop file uploads with image previews - - TODO: - Complete dropzone options and features binding - - Authors: Julien Verneuil (06/04/2016) - David René (2017/08/12) - -read tools/basis.anubis -read system/string.anubis -read xlib/web/CXM_making_a_web_site.anubis -read xlib/web/CXM_jquery.anubis - -public define HTML_Partial_Content - dropzone - ( - String dropzone_form_name, - String dict_default_message, - String dict_file_too_big, - String param_name, - String init, - WEB_Action_Name submit_action, - List((String,String)) extra_ops, - ) = - with dropzone_form_id = to_lower(dropzone_form_name+"_"+generate_random_string(15)), - partial_content( - [ js(js_file("js/dropzone.js")), - css(css_file("css/dropzone.css")), - js_script(" - Dropzone.options." + to_Camel_case(dropzone_form_id) + " = { - dictDefaultMessage : \"" + dict_default_message + "\", - dictFileTooBig : \"" + dict_file_too_big + "\", - timeout : 864000, - paramName : \"" + param_name + - ( if init = "" then - "\"" - else - "\", - init: "+init - )+" - }; - $('#"+dropzone_form_id+"').dropzone(); " - ) - ], - form(dropzone_form_id, [class("dropzone")], submit_action, extra_ops, empty) - ) -. - -public define HTML_Partial_Content - dropzone - ( - String dropzone_form_name, - String dict_default_message, - String dict_file_too_big, - String param_name, - WEB_Action_Name submit_action - )= - dropzone(dropzone_form_name, dict_default_message, dict_file_too_big, param_name, "", submit_action, []) -. diff --git a/web/CXM_generic_form.anubis b/web/CXM_generic_form.anubis deleted file mode 100644 index 853fb66..0000000 --- a/web/CXM_generic_form.anubis +++ /dev/null @@ -1,471 +0,0 @@ - - - - *Project* The Anubis Project - - *Title* - - *Copyright* Copyright (c) Alain Prouté 2005. - - - *Author* Alain Prouté - - - - In this file we rationalize the construction of forms. - - - -read CXM_making_a_web_site.anubis -read tools/basis.anubis - - -public type Mandatory: // used to mark fields as mandatory. - mandatory, - non_mandatory. - -public type Width: - small, - narrow, - wide, - custom(Int). - -public type FormFieldWidth: - auto, - custom(Int). - - - - Sorts of fields that you can put in a form: - -public type FormField: - - //--- title field --------------------------------------------------------------------- - title (String text), - title (Int text_size, - String text), - title_f (List(Text_Option) -> HTML_In_Form), - - //--- message field ------------------------------------------------------------------- - message (Result(String,String) msg), - message_f (Result(List(Text_Option) -> HTML_In_Form,List(Text_Option) -> HTML_In_Form)), - - //--- text input field ---------------------------------------------------------------- - input (WebArgName web_arg_name, - String tag, - Width width, - InitialValue init_value, - Mandatory mandatory), - input (WebArgName web_arg_name, - Width width, - InitialValue init_value), - input_f (WebArgName web_arg_name, - List(Text_Option) -> HTML_In_Form tag, - Width width, - InitialValue init_value, - Mandatory mandatory), - - //--- password input field ------------------------------------------------------------ - password_input (WebArgName web_arg_name, - String tag, - Mandatory mandatory), - password_input_f (WebArgName web_arg_name, - List(Text_Option) -> HTML_In_Form tag, - Mandatory mandatory), - - //--- explanation field --------------------------------------------------------------- - explain (String text), - explain (String text, - FormFieldWidth width), - explain_f (List(Text_Option) -> HTML_In_Form), - - //--- selector field ------------------------------------------------------------------ - selector (WebArgName web_arg_name, - String tag, - List(String) items, - Maybe(InitialValue) selected, - Mandatory mandatory), - selector_f (WebArgName web_arg_name, - List(Text_Option) -> HTML_In_Form, - List(String) items, - Maybe(InitialValue) selected, - Mandatory mandatory), - selector_c (WebArgName web_arg_name, - String tag, - List((List(CoreAttrs), WebArgValue, String)) items, - Maybe(InitialValue) selected, - Mandatory mandatory), - - - - //--- checkbox field ------------------------------------------------------------------ - checkbox (WebArgName web_arg_name, - String tag, - Bool checked, - Mandatory mandatory), - // the same one, but with the tag on the right of the checkbox - checkboxr (WebArgName web_arg_name, - String tag, - Bool checked, - Mandatory mandatory), - checkbox_f (WebArgName web_arg_name, - List(Text_Option) -> HTML_In_Form, - Bool checked, - Mandatory mandatory), - - //--- radio-button field -------------------------------------------------------------- - radio_button (WebArgName web_arg_name, - WebArgValue web_arg_value, - String tag, - Bool checked, - Mandatory mandatory), - // the same one, but with the tag on the right of the radio_button - radio_buttonr (WebArgName web_arg_name, - WebArgValue web_arg_value, - String tag, - Bool checked, - Mandatory mandatory), - - //--- text area field ----------------------------------------------------------------- - text_area (WebArgName web_arg_name, - InitialValue initial_text), - text_area (WebArgName web_arg_name, - String tag, - InitialValue initial_text), - text_area (WebArgName web_arg_name, - String tag, - InitialValue initial_text, - Int width, - Int height), - - //--- fields table -------------------------------------------------------------------- - fields_table (String tag, - List(FormField) fields), - - //--- fields line --------------------------------------------------------------------- - fields_line (String tag, - List(FormField) fields), - fields_line (List(FormField) fields), - - //--- preview field ------------------------------------------------------------------- - preview (String html_text), - - //--- submit button ------------------------------------------------------------------- - submit (String action_name, - Maybe(String) label, - String button_text, - List((String,String)) extra_operands). - - - Convenience functions: - -public define FormField title(List(Text_Option) -> HTML_In_Form f) = title_f(f). -public define FormField - message(Result(List(Text_Option) -> HTML_In_Form,List(Text_Option) -> HTML_In_Form) f) = message_f(f). -public define FormField input(WebArgName web_arg_name, - List(Text_Option) -> HTML_In_Form tag, - Width width, - InitialValue init_value, - Mandatory mandatory) - = input_f(web_arg_name,tag,width,init_value,mandatory). -public define FormField password_input(WebArgName web_arg_name, - List(Text_Option) -> HTML_In_Form tag, - Mandatory mandatory) - = password_input_f(web_arg_name,tag,mandatory). -public define FormField explain(List(Text_Option) -> HTML_In_Form f) = explain_f(f). -public define FormField selector(WebArgName web_arg_name, - List(Text_Option) -> HTML_In_Form f, - List(String) items, - Maybe(InitialValue) selected, - Mandatory mandatory) - = selector_f(web_arg_name,f,items,selected,mandatory). -public define FormField checkbox(WebArgName web_arg_name, - List(Text_Option) -> HTML_In_Form f, - Bool checked, - Mandatory mandatory) - = checkbox_f(web_arg_name,f,checked,mandatory). - - Make the form itself with: - -public define HTML_Off_Form - generic_form - ( - String form_name, - RGB background_color, - Int width, - List(FormField) fields - ). - - - - --- That's all for the public part ! -------------------------------------------------- - -// TO DO update code of CXM generic form -define HTML_Row(HTML_In_Form) - format_form_field - ( - FormField ff - ) = - with star = (Mandatory m) |-> (HTML_In_Form)text([color(rgb(255,0,0)),size(12)], - if m is - { - mandatory then "*", - non_mandatory then "" - }), - row( - if ff is - { - title(t) then (List(HTML_Cell(HTML_In_Form))) - [ - cell([columns(3),h_center],text([size(16),bold,color(rgb(0,0,0))],t)) - ], - - title(s,t) then (List(HTML_Cell(HTML_In_Form))) - [ - cell([columns(3),h_center],text([size(s),bold,color(rgb(0,0,0))],t)) - ], - - title_f(t) then (List(HTML_Cell(HTML_In_Form))) - [ - cell([columns(3),h_center],t([size(16),bold,color(rgb(0,0,0))])) - ], - - message(r) then (List(HTML_Cell(HTML_In_Form))) if r is - { - error(msg) then [cell([columns(3),h_center], - text([size(10),color(rgb(240,0,0))],msg))] - ok(msg) then [cell([columns(3),h_center], - text([size(10),color(rgb(0,150,0))],msg))] - }, - - message_f(r) then (List(HTML_Cell(HTML_In_Form))) if r is - { - error(msg) then [cell([columns(3),h_center], - msg([size(10),color(rgb(240,0,0))]))] - ok(msg) then [cell([columns(3),h_center], - msg([size(10),color(rgb(0,150,0))]))] - }, - - input(wan,tag,w,init,mand) then (List(HTML_Cell(HTML_In_Form))) - [ - cell([right ], text([size(10)],tag)), - cell([width(7) ], star(mand)), - cell([left ], text_input([], "",html_Id(""), wan, init,if w is - { - small then 10, - narrow then 50, - wide then 70, - custom(n) then n - })) - ], - - input(wan,w,init) then (List(HTML_Cell(HTML_In_Form))) - [ - cell([left,columns(3) ], text_input([], "", html_Id(""), wan,init,if w is - { - small then 10, - narrow then 30, - wide then 70, - custom(n) then n - })) - ], - - input_f(wan,tag,w,init,mand) then (List(HTML_Cell(HTML_In_Form))) - [ - cell([right ], tag([size(10)])), - cell([width(7) ], star(mand)), - cell([left ], text_input([], "", html_Id(""),wan,init,if w is - { - small then 15, - narrow then 30, - wide then 70, - custom(n) then n - })) - ], - - password_input(wan,tag,mand) then (List(HTML_Cell(HTML_In_Form))) - [ - cell([right ], text([size(10)],tag)), - cell([width(7) ], star(mand)), - cell([left ], password_input([], "",html_Id(""), wan, init(""), 30)) - ], - - password_input_f(wan,tag,mand) then (List(HTML_Cell(HTML_In_Form))) - [ - cell([right ], tag([size(10)])), - cell([width(7) ], star(mand)), - cell([left ], password_input([], "",html_Id(""), wan, init(""), 30)) - ], - - explain(t) then (List(HTML_Cell(HTML_In_Form))) - [ - cell([columns(3),h_center], - table([nude],[row(cell([width(500)], - paragraph([/*justified,*/size(10),color(rgb(0,100,0))],literal(t))))])) - ], - - explain(t,w) then (List(HTML_Cell(HTML_In_Form))) - [ - cell([columns(3),h_center], - table([nude],[row(cell( - if w is - { - auto then [], - custom(i) then [width(i)] - }, - paragraph([/*justified,*/size(10),color(rgb(0,100,0))], literal(t))))])) - ], - - explain_f(t) then (List(HTML_Cell(HTML_In_Form))) - [ - cell([columns(3),h_center], - table([nude],[row(cell([width(500)], - t([/*justified,*/size(10),color(rgb(0,100,0))])))])) - ], - - selector(wan,tag,items,selected,mand) then (List(HTML_Cell(HTML_In_Form))) - [ - cell([right ], text([size(10)],tag)), - cell([width(7)], star(mand)), - cell([left ], if selected is - { - failure then selector([], "", html_Id(""), wan,1,items) - success(sel) then selector([], "", html_Id(""), wan,1,items, sel) - }) - ], - - selector_f(wan,tag,items,selected,mand) then (List(HTML_Cell(HTML_In_Form))) - [ - cell([right ], tag([size(10)])), - cell([width(7)], star(mand)), - cell([left ], if selected is - { - failure then selector([], "", html_Id(""), wan,1,items) - success(sel) then selector([], "", html_Id(""), wan,1,items, sel) - }) - ], - - selector_c(wan,tag,items,selected,mand) then (List(HTML_Cell(HTML_In_Form))) - [ - cell([right ], text([size(10)],tag)), - cell([width(7)], star(mand)), - cell([left ], if selected is - { - failure then selector_c([], "", html_Id(""), wan,1,items) - success(sel) then selector_c([], "", html_Id(""), wan,1,items,sel) - }) - ], - - checkbox(wan,tag,checked,mand) then (List(HTML_Cell(HTML_In_Form))) - [ - cell([right ], text([size(10)],tag)), - cell([width(7)], star(mand)), - cell([left ], check_box([], "",html_Id(""),wan, wav(wan.name),checked)) - ], - - checkboxr(wan,tag,checked,mand) then (List(HTML_Cell(HTML_In_Form))) - [ - cell([right ], check_box([], "",html_Id(""),wan, wav(wan.name),checked)), - cell([width(7)], star(mand)), - cell([left ], text([size(10)],tag)) - ], - - checkbox_f(wan,tag,checked,mand) then (List(HTML_Cell(HTML_In_Form))) - [ - cell([right ], tag([size(10)])), - cell([width(7)], star(mand)), - cell([left ], check_box([], "",html_Id(""),wan,wav(wan.name),checked)) - ], - - radio_button(wan,wav,tag,checked,mand) then (List(HTML_Cell(HTML_In_Form))) - [ - cell([right ], text([size(10)],tag)), - cell([width(7)], star(mand)), - cell([left ], radio_button([], "", html_Id(""), wan, wav, checked)) - ], - - radio_buttonr(wan,wav,tag,checked,mand) then (List(HTML_Cell(HTML_In_Form))) - [ - cell([right ], radio_button([], "", html_Id(""), wan, wav, checked)), - cell([width(7)], star(mand)), - cell([left ], text([size(10)],tag)) - ], - - text_area(wan,tx) then (List(HTML_Cell(HTML_In_Form))) - [ - cell([h_center,columns(3)],text_area([wrap_lines],wan,tx,75,10)) - ], - - text_area(wan,tag,tx) then (List(HTML_Cell(HTML_In_Form))) - [ - cell([right,top], text([size(10)],tag)), - cell([width(7)], text([],"")), - cell([h_center],text_area([wrap_lines],wan,tx,75,10)) - ], - - text_area(wan,tag,tx,w,h) then (List(HTML_Cell(HTML_In_Form))) - [ - cell([right,top], text([size(10)],tag)), - cell([width(7)], text([],"")), - cell([h_center],text_area([wrap_lines],wan,tx,w,h)) - ], - - fields_table(tag,fields) then (List(HTML_Cell(HTML_In_Form))) - [ - cell([right,top], text([size(10)],tag)), - cell([width(7)], text([],"")), - cell([left,top], table([],map((FormField ff2) |-> format_form_field(ff2),fields))) - ], - - fields_line(tag,fields) then (List(HTML_Cell(HTML_In_Form))) - [ - cell([right,top], text([size(10)],tag)), - cell([width(7)], text([],"")), - cell([left,top], table([nude],[row([], //border(0,0,3,rgb(0,0,0)) - map((FormField ff2) |-> cell([top],table([nude],[format_form_field(ff2)])),fields))])) - ], - - fields_line(fields) then (List(HTML_Cell(HTML_In_Form))) - [ - cell([left,top,columns(3)], table([nude],[row([], - map((FormField ff2) |-> cell([top],table([nude],[format_form_field(ff2)])),fields))])) - ], - - preview(html_text) then (List(HTML_Cell(HTML_In_Form))) - [ - cell([top,left,columns(3),background_color(rgb(255,255,255))], - table([border(0,8,0,rgb(0,0,0))], - [row(cell([left,top,height(200)],literal(html_text)))])) - ], - - submit(action_name,mb_label,button_text,extra_operands) then (List(HTML_Cell(HTML_In_Form))) - [ - cell([columns(3),right],actioner(same, - if mb_label is - { - failure then same, - success(n) then same(n) - }, - submit([], button_text), - action_name, - extra_operands)) - ] - }). - - - -// TO DO update code of CXM generic form -public define HTML_Off_Form - generic_form - ( - String form_name, - RGB bg_color, - Int w, - List(FormField) fields - ) = - table([border(0,0,5,bg_color),percentage_width(100), - background_color(bg_color)],[row(cell([h_center], - form(form_name,[],table([border(0,2,0,bg_color)], - map(format_form_field, fields)))))]). - - diff --git a/web/CXM_generic_login.anubis b/web/CXM_generic_login.anubis deleted file mode 100644 index f1db55d..0000000 --- a/web/CXM_generic_login.anubis +++ /dev/null @@ -1,116 +0,0 @@ - - - - - Rationalisation de la gestion des logins et des mots de passe - -read CXM_common.anubis -read CXM_making_a_web_site.anubis -read CXM_generic_form.anubis - - - - - *** (1) Connection sur site scurise - - ou formulaire de saisie du login et du mot de passe - - - Le formulaire de saisie du login et du mot de passe pour se connecter un site https - se compose : - .1. d'un ventuel message pour alerter que la paire (login,passwd) est errone, - .2. du formulaire proprement dit pour lequel il faut donner : - - le titre du formulaire - - les textes figurant devant les 2 texts input - - le text du bouton submit - - le nom de l'action, - - la couleur de fond - - - -public define HTML_Off_Form - login_form - ( - String wrong_message, - RGB background_color, - String title_text, - String pseudo_text, - String passwd_text, - String submit_text, - String login_action - ). - - - - - *** (2) Vrification de la saisie - - -public define Maybe($User) - check_login_passwd - ( - String -> Maybe($User) check_pseudo, - $User -> ByteArray get_passwd, - List(Web_arg) lwa - ). - - - - --- That's all for the public part ! -------------------------------------------------- - - - - *** [1] Connection sur site scurise - -public define HTML_Off_Form - login_form - ( - String wrong_message, - RGB background_color, - String title_text, - String pseudo_text, - String passwd_text, - String submit_text, - String login_action - ) = - generic_form - ("login_form",background_color,700, - [ - title (title_text), - explain (wrong_message), - input ("pseudo",pseudo_text,narrow,"",mandatory), - password_input ("passwd",passwd_text,mandatory), - submit (login_action,failure,submit_text,[]) - ]). - - - - *** [2] Vrification de la saisie - -public define Maybe($User) - check_login_passwd - ( - String -> Maybe($User) check_pseudo, - $User -> ByteArray get_passwd, - List(Web_arg) lwa - ) = - if web_arg_value(lwa,"pseudo") is - { - not_found then failure, - found(ps) then - if web_arg_value(lwa,"passwd") is - { - not_found then failure, - found(pwd) then - if check_pseudo(ps) is - { - failure then failure, - success(user) then - if sha1(to_byte_array(pwd))=get_passwd(user) - then success(user) - else failure - } - }}. - - - diff --git a/web/CXM_generic_table.anubis b/web/CXM_generic_table.anubis deleted file mode 100644 index 23cfcd6..0000000 --- a/web/CXM_generic_table.anubis +++ /dev/null @@ -1,786 +0,0 @@ - - *Project* The Anubis Project - - *Title* Generic table page. - - *Copyright* Copyright (c) Alain Prouté 2004. - - - *Author* Alain Prouté - *Author* Olivier Duvernois - - - - ---------------------------------------------------------------------------------------- - - - - -read tools/basis.anubis -read CXM_common.anubis -read CXM_making_a_web_site.anubis - - - The purpose is to print on a html browser a table from a List($Data) using the function - 'generic_table()' describe below. - - Note : the explanations are only given for HTML_Item and its components. But they are - also available for HTML_Form and HTML_Element and their components. - - - A table may have the following look : - - +-----+----------+--------+-----------------------+ ............... - | | | | name 3 | - | num | name1 | name2 |-----------+-----------+ columns_name - | | | | name 31 | name 32 | - +-----+----------+--------+-----------+-----------+ ............... - | 1 | data11 | data12 | data131 | data132 | line 1 with background color a - +-----+----------+--------+-----------+-----------+ ............... - | 2 | data21 | data22 | data231 | data232 | line 2 with background color b - +-----+----------+--------+-----------+-----------+ ............... - | 3 | data31 | data32 | data331 | data332 | line 3 with background color a - +-----+----------+--------+-----------+-----------+ ............... - - | n | datan1 | datan2 | datan31 | datan32 | line n with background color ? - +-----+----------+--------+-----------+-----------+ ............... - |total| total1 | | | total32 | total line - +-----+----------+--------+-----------+-----------+ ............... - - For the total-line, assuming that datax1 to dataxn and datax32 to datan32 are numbers - (Int, Float or Maybe(Float)). - - - The columns name are just a List(Item_Row). - - The column 'num' is in the case you want to enumerate your data. The existence of this - column depends on the line function. - - Lines are given by the function : (RGB color,Int num,$Data d) -> Item_Row - - where : - (RGB)color is the color of the background of the row (the 'a color' or 'b - color'); - - (Int)num the number of the data (to enumerate). - - So, this function must be written something like : - - (RGB color, Int num,$Data d) |-> - row([background_color(color)], // and of course possibly other row-options - [ - cell([], (Int -> $HTML)(num) ) - . ($Data -> List(Cell))d // how data is printed in cells - ]). - - But, for the above convenient function with no enumeration, you can only write : - - (RGB color, $Data d) |-> - row([background_color(color)], // and of course possibly other row-options - ($Data -> List(Cell))d // how data is printed in cells - ). - - - If you want to sum by column your data, use the following type : - -public type Total_Line($Data,$Upplet,$Row): - no_total, - total - ( - ($Upplet,$Data) -> $Upplet sum_functions, - $Upplet -> $Row print_total_line, - $Upplet initial_value - ). - - $Row is for HTML_Row($HTML). - $Upplet represents the components of $Data that will be sum. - - Example : - with the above sheme table, $Data is something like : - type $Data - data - ( - Data1 d1, - Data2 d2 - Data3 d3 - ). - and type Data3: - data3 - ( - Data31 d31, - Data32 d32 - ). - - So $Upplet will be (Data1,Data32) : sums are wanted for those 2 datum - - The function ($Upplet,$Data) -> $Upplet will be written like : - ($Upplet u,$Data d) -> if u is (u1,u2) then (u1+d1(d), u2+d32(d3(d))) - - (if of course (Data1 + Data1) and (Data32 + Data32) are defined). - - - - - Several columns - - ------------------- - - If you want to print your data on sevaral columns (i.e. considering the above table - scheme as a column), you must specify the number of columns. You will obtain : - - Here is a List($Data) : l = [a,b,c,d,e,f,g,h,i,j,k,l,m]; - and f : (RGB,Int,$Data) -> Item_Row - You want to print this list on 3 columns. - The result will be : - - - +-----------+-----------+-----------+ - | col.names | col.names | col.names | - +-----------+-----------+-----------+ - | f(a) | f(f) | f(k) | - +-----------+-----------+-----------+ - | f(b) | f(g) | f(l) | - +-----------+-----------+-----------+ Each column is a table as defined - | f(c) | f(h) | f(m) | above. - +-----------+-----------+-----------+ - | f(d) | f(i) | | - +-----------+-----------+-----------+ - | f(e) | f(j) | | - +-----------+-----------+-----------+ - - - If several columns are required, it's also asked for spaces between two colums. - - So use the following type : - -public type HowManyColumns: - _1, - several (Int col_nb, - Int spacer). - - - - - - Now the Generic table definition - - ------------------------------------ - - Here is the most customizable generic table. Below, they are some convenience functions. - -public define HTML_Off_Form - generic_table - ( - List($Data) data, - List(Table_Option) lto, - List(HTML_Row(HTML_Off_Form)) columns_name, - HowManyColumns number_of_columns, - (RGB,Int,$Data) -> HTML_Row(HTML_Off_Form) line_format, - RGB a_color, - RGB b_color, - Total_Line($Data,$Upplet,HTML_Row(HTML_Off_Form)) total_line - ). - -public define HTML_In_Form - generic_table - ( - List($Data) data, - List(Table_Option) lto, - List(HTML_Row(HTML_In_Form)) columns_name, - HowManyColumns number_of_columns, - (RGB,Int,$Data) -> HTML_Row(HTML_In_Form) line_format, - RGB a_color, - RGB b_color, - Total_Line($Data,$Upplet,HTML_Row(HTML_In_Form)) total_line - ). - - - - Note : - List(Table_Option) : if you choose 'nude' (i.e. border(0,0,0)), don't forget a - horizontal spacer between the cells contain in the 'line_format' row. If you don't put - any, each data will be closer to the next one. - - - - - Convenience functions - - ------------------------- - - 1/ Table without multicolumns, enumeration and total-line: - -public define HTML_Off_Form - generic_table - ( - List($Data) data, - List(Table_Option) lto, - List(HTML_Row(HTML_Off_Form)) columns_name, - (RGB,$Data) -> HTML_Row(HTML_Off_Form) line_format, - RGB a_color, - RGB b_color - ). - -public define HTML_In_Form - generic_table - ( - List($Data) data, - List(Table_Option) lto, - List(HTML_Row(HTML_In_Form)) columns_name, - (RGB,$Data) -> HTML_Row(HTML_In_Form) line_format, - RGB a_color, - RGB b_color - ). - - - - 2/ Table with total-line and without multicolumns, enumeration. - - -public define HTML_Off_Form - generic_table - ( - List($Data) data, - List(Table_Option) lto, - List(HTML_Row(HTML_Off_Form)) columns_name, - (RGB,$Data) -> HTML_Row(HTML_Off_Form) line_format, - RGB a_color, - RGB b_color, - Total_Line($Data,$Upplet,HTML_Row(HTML_Off_Form)) total_line - ). - -public define HTML_In_Form - generic_table - ( - List($Data) data, - List(Table_Option) lto, - List(HTML_Row(HTML_In_Form)) columns_name, - (RGB,$Data) -> HTML_Row(HTML_In_Form) line_format, - RGB a_color, - RGB b_color, - Total_Line($Data,$Upplet,HTML_Row(HTML_In_Form)) total_line - ). - - - 3/ Table with multicolumns, enumeration, but without total - -public define HTML_Off_Form - generic_table - ( - List($Data) data, - List(Table_Option) lto, - List(HTML_Row(HTML_Off_Form)) columns_name, - HowManyColumns number_of_columns, - (RGB,Int,$Data) -> HTML_Row(HTML_Off_Form) line_format, - RGB a_color, - RGB b_color - ). - -public define HTML_In_Form - generic_table - ( - List($Data) data, - List(Table_Option) lto, - List(HTML_Row(HTML_In_Form)) columns_name, - HowManyColumns number_of_columns, - (RGB,Int,$Data) -> HTML_Row(HTML_In_Form) line_format, - RGB a_color, - RGB b_color - ). - - - - 4/ Table with multicolumns and without enumeration & total - -public define HTML_Off_Form - generic_table - ( - List($Data) data, - List(Table_Option) lto, - List(HTML_Row(HTML_Off_Form)) columns_name, - HowManyColumns number_of_columns, - (RGB,$Data) -> HTML_Row(HTML_Off_Form) line_format, - RGB a_color, - RGB b_color - ). - -public define HTML_In_Form - generic_table - ( - List($Data) data, - List(Table_Option) lto, - List(HTML_Row(HTML_In_Form)) columns_name, - HowManyColumns number_of_columns, - (RGB,$Data) -> HTML_Row(HTML_In_Form) line_format, - RGB a_color, - RGB b_color - ). - - - --- That's all for public part. ------------------------------------------------------------------------- - - - When the datum $Data must be presented on several columns, the initial list must be - re-composed : sot the type Print_Table. - -type Print_Table($Data): - print_table - ( - $Data data, - Int num - ). - - - *** Transform List($Data) into List(Print_Table($Data)) - - -define (List(Print_Table($Data)),List($Data)) - get_n_elements - ( - List($Data) l, - List(Print_Table($Data)) result, - Int n, - Int ct, // counter - Int num - ) = - if l is - { - [] then (reverse(result),[]), - [h . t] then - if ct = n - then (reverse([print_table(h,num+1) . result]),t) - else get_n_elements(t,[print_table(h,num+1) . result],n,ct+1,num+1) - }. - - -define List(List(Print_Table($Data))) - short_lists - ( - List($Data) l, - Int nb, // number of element of short list - Int ct // counter for numbering data (initialized at 0) - ) = - if get_n_elements(l,[],nb,1,ct) is (result,unused) - then if unused is - { - [] then [result], - [_ . _] then [result . short_lists(unused,nb,ct+nb)] - }. - - - - Generic row - - --------------- - -define (List(HTML_Row($HTML)),$Upplet) - generic_rows - ( - List(Print_Table($Data)) lpt, - (RGB,Int,$Data) -> HTML_Row($HTML) line_format, - RGB a_color, - RGB b_color, - ($Upplet,$Data) -> $Upplet do_sum, - List(HTML_Row($HTML)) rows, - $Upplet sum - ) = - if lpt is - { - [] then (reverse(rows),sum), - [h . t] then - generic_rows(t,line_format,b_color,a_color,do_sum, - [line_format(a_color,num(h),data(h)) . rows],do_sum(sum,data(h))) - }. - - - - - HTML_In_Form - - ---------------- - -define List(HTML_Cell(HTML_In_Form)) - generic_cells - ( - List(List(Print_Table($Data))) print_data, - List(Table_Option) lto, - List(HTML_Row(HTML_In_Form)) names, - (RGB,Int,$Data) -> HTML_Row(HTML_In_Form) line_format, - RGB a_color, - RGB b_color, - ($Upplet,$Data) -> $Upplet do_sum, - $Upplet -> HTML_Row(HTML_In_Form) total_line, - $Upplet value, - Int spacer - ) = - if print_data is - { - [] then (List(HTML_Cell(HTML_In_Form))) [], - [h . t] then - if generic_rows(h,line_format,a_color,b_color,do_sum,(List(HTML_Row(HTML_In_Form)))[],value) is - (rows,new_value) then - if t is [] - then [cell([top],table(lto,names+rows+[total_line(new_value)]))] - else [ - cell([top],table(lto,append(names,rows))) - . if spacer = 0 - then generic_cells - (t,lto,names,line_format,a_color,b_color,do_sum,total_line,new_value,spacer) - else [cell([width(spacer)],text([],"")) - . generic_cells - (t,lto,names,line_format,a_color,b_color,do_sum,total_line,new_value,spacer)] - ] - }. - -//public define Int -// Int x (mod Int y) -// = -// if x / y is -// { -// failure then 0, -// success(result) then -// if result is (q, r) then r -// }. -// - - -public define HTML_In_Form - generic_table - ( - List($Data) l, - List(Table_Option) lto, - List(HTML_Row(HTML_In_Form)) names, - HowManyColumns hm_col, - (RGB,Int,$Data) -> HTML_Row(HTML_In_Form) line_format, - RGB a_color, - RGB b_color, - Total_Line($Data,$Upplet,HTML_Row(HTML_In_Form)) total_line - ) = - table([], - if l is [] - then [] - else - with nbl = length(l), - [ - row([], - if total_line is - { - no_total then - with col_nb = if hm_col is - { - _1 then 1, - several(n,_) then n - }, - with spacer = if hm_col is - { - _1 then 0, - several(n,sp) then sp - }, - generic_cells - (short_lists(l,nbl\col_nb + if (nbl (mod col_nb)) > 0 then 1 else 0,0), - lto,names,line_format,a_color,b_color, - (One u,$Data d) |-> unique,(One _) |-> row([],[]),unique,spacer), - total(sum_fct,total_line,init) then - with col_nb = if hm_col is - { - _1 then 1, - several(n,_) then n - }, - with spacer = if hm_col is - { - _1 then 0, - several(n,sp) then sp - }, - generic_cells - ( - short_lists(l,nbl\col_nb + if (nbl (mod col_nb)) > 0 then 1 else 0,0), - lto,names,line_format,a_color,b_color, - sum_fct,total_line,init,spacer - ) - }) - ]). - - - - HTML_Off_Form - - ---------------- - -define List(HTML_Cell(HTML_Off_Form)) - generic_cells - ( - List(List(Print_Table($Data))) print_data, - List(Table_Option) lto, - List(HTML_Row(HTML_Off_Form)) names, - (RGB,Int,$Data) -> HTML_Row(HTML_Off_Form) line_format, - RGB a_color, - RGB b_color, - ($Upplet,$Data) -> $Upplet do_sum, - $Upplet -> HTML_Row(HTML_Off_Form) total_line, - $Upplet value, - Int spacer - ) = - if print_data is - { - [] then (List(HTML_Cell(HTML_Off_Form))) [], - [h . t] then - if generic_rows(h,line_format,a_color,b_color,do_sum,(List(HTML_Row(HTML_Off_Form)))[],value) is - (rows,new_value) then - if t is [] - then [cell([top],table(lto,(names+rows+[total_line(new_value)])))] - else [ - cell([top],table(lto,append(names,rows))) - . if spacer =0 - then generic_cells - (t,lto,names,line_format,a_color,b_color,do_sum,total_line,new_value,spacer) - else [cell([width(spacer)],text([],"")) - . generic_cells - (t,lto,names,line_format,a_color,b_color,do_sum,total_line,new_value,spacer)] - ] - }. - -public define HTML_Off_Form - generic_table - ( - List($Data) l, - List(Table_Option) lto, - List(HTML_Row(HTML_Off_Form)) names, - HowManyColumns hm_col, - (RGB,Int,$Data) -> HTML_Row(HTML_Off_Form) line_format, - RGB a_color, - RGB b_color, - Total_Line($Data,$Upplet,HTML_Row(HTML_Off_Form)) total_line - ) = - table([], - with nbl = length(l), - [ - row([], - if total_line is - { - no_total then - with col_nb = if hm_col is - { - _1 then 1, - several(n,_) then n - }, - with spacer = if hm_col is - { - _1 then 0, - several(n,sp) then sp - }, - generic_cells - ( - short_lists(l,nbl\col_nb + if (nbl (mod col_nb)) > 0 then 1 else 0,0), - lto,names,line_format,a_color,b_color, - (One u,$Data d) |-> unique,(One _) |-> row([],[]),unique,spacer - ), - total(sum_fct,total_line,init) then - with col_nb = if hm_col is - { - _1 then 1, - several(n,_) then n - }, - with spacer = if hm_col is - { - _1 then 0, - several(n,sp) then sp - }, - generic_cells - ( - short_lists(l,nbl\col_nb + if (nbl (mod col_nb)) > 0 then 1 else 0,0), - lto,names,line_format,a_color,b_color, - sum_fct,total_line,init,spacer - ) - }) - ]). - - - - - Convenience functions : - -public define HTML_Off_Form - generic_table - ( - List($Data) data, - List(Table_Option) lto, - List(HTML_Row(HTML_Off_Form)) columns_name, - (RGB,$Data) -> HTML_Row(HTML_Off_Form) line_format, - RGB a_color, - RGB b_color - ) = - generic_table - ( - (List($Data)) data, - (List(Table_Option)) lto, - (List(HTML_Row(HTML_Off_Form))) columns_name, - (HowManyColumns) _1, - ((RGB,Int,$Data) -> HTML_Row(HTML_Off_Form)) (RGB r,Int n,$Data d) |-> line_format(r,d), - (RGB) a_color, - (RGB) b_color, - (Total_Line($Data,$Data,HTML_Row(HTML_Off_Form))) no_total - ). - -public define HTML_In_Form - generic_table - ( - List($Data) data, - List(Table_Option) lto, - List(HTML_Row(HTML_In_Form)) columns_name, - (RGB,$Data) -> HTML_Row(HTML_In_Form) line_format, - RGB a_color, - RGB b_color - ) = - generic_table - ( - (List($Data)) data, - (List(Table_Option)) lto, - (List(HTML_Row(HTML_In_Form))) columns_name, - (HowManyColumns) _1, - ((RGB,Int,$Data) -> HTML_Row(HTML_In_Form)) (RGB r,Int n,$Data d) |-> line_format(r,d), - (RGB) a_color, - (RGB) b_color, - (Total_Line($Data,$Data,HTML_Row(HTML_In_Form))) no_total - ). - - - 2/ Table with total-line and without multicolumns, enumeration. - - -public define HTML_Off_Form - generic_table - ( - List($Data) data, - List(Table_Option) lto, - List(HTML_Row(HTML_Off_Form)) columns_name, - (RGB,$Data) -> HTML_Row(HTML_Off_Form) line_format, - RGB a_color, - RGB b_color, - Total_Line($Data,$Upplet,HTML_Row(HTML_Off_Form)) total_line - ) = - generic_table - ( - (List($Data)) data, - (List(Table_Option)) lto, - (List(HTML_Row(HTML_Off_Form))) columns_name, - (HowManyColumns) _1, - ((RGB,Int,$Data) -> HTML_Row(HTML_Off_Form)) (RGB r,Int n,$Data d) |-> line_format(r,d), - (RGB) a_color, - (RGB) b_color, - (Total_Line($Data,$Upplet,(HTML_Row(HTML_Off_Form)))) total_line - ). - -public define HTML_In_Form - generic_table - ( - List($Data) data, - List(Table_Option) lto, - List(HTML_Row(HTML_In_Form)) columns_name, - (RGB,$Data) -> HTML_Row(HTML_In_Form) line_format, - RGB a_color, - RGB b_color, - Total_Line($Data,$Upplet,HTML_Row(HTML_In_Form)) total_line - ) = - generic_table - ( - (List($Data)) data, - (List(Table_Option)) lto, - (List(HTML_Row(HTML_In_Form))) columns_name, - (HowManyColumns) _1, - ((RGB,Int,$Data) -> HTML_Row(HTML_In_Form)) (RGB r,Int n,$Data d) |-> line_format(r,d), - (RGB) a_color, - (RGB) b_color, - (Total_Line($Data,$Upplet,(HTML_Row(HTML_In_Form)))) total_line - ). - - - - - 3/ Table with multicolumns, enumeration, but without total - -public define HTML_Off_Form - generic_table - ( - List($Data) data, - List(Table_Option) lto, - List(HTML_Row(HTML_Off_Form)) columns_name, - HowManyColumns number_of_columns, - (RGB,Int,$Data) -> HTML_Row(HTML_Off_Form) line_format, - RGB a_color, - RGB b_color - ) = - generic_table - ( - (List($Data)) data, - (List(Table_Option)) lto, - (List(HTML_Row(HTML_Off_Form))) columns_name, - (HowManyColumns) number_of_columns, - ((RGB,Int,$Data) -> HTML_Row(HTML_Off_Form)) (RGB r,Int n,$Data d) |-> line_format(r,n,d), - (RGB) a_color, - (RGB) b_color, - (Total_Line($Data,$Data,(HTML_Row(HTML_Off_Form)))) no_total - ). - - -public define HTML_In_Form - generic_table - ( - List($Data) data, - List(Table_Option) lto, - List(HTML_Row(HTML_In_Form)) columns_name, - HowManyColumns number_of_columns, - (RGB,Int,$Data) -> HTML_Row(HTML_In_Form) line_format, - RGB a_color, - RGB b_color - ) = - generic_table - ( - (List($Data)) data, - (List(Table_Option)) lto, - (List(HTML_Row(HTML_In_Form))) columns_name, - (HowManyColumns) number_of_columns, - ((RGB,Int,$Data) -> HTML_Row(HTML_In_Form)) (RGB r,Int n,$Data d) |-> line_format(r,n,d), - (RGB) a_color, - (RGB) b_color, - (Total_Line($Data,$Data,(HTML_Row(HTML_In_Form)))) no_total - ). - - - - 4/ Table with multicolumns and without enumeration & total - -public define HTML_Off_Form - generic_table - ( - List($Data) data, - List(Table_Option) lto, - List(HTML_Row(HTML_Off_Form)) columns_name, - HowManyColumns number_of_columns, - (RGB,$Data) -> HTML_Row(HTML_Off_Form) line_format, - RGB a_color, - RGB b_color - ) = - generic_table - ( - (List($Data)) data, - (List(Table_Option)) lto, - (List(HTML_Row(HTML_Off_Form))) columns_name, - (HowManyColumns) number_of_columns, - ((RGB,Int,$Data) -> HTML_Row(HTML_Off_Form)) (RGB r,Int n,$Data d) |-> line_format(r,d), - (RGB) a_color, - (RGB) b_color, - (Total_Line($Data,$Data,(HTML_Row(HTML_Off_Form)))) no_total - ). - - -public define HTML_In_Form - generic_table - ( - List($Data) data, - List(Table_Option) lto, - List(HTML_Row(HTML_In_Form)) columns_name, - HowManyColumns number_of_columns, - (RGB,$Data) -> HTML_Row(HTML_In_Form) line_format, - RGB a_color, - RGB b_color - ) = - generic_table - ( - (List($Data)) data, - (List(Table_Option)) lto, - (List(HTML_Row(HTML_In_Form))) columns_name, - (HowManyColumns) number_of_columns, - ((RGB,Int,$Data) -> HTML_Row(HTML_In_Form)) (RGB r,Int n,$Data d) |-> line_format(r,d), - (RGB) a_color, - (RGB) b_color, - (Total_Line($Data,$Data,(HTML_Row(HTML_In_Form)))) no_total - ). - - - - diff --git a/web/CXM_http_get.anubis b/web/CXM_http_get.anubis deleted file mode 100644 index 039fc50..0000000 --- a/web/CXM_http_get.anubis +++ /dev/null @@ -1,318 +0,0 @@ - *Project* The Anubis Project - - *Title* Getting a document from the Web. - - *Copyright* Copyright (c) Alain Prouté 2001. - - - *Author* Alain Prouté - - - - *Overview* - This file defines the function 'http_get' which retrieves a document from the world - wide web (a similar function 'https_get' for secured documents is defined in - 'https_get.anubis'). The function simulates the behavior of a browser, at least just - what is needed to retrieve the document. It does not display the document, but returns - it (if found) in the form of a string. It also returns the response line from the - server, and the list af all HTTP headers. - - The function 'http_get' takes the following arguments: - - - the name of the server to which the request is to be sent, - - the name (including the path) of the document on this server, - - a list of headers to be added to mandatory standard headers, - - a list of 'arguments' in the form of pairs of strings '(name,value)' to be sent as - the body of the request. - - - The result returned by 'http_get' has the following type, which defines the problems - which may happen: - - -read tools/basis.anubis -read system/string.anubis -transmit xlib/web/CXM_common.anubis -transmit xlib/web/CXM_http_get_common.anubis - - -public type HTTP_GET_Result: - cannot_resolve_server_name(DNS_Result), - cannot_connect_to_server(NetworkConnectError), - transmission_problem, - request_refused_by_server, - ok(String response, // HTTP response line from the server - List(HTTP_header) headers, // HTTP headers received from the server - String document). // The HTML document itself - - -public define HTTP_GET_Result - http_get - ( //-------- example: ----------------------- - String server_name, // "www.machin.com" - String document_name, // "/truc/bidule.html" - List(HTTP_header) headers, // [http_header("Cookie","..."),...] - List(HTTP_argument) arguments // [http_argument("ga","bu"),...] - ). - - The same one without the 'headers' argument: - -public define HTTP_GET_Result - http_get - ( //-------- example: ----------------------- - String server_name, // "www.machin.com" - String document_name, // "/truc/bidule.html" - List(HTTP_argument) arguments // [http_argument("ga","bu"),...] - ) = http_get(server_name,document_name,[],arguments). - - - - This file also defines the command 'http_get' to be used directly from the system - prompt. To learn about the syntax, just type 'http_get' at the system prompt, or have - a look at the end of this file - - --- That's all for public definitions. ------------------------------------------------ - - - - We need two functions for sending and receiving bytes. - -define Maybe(One) - send - ( - RWStream conn, // where to send the text - String text, // the text to be sent - Word32 n // start sending at character number 'n' in 'text' - ) = - if nth(to_Int(n),text) is - { - failure then success(unique), - success(c) then - if conn <- c is - { - failure then failure, - success(_) then send(conn,text,n+1) - } - }. - -define Maybe(String) - receive_text_chunk - ( - RWStream conn, - List(Word8) so_far, - Word32 count - ) = - if count = 1000 then - success(implode(reverse(so_far))) - else if *conn is // *conn waits for data to be readable from connection - { - failure then success(implode(reverse(so_far))), // means 'connection closed by peer' - success(c) then - receive_text_chunk(conn, [c . so_far], count+1) - }. - - -define HTTP_GET_Result - receive - ( - RWStream conn, - String headers, - String text_so_far, - Bool double_crlf_seen - ) = - if receive_text_chunk(conn,[],0) is - { - failure then if separate_headers(headers) is - { - [ ] then ok("",[],text_so_far), - [h . t] then if h is http_header(a,b) then ok(a,t,text_so_far) - }, - - success(s) then - if s = "" then - if separate_headers(headers) is - { - [ ] then ok("",[],text_so_far), - [h . t] then if h is http_header(a,b) then ok(a,t,text_so_far) - } - else - with new_s = text_so_far+s, - if double_crlf_seen then - with len = length(s), - println("content received : "+len+" bytes"); - receive(conn, headers, new_s, true) - else if has_double_crlf(new_s) is - { - failure then - receive(conn, headers, new_s, false), - success(n) then - //extract the begin of data - if sub_string(new_s,n+4,length(new_s)-n-4) is - { - failure then alert, - success(s1) then - //extract end of the header - if sub_string(new_s, 0, n) is - { - failure then alert, - success(h) then receive(conn, h, s1, true) - } - } - } - }. - - - - The next function has a valid TCP/IP connection to the server, and tries to retrieve - the document. - - -define HTTP_GET_Result - http_get - ( - Bool print_all, - RWStream conn, - String server_name, - String document_name, - List(HTTP_header) headers, - List(HTTP_argument) arguments, - ) = - // - // Send the HTTP request, and receive the answer: - // - with body = format_http_args(arguments), - with request = (if arguments = [] then "GET " else "POST ") - + document_name + " HTTP/1.1" + crlf + - "Host: " + server_name + crlf + - "Accept-Charset: iso-8859-1,*,utf-8" + crlf + - (if arguments = [] then "" - else "Content-type: application/x-www-form-urlencoded" + crlf + - "Content-length: " + to_decimal(length(body))+ crlf) + - format_headers(headers) + - crlf + - body, - (if print_all then - ( - print("----- request ----\n"); - print(request); - print("\n") - ) else unique); - if send(conn,request,0) is - { - failure then transmission_problem, - success(_) then receive(conn,"","",false) - }. - - - The next function retrieves the document using the numerical (resolved) server address. - -define HTTP_GET_Result - http_get - ( - Bool print_all, - Word32 server_addr, - Word32 server_port, - String server_name, - String document_name, - List(HTTP_header) headers, - List(HTTP_argument) arguments, - ) = - // - // try to connect to the server before sending the request - // - if (Result(NetworkConnectError,RWStream))connect(server_addr,server_port) is - { - error(e) then cannot_connect_to_server(e), - ok(conn) then http_get(print_all,conn,server_name,document_name,headers,arguments) - }. - - -public define HTTP_GET_Result - http_get - ( - Bool print_all, - String server_name, - String document_name, - List(HTTP_header) headers, - List(HTTP_argument) arguments, - ) = - if separate_name_port(server_name,80) is (name,port) then - // - // resolve server name and call 'http_get' with numeric server address: - // - with a = dns(name), - if a is ok(addr) - then http_get(print_all,addr,port,name,document_name,headers,arguments) - else cannot_resolve_server_name(a). - - - Now, here is our public tool: - -public define HTTP_GET_Result - http_get - ( - String server_name, - String document_name, - List(HTTP_header) headers, - List(HTTP_argument) arguments, - ) = http_get(false,server_name,document_name,headers,arguments). - - - - Finally, we construct the executable module 'http_get': - -define One - recall_syntax = - print("\nUsage: http_get [options] =
... - ...\n"); - print(" Options are:\n"); - print(" -print_all print request, response line, headers and document\n"); - print(" (default is to print only the document)\n"). - - - - - global define One - http_get - ( - List(String) args - ) = - if args is - { - [ ] then recall_syntax, - [server . t] then if t is - { - [ ] then recall_syntax, - [document . rest] then - with print_all = member(rest,"-print_all"), - headers = get_headers(rest), - arguments = get_arguments(rest), - if http_get(print_all,server,document,headers,arguments) is - { - cannot_resolve_server_name(dns_error) then - print("Cannot resolve server name: " + format(dns_error) + ".\n"), - - cannot_connect_to_server(connect_error) then - print("Cannot connect to server: " + format(connect_error) + ".\n"), - - transmission_problem then - print("Transmission problem.\n"), - - request_refused_by_server then - print("The request has been refused by server: " + server + ".\n"), - - ok(response,headers1,document1) then - ( - if print_all - then ( - print("\n----- response ----\n"); - print(response); - print("\n----- headers -----\n"); - print_headers(headers1); - print("----- document ----\n") - ) else unique - ); - print(document1) // on the screen (use a redirection to get it in a file) - } - } - }. - diff --git a/web/CXM_https_get.anubis b/web/CXM_https_get.anubis deleted file mode 100644 index 1b1e029..0000000 --- a/web/CXM_https_get.anubis +++ /dev/null @@ -1,390 +0,0 @@ - - *Project* The Anubis Project - - *Title* Getting a document from the secured Web. - - *Copyright* Copyright (c) Alain Prouté 2001. - - - *Author* Alain Prouté - - - *Overview* - This file defines the function 'https_get' which retrieve a document from the world - wide web in secured mode (HTTPS). The function is analogous to 'http_get', to be found - in 'web/http_get.anubis'. - - The function simulates the behavior of a browser, at least just what is needed to - retrieve the document. It does not display the document, but returns it (if found) in - the form of a string. - - The function 'https_get' takes the following operands: - - - the name of the server to which the request is to be sent, - - the name (including the path) of the document on this server, - - a list of headers to be added to mandatory standard headers, - - a list of 'arguments' to be sent as the body of the request (web arguments). - - an accept policy function (see below), for accepting X.509 certificates in case of - a problem. - - The result returned by 'https_get' has the following type, which defines the problems - which may happen: - - -read tools/basis.anubis -read system/string.anubis -//read html.anubis -read CXM_http_get_common.anubis -//read http_server.anubis -read CXM_common.anubis - - -public type HTTPS_GET_Result: - cannot_resolve_server_name(DNS_Result), - ssl_connect_error(SSLConnectError), - transmission_problem, - request_refused_by_server, - ok(String response, - List(HTTP_header) headers, - String document). - - Cookies are among headers. See 'web/cookies.anubis' for cookies handling. - - - Note: The types 'DNS_Result' and 'SSLConnectError' are defined in 'predefined.anubis'. - -public define HTTPS_GET_Result - https_get - ( - String server_name, - String document_name, - List(HTTP_header) headers, - List(HTTP_argument) arguments, - (Maybe(X509)) -> Bool accept_policy - ). - - The same one without the 'headers' argument: - -public define HTTPS_GET_Result - https_get - ( - String server_name, - String document_name, - List(HTTP_argument) arguments, - (Maybe(X509)) -> Bool accept_policy - ) = https_get(server_name,document_name,[],arguments,accept_policy). - - The main difference with 'http_get' is the presence of the 'accept_policy' - argument. 'accept_policy' is the function which determines your personal policy for - accepting a server certificate, if it is the case that either this certificate is - invalid (or missing), or if its common name does not match the server name, that is to - say if 'open_SSL_connection' (defined in 'predefined.anubis') did not already accept - it. - - 'X509' is an 'opaque' type defined in 'predefined.anubis'. It is 'opaque' in the sens - that no alternative of this type is directly accessible to you (despite the fact that - the type is public). - - An accept policy function takes (maybe) an X.509 certificate as its unique argument, so - that the decision may be taken with the suspect certificate at hand. It must return - 'true' for accepting, and 'false' for refusing. - - You may use the following default accept policy function: - -public define Bool - default_accept_policy - ( - Maybe(X509) suspect_certificate - ) = false. - - That is, never accept a certificate which cannot be successfully verified by - 'open_SSL_connection'. Notice that this is not a paranoid behavior, but a normal - behavior. Nevertheless, you still have the possibility to weaken this behavior by - using another accept policy function. Be very careful when writing this function, - because this may weaken your security. This function may for example show the - certificate and ask for user input for accepting it. It may also check the certificate - fingerprint against a data base, etc... - - Another accept policy function is defined in this file: - -public define Bool - command_line_accept_policy - ( - Maybe(X509) suspect_certificate - ). - - It is used by the command line module 'https_get.adm'. If the certificate is not - accepted by 'open_SSL_connection', this function prints the certificate on the screen, - and ask the user for acceptation. It also asks the user for accepting the certificate - for ever. - - It is likely that you will need an accept policy function of your own. See the - definition of 'command_line_accept_policy' below for information and - 'predefined.anubis' for the tools enabling the manipulation of X.509 certificates. - Certificates that you trust are stored into the directory declared under the symbol - 'ca' (for 'Certificate Authorities') in your configuration file. Any certificate - present in this directory is trusted without any condition. - - This file defines the module 'https_get' to be used directly from the command line. To - learn about the syntax, just type 'https_get' at the system prompt, or have a look at - the end of this file. - - - - - --- That's all for public definitions. ------------------------------------------------ - - - - - - - - -define Maybe(String) - receive_text_chunk - ( - SSL_Connection conn - ) = - read(conn,100,1000). - - - - -define HTTPS_GET_Result - receive - ( - SSL_Connection conn, - String headers, - String text_so_far, - Bool double_crlf_seen - ) = - if receive_text_chunk(conn) is - { - failure then if separate_headers(headers) is - { - [ ] then ok("",[],text_so_far), - [h . t] then if h is http_header(a,b) then ok(a,t,text_so_far) - }, - - success(s) then - if s = "" - then if separate_headers(headers) is - { - [ ] then ok("",[],text_so_far), - [h . t] then if h is http_header(a,b) then ok(a,t,text_so_far) - } - else with new_s = text_so_far+s, - if double_crlf_seen - then receive(conn,headers,new_s,true) - else if has_double_crlf(new_s) is - { - failure then receive(conn,headers,new_s,false), - success(n) then - if sub_string(new_s,n+4,length(new_s)-n-4) is - { - failure then alert, - success(s1) then - if sub_string(new_s,0,n) is - { - failure then alert, - success(h) then receive(conn,h,s1,true) - } - } - } - }. - - - - The next function has a valid SSL connection to the server, and tries to retrieve the - document. - -define HTTPS_GET_Result - https_get - ( - Bool print_all, - SSL_Connection conn, - String server_name, - String document_name, - List(HTTP_header) headers, - List(HTTP_argument) arguments - ) = - // - // Send the HTTP request, and receive the answer: - // - with body = format_http_args(arguments), - with request = (if arguments = [] then "GET " else "POST ") - + document_name + " HTTP/1.0" + crlf + - "Host: " + server_name + crlf + - "Accept-Charset: iso-8859-1,*,utf-8" + crlf + - (if arguments = [] then "" - else "Content-type: application/x-www-form-urlencoded" + crlf + - "Content-length: " + to_decimal(length(body))+ crlf) + - format_headers(headers) + - crlf + - body, - (if print_all then - ( - print("Sending request:\n"); - print(request); - print("\n") - ) else unique); - if write(conn,request) is - { - failure then transmission_problem, - success(_) then receive(conn,"","",false) - }. - - - The next function retrieves the document using the numerical (resolved) server address. - -define HTTPS_GET_Result - https_get - ( - Bool print_all, - Word32 server_addr, - Word32 server_port, - String server_name, - String document_name, - List(HTTP_header) headers, - List(HTTP_argument) arguments, - (Maybe(X509)) -> Bool accept_policy - ) = - if open_SSL_connection(server_name,server_addr,server_port,accept_policy) is - { - error(msg) then ssl_connect_error(msg), - ok(conn) then https_get(print_all,conn,server_name,document_name,headers,arguments) - }. - - - -define HTTPS_GET_Result - https_get - ( - Bool print_all, - String server_name, - String document_name, - List(HTTP_header) headers, - List(HTTP_argument) arguments, - (Maybe(X509)) -> Bool accept_policy - ) = - if separate_name_port(server_name,443) is (name,port) then - // - // resolve server name and call 'https_get' with numeric server address: - // - with a = dns(name), - if a is ok(addr) - then https_get(print_all,addr,port,name,document_name,headers,arguments,accept_policy) - else cannot_resolve_server_name(a). - - - - Now, here is our public tool: - -public define HTTPS_GET_Result - https_get - ( - String server_name, - String document_name, - List(HTTP_header) headers, - List(HTTP_argument) arguments, - (Maybe(X509)) -> Bool accept_policy - ) = https_get(false,server_name,document_name,headers,arguments,accept_policy). - - - - - - Finally, we construct the command line executable module 'https_get.adm': - -define One - syntax_https_get = - print("\nUsage: https_get [options] =
... ...\n"); - print(" Options are:\n"); - print(" -print_all print request, response line, headers and document\n"); - print(" (default is to print only the document)\n"). - - - - - Below is our accept policy function for the command line module. This function may - serve as a model for your own accept policy function. - -public define Bool - command_line_accept_policy - ( - Maybe(X509) mbcert - ) = - if mbcert is - { - failure then - print("No server certificate or invalid server certificate.\n"); - print("Do you want to trust this site anyway ? [Y/N]\n"); - yes, // this is the same as 'if yes then true else false' - - success(cert) then - print(to_string(cert)); - print("\nDo you want to accept the above certificate ? [Y/N]\n"); - if yes - then ( - print("Do you want to accept this certificate for ever ? [Y/N]\n"); - if yes - then (if trust_for_ever(cert) is - { - ca_directory_not_found then print("'ca' directory not found.\n"), - cannot_create_file then print("cannot create file.\n"), - cannot_create_symbolic_link then print("cannot create symbolic link.\n"), - write_error then print("write error.\n"), - ok then unique - }; true) - else true - ) - else false - }. - - -global define One - https_get - ( - List(String) args - ) = - if args is - { - [ ] then syntax_https_get, - [server . t] then if t is - { - [ ] then syntax_https_get, - [document . rest] then - with print_all = member(rest,"-print_all"), - headers = get_headers(rest), - arguments = get_arguments(rest), - if https_get(print_all,server,document,headers,arguments,command_line_accept_policy) is - { - cannot_resolve_server_name(dns_error) then - print("Cannot resolve server name: " + format(dns_error) + ".\n"), - - ssl_connect_error(connect_error) then - print("SSL connect error: " + format(connect_error) + ".\n"), - - transmission_problem then - print("Transmission problem.\n"), - - request_refused_by_server then - print("The request has been refused by server: " + server + ".\n"), - - ok(response,headers1,document1) then - ( - if print_all - then ( - print("\n----- response ----\n"); - print(response); - print("\n----- headers -----\n"); - print_headers(headers1); - print("----- document ----\n") - ) else unique - ); - print(document1) // on the screen (use a redirection to get it in a file) - } - } - }. - diff --git a/web/CXM_mime.anubis b/web/CXM_mime.anubis deleted file mode 100644 index 1700df9..0000000 --- a/web/CXM_mime.anubis +++ /dev/null @@ -1,70 +0,0 @@ - - *Project* The Anubis Project - - *Title* MIME Types definition. - - *Copyright* Copyright (c) Alain Prouté 2005. - - - *Authors* Alain Prouté - David René - - -read tools/base64.anubis -read tools/basis.anubis -read system/string.anubis - - public type MIME: - mime(String type, - String sybtype, - List(String) file_extensions). - - - public define Bool - MIME x = MIME y - = - if x is mime(x_type, x_subtype, _) then - if y is mime(y_type, y_subtype, _) then - insensitive_equal(x_type, y_type) & insensitive_equal(x_subtype, y_subtype). - - public define List(MIME) - known_mime_types - = - [ - mime("application", "octet-stream", [".exe"]), - mime("application", "x-pdf", [".pdf"]), - mime("image", "bmp", [".bmp"]), - mime("image", "gif", [".gif"]), - mime("image", "jpeg", [".jpg", ".jpeg"]), - mime("image", "png", [".png"]), - mime("image", "x-icon", [".ico"]), - mime("text", "html", [".html", ".htm"]), - mime("text", "css", [".css"]), - mime("text", "javascript", [".js"]), - mime("text", "plain", [".txt", ".anubis", ".c", ".h", ".y", "/Makefile"]), - mime("text", "comma-separated-values", [".csv"]), - mime("application", "msword", [".doc"]), - mime("application", "octet-stream", [".emz", ".xml", ".mso", ".wmf", ".gz", ".rar", ".zip", ".card", ".ankh", ".adm", ".swf", ".downloaded"]), - mime("audio", "x-mpeg", [".mp3"]), - mime("video", "x-msvideo", [".avi"]), - mime("message", "rfc822", [".eml"]), - ]. - - public define String - to_String - ( - MIME mime_type - ) = - if mime_type is mime(type, subtype, _) then - type + "/" + subtype. - - public define String - to_MIME_text - ( - String charset, - String text - )= - if length(text) > 0 then - with text2 = "=?"+charset+"?B?"+to_string(base64_encode(to_byte_array(text)))+"?=", - find_and_replace(text2, implode([13,10]), implode([13,10,32])) - else "". diff --git a/web/CXM_style_tools.anubis b/web/CXM_style_tools.anubis deleted file mode 100644 index 776903b..0000000 --- a/web/CXM_style_tools.anubis +++ /dev/null @@ -1,18 +0,0 @@ -public define String - format_rgba_to_style_color - ( - RGBA color - ) = - if color is - { - rgba(r, g, b, a) then - with alpha_str = - if to_Float(word32(word16(a, 0), word16(0, 0))) / 255.0 is - { - failure then "1", - success(v) then - float_to_string(v, 8) - }, - - "rgba(" + to_decimal(r) + "," + to_decimal(g) + "," + to_decimal(b) + "," + alpha_str + ");" - }. diff --git a/web/CXM_web_arg_encode.anubis b/web/CXM_web_arg_encode.anubis deleted file mode 100644 index 0859f83..0000000 --- a/web/CXM_web_arg_encode.anubis +++ /dev/null @@ -1,349 +0,0 @@ - - *Project* The Anubis Project - - *Title* Encoding data for web argument values. - - *Copyright* Copyright (c) Alain Prouté 2002. - - - *Author* Alain Prouté - - - - *Overview* - This file contains encoding and decoding functions which allow to put any serializable - datum as the value of a web argument. The datum is serialized, and the result of - serialization (a byte array) is encoded in such a way that it can safely be used as the - value of a web argument. The encoding process is similar to the standard process - 'base64', but nevertheless different, because base64 is not suitable for that purpose. - - -public define String - web_arg_encode - ( - $T datum - ). - -public define Maybe($T) - web_arg_decode - ( - String encoded_value - ). - - Of course, since the type of the datum is not available from 'encoded_value', a term - like 'web_arg_decode(my_string)' must generally be explicitly typed, like this: - - (Maybe(MyType))web_arg_decode(my_string) - - - These functions are used for example in 'anubis/library/web/kernel.anubis'. - - - - - - --- That's all for the public part. --------------------------------------------------- - -read tools/basis.anubis -read system/convert.anubis - - Our algorithms are copy-pasted from 'base64.anubis' and slightly modified. The point is - twofold: - - (1) base64 encoding inserts carriage return (CR) and line feed (LF) characters every - 76 character, but CR and LF are not suitable in the values of a web argument, - - (2) the base64 alphabet uses '+' and '/', which are also not suitable in the value of - a web argument, because they have special meanings. - - Hence, we just have to modify the base64 algorithms, so as not to generate any CR or - LF, and use '-' and '_' instead of '+' and '/'. Also, we do not use padding characters - '=', which are needless (as remarked in 'anubis/library/tools/base64.anubis'). - - - - *** Encoding. ************************************************************************* - - Translate an index into a wa64 character. - -define Word8 - wa64_alphabet - ( - Word32 index // the index is assumed to be >= 0 and < 64 - ) = - if index -< 0 then print("Bad index [" + index + "] in wa64_alphabet()\n"); '_' else - if index -< 26 then truncate_to_Word8(index+'A') else - if index -< 52 then truncate_to_Word8(index-26+'a') else - if index -< 62 then truncate_to_Word8(index-52+'0') else - if index = 62 then '-' else - if index = 63 then '_' else - print("Bad index [" + index + "] in wa64_alphabet()\n"); '_'. - - - - Transform a group of 3 bytes into a group of 4 wa64 letters. - - -define Word32 - to_word32 - ( - Word8 x - ) = - word32(word16(x,0),0). - -define (Word8,Word8,Word8,Word8) - transform_group - ( - Word8 byte1, - Word8 byte2, - Word8 byte3 - ) = - with n1 = to_word32(byte1), - n2 = to_word32(byte2), - n3 = to_word32(byte3), - ( - wa64_alphabet(n1>>2), - wa64_alphabet(((n1&3)<<4)|(n2>>4)), - wa64_alphabet(((n2&15)<<2)|(n3>>6)), - wa64_alphabet(n3&63) - ). - - - Transform a group of two bytes. - -define ByteArray - two_mod_three - ( - ByteArray result, - Int result_index, - Word8 byte1, - Word8 byte2 - ) = - with n1 = to_word32(byte1), - n2 = to_word32(byte2), - forget(put(result,result_index ,wa64_alphabet(n1>>2))); - forget(put(result,result_index+1,wa64_alphabet(((n1&3)<<4)|(n2>>4)))); - forget(put(result,result_index+2,wa64_alphabet((n2&15)<<2))); - forget(put(result,result_index+4,0)); - result. - - - - Transform a 'group of one byte'. - -define ByteArray - one_mod_three - ( - ByteArray result, - Int result_index, - Word8 byte1 - ) = - with n1 = to_word32(byte1), - forget(put(result,result_index ,wa64_alphabet(n1>>2))); - forget(put(result,result_index+1,wa64_alphabet((n1&3)<<4))); - forget(put(result,result_index+4,0)); - result. - - - -define ByteArray - wa64_encode - ( - ByteArray ba, - Int ba_index, // index into byte array - ByteArray result, - Int result_index - ) = - if nth(ba_index,ba) is - { - failure then forget(put(result,result_index,0)); result, // no new block of 3 bytes - success(byte1) then - if nth(ba_index+1,ba) is - { - failure then one_mod_three(result,result_index,byte1), - success(byte2) then - if nth(ba_index+2,ba) is - { - failure then two_mod_three(result,result_index,byte1,byte2), - success(byte3) then - if transform_group(byte1,byte2,byte3) is (c1,c2,c3,c4) then - ( - forget(put(result,result_index,c1)); - forget(put(result,result_index+1,c2)); - forget(put(result,result_index+2,c3)); - forget(put(result,result_index+3,c4)); - wa64_encode(ba, - ba_index+3, - result, - result_index+4) - ) - } - } - }. - - - -define ByteArray - wa64_encode - ( - ByteArray ba - ) = - with l = length(ba), - wa64_encode(ba,0, - constant_byte_array((((l\57)+1)*76)+10,0),0). - - -public define String - web_arg_encode - ( - $T datum - ) = - to_string(wa64_encode(serialize(datum))). - - - - - - *** Decoding. ************************************************************************* - - See the comments in 'anubis/library/tools/base64.anubis'. - - Checking if a character belongs to the wa64 alphabet. If true, the function returns the - index of the character in the alphabet. - -define Maybe(Word32) - is_wa64_char - ( - Word8 c - ) = - with n = to_word32(c), - if ('A' +=< n & n +=< 'Z') then success(n - 'A') else - if ('a' +=< n & n +=< 'z') then success(n - 'a' + 26) else - if ('0' +=< n & n +=< '9') then success(n - '0' + 52) else - if n = '-' then success(62) else - if n = '_' then success(63) else - failure. - - - - Getting the next wa64 character from the input. The function returns the next position - for reading. The function does not return the character itself, but its index in the - alphabet. - -define Maybe((Int, // next position for reading - Word32)) // index of character in wa64 alphabet - get_next_character - ( - ByteArray ba, - Int n - ) = - if nth(n,ba) is - { - failure then failure, - success(c) then - if is_wa64_char(c) is - { - failure then failure, - success(i) then success((n+1,i)) - } - }. - - - Translating a group of characters into a group of bytes. - -type TranslateGroupResult_WebArg: - three_bytes (Int new_pos, Word8 b1, Word8 b2, Word8 b3), - two_bytes ( Word8 b1, Word8 b2 ), - one_byte ( Word8 b1 ), - zero_bytes, - error. - - -define TranslateGroupResult_WebArg - translate_group - ( - ByteArray ba, - Int n - ) = - if get_next_character(ba,n) is - { - failure then zero_bytes, - success(p1) then if p1 is (n1,i1) then - if get_next_character(ba,n1) is - { - failure then error, - success(p2) then if p2 is (n2,i2) then - if get_next_character(ba,n2) is - { - failure then // we don't check the padding characters - one_byte(truncate_to_Word8((i1<<2)|(i2>>4))), - success(p3) then if p3 is (n3,i3) then - if get_next_character(ba,n3) is - { - failure then - two_bytes(truncate_to_Word8((i1<<2)|(i2>>4)), - truncate_to_Word8(((i2&15)<<4)|(i3>>2))), - success(p4) then if p4 is (n4,i4) then - three_bytes(n4,truncate_to_Word8((i1<<2)|(i2>>4)), - truncate_to_Word8(((i2&15)<<4)|(i3>>2)), - truncate_to_Word8(((i3&3)<<6)|i4)) - } - } - } - }. - - -define Int // returns the size of the decoded array of bytes - translate_groups - ( - ByteArray source, - Int n, // position in source - ByteArray target, - Int m // position in target - ) = - if translate_group(source,n) is - { - three_bytes(n1,b1,b2,b3) then - forget(put(target,m,b1)); - forget(put(target,m+1,b2)); - forget(put(target,m+2,b3)); - translate_groups(source,n1,target,m+3), - - two_bytes(b1,b2) then - forget(put(target,m,b1)); - forget(put(target,m+1,b2)); - m+2, - - one_byte(b1) then - forget(put(target,m,b1)); - m+1, - - zero_bytes then - m, - - error then - m - }. - - -define ByteArray - wa64_decode - ( - ByteArray ba - ) = - with l = length(ba), - result = constant_byte_array(l,'0'), - truncate(result,translate_groups(ba,0,result,0)); - result. - -public define Maybe($T) - web_arg_decode - ( - String encoded_datum - ) = - (Maybe($T))unserialize(wa64_decode(to_byte_array(encoded_datum))). - - - - - diff --git a/web/CXM_xml_rpc.anubis b/web/CXM_xml_rpc.anubis deleted file mode 100644 index bb5f36f..0000000 --- a/web/CXM_xml_rpc.anubis +++ /dev/null @@ -1,418 +0,0 @@ -/* - * Created by PyramIDE. - * User: Totoro - * Date: 29/06/2013 - * Time: 00:47 - * - */ - -read tools/base64.anubis -transmit tools/basis.anubis -read tools/connections.anubis -read system/convert.anubis -transmit system/string.anubis -read xlib/web/CXM_common.anubis -read xlib/web/CXM_http_get_common.anubis -read xlib/web/CXM_multihost_http_server.anubis -transmit xlib/web/CXM_xml_rpc_parser.anubis -transmit xlib/web/CXM_xml_rpc_types.anubis - - -define XML_RPC_parameters sysinfo_params = - parameters - [ - parameter[int(1)], - parameter[bool(true)], - parameter[string("This is a string")], - parameter[double(1.45)], - parameter[datetime("date to do")], - parameter[base64("Base 64 content")], - parameter[struct(members([ - member("1st member", int(2)), - member("2nd member", string("this is the 2nd string")) - ]))], - parameter[array(array([ - int(3), - string("3rd string") - ]))] - ]. - -define XML_RPC_parameters empty_param = parameters []. - -public type XML_RPC_Result: - cannot_resolve_server_name(DNS_Result), - cannot_connect_to_server(NetworkConnectError), - transmission_problem, - request_refused_by_server, - ok(String response, // HTTP response line from the server - List(HTTP_header) headers, // HTTP headers received from the server - String document). // The HTML document itself - -public type XML_RPC_Auth: - none, - basic(String login, String password). - -public type XML_RPC_client: - xml_rpc_client( - Connection conn, - XML_RPC_Auth auth, - String url, - String user_agent, - String host). - -define String - tab - ( - Int position - )= - to_string(constant_byte_array(position * 2, ' ')). - -define String format_struct(XML_RPC_struct structure, Int position). -define String format_array(XML_RPC_array array, Int position). - -define String format_int_value ( Word32 value) = ""+to_String(value)+"" + crlf. -define String format_boolean_value ( Bool value) = ""+to_String_value(value)+"" + crlf. -define String format_string_value ( String value) = ""+value+"" + crlf. -define String format_double_value ( Float value) = ""+float_to_string(value, 10)+"" + crlf. -define String format_datetime_value ( String value) = ""+value+"" + crlf. -define String format_base64_value ( String value) = ""+value+"" + crlf. -define String format_nil = "" + crlf. - - -define String - format_value - ( - XML_RPC_value rpc_value, - Int position - )= - with return = if rpc_value is - { - int(value) then format_int_value(value), - bool(value) then format_boolean_value(value), - string(value) then format_string_value(value), - double(value) then format_double_value(value), - datetime(value) then format_datetime_value(value), - base64(value) then format_base64_value(value), - struct(value) then format_struct(value, position + 1), - array(value) then format_array(value, position + 1), - nil then format_nil - }, - tab(position) + return. - - -define String - _format_struct - ( - String so_far, - List(XML_RPC_struct_member) members, - Int position - )= - if members is - { - [] then so_far, - [h . t] then - if h is member(name, val) then - _format_struct( so_far + tab(position) + "" + crlf + - tab(position + 1)+""+name+"" + crlf + - format_value(val, position + 1) + - tab(position + 1) + "" + crlf, - t, - position) - }. - -define String - format_struct - ( - XML_RPC_struct struct, - Int position - ) = - if struct is members(structure_members) then - /*tab(position) +*/ "" + crlf + - _format_struct("", structure_members, position+1)+ - tab(position + 1) + "" + crlf. - -define String - _format_array - ( - String so_far, - List(XML_RPC_value) values, - Int position - )= - if values is - { - [] then so_far, - [h . t] then _format_array( so_far + format_value(h, position), t, position) - }. - -define String - format_array - ( - XML_RPC_array arr, - Int position - ) - = - if arr is array(values) then - /*tab(position) +*/ "" + crlf + - tab(position + 1) + "" + crlf+ - _format_array("", values, position + 2)+ - tab(position+2)+"" + crlf + - tab(position + 1) + "" + crlf. - -public define String - format_xml_rpc_values - ( - List(XML_RPC_value) values, - Int position, - String so_far - )= - if values is - { - [] then so_far, - [ h . t ] then - format_xml_rpc_values(t, position, so_far + format_value(h, position)) - }. - -public define String - format_xml_rpc_parameter - ( - XML_RPC_parameter param, - Int position - )= - if param is parameter(values) then - format_xml_rpc_values(values, position, "") - . - - -define String - _format_xml_rpc_parameters - ( - String so_far, - List(XML_RPC_parameter) params, - Int position - )= - if params is - { - [] then so_far, - [ h . t ] then - _format_xml_rpc_parameters( so_far + tab(position) + "" + crlf + - format_xml_rpc_parameter(h, position + 1) + - tab(position+1) + "" + crlf, - t, - position) - }. - -public define String - format_xml_rpc_parameters - ( - XML_RPC_parameters params, - Int position - )= - if params is parameters(list_param) then - tab(position)+"" + crlf + - _format_xml_rpc_parameters("", list_param, position+1) + - tab(position+1)+"". - -public define String - format_xml_rpc_fault - ( - XML_RPC_value value, - Int position - )= - tab(position)+"" + crlf + - format_value(value, position+1) + - tab(position+1)+"". - -public define Bool - accept_policy - ( - Maybe(X509) suspect_certificate - ) = true. - -public define Maybe(XML_RPC_client) - xml_rpc_new_client - ( - String server_name, - Bool use_ssl, - XML_RPC_Auth auth, - String user_agent, - String host - )= - if separate_name_port(server_name, if use_ssl then 443 else 80) is (name, server_port) then - // - // resolve server name and call 'https_get' with numeric server address: - // - with a = dns(name), - if a is ok(server_addr) then - //connect to server with right protocol - if use_ssl then - //println("SSL "+server_port+ " "+server_name); - if open_SSL_connection(server_name, server_addr, server_port, accept_policy) is - { - error(msg) then failure, - ok(conn) then success(xml_rpc_client(ssl(conn), auth, server_name, user_agent, host)) - } - else - //println("TCP "+server_port+ " "+server_name); - if (Result(NetworkConnectError,RWStream))connect(server_addr, server_port) is - { - error(e) then failure, - ok(conn) then success(xml_rpc_client(tcp(conn), auth, server_name, user_agent, host)) - } - else - failure. -define Maybe(XML_RPC_response) - receive - ( - Bool print_dump, - Connection conn - )= - //TODO find the header and content-lenght to get full length of answer - - if read(conn, 16384, 5) is - { - error then println("Read error");failure, - timeout then println("Read timeout");failure, - ok(ba) then - with xml_response = to_string(ba), - typed_response = xml_rpc_get_response(xml_response), - (if print_dump then - - println("=== Server answer ==="+crlf + xml_response ); - println("=== XML_RPC Anubis interpretation ==="); - - if typed_response is - { - failure then println("Interpretation error"), - success(result) then - if result is - { - ok(ok_res) then println(format_xml_rpc_parameters(ok_res,1)), - fault(fault) then println(format_xml_rpc_fault(fault,1)) - } - - } - else unique); - typed_response - } - . - -define Maybe(XML_RPC_response) - receive_new - ( - Bool print_dump, - Connection conn - )= - //TODO find the header and content-lenght to get full length of answer - //construct a buffered connection - with b_con = http_buffered_connection(conn), - if skip_line(b_con) is - { - error(msg) then print(format(msg));failure, - ok(_) then - if read_http_headers(b_con) is - { - error(msg) then print(format(msg));failure, - ok(headers) then - if get_body_size(headers) is - { - error(msg) then print(format(msg));failure, - ok(body_size) then - if read_http_body(b_con, body_size, constant_byte_array(0,0), 1000) is - { - error(msg) then print(format(msg));failure, - ok(body) then - with xml_response = to_string(body), - with typed_response = xml_rpc_get_response(xml_response), - (if print_dump then - - println("=== Server answer ==="+crlf + xml_response); - println("=== XML_RPC Anubis interpretation ==="); - - if typed_response is - { - failure then println("Interpretation error"), - success(result) then - if result is - { - ok(ok_res) then println(format_xml_rpc_parameters(ok_res,1)), - fault(fault) then println(format_xml_rpc_fault(fault,1)) - } - - } - else unique); - typed_response - } - } - }} - . - -public define Maybe(XML_RPC_response) - xml_rpc_client_execute - ( - Bool print_dump, - XML_RPC_client client, - String url, - String method_name, - XML_RPC_parameters params - //(XML-string)->$T answer_handler //convert the xml answer to anubis type - )= - if client is xml_rpc_client(conn, auth, server_name, user_agent, host) then - //execute the method on remote server - // - 1 - Format the xml body to comply with XML RPC - with body = "" + crlf + - tab(1)+"" + crlf + - tab(2)+"" + method_name +"" + crlf + - format_xml_rpc_parameters(params, 2) + - tab(1)+"", - - // - 2 - Format the POST HTTP request - with request = "POST "+url+" HTTP/1.1"+ crlf + //HTTP/1.1 is very important because it allow to send multiple execute - "User-Agent: "+ user_agent + crlf + //with only one connection (keep-alive is default in http 1.1) - "Host: " + server_name + crlf + - "Content-type: text/xml" + crlf + - if auth is - { - none then "", - basic(login, pass) then "Authorization: Basic "+base64_encode(login+":"+pass)+ crlf - }+ - "Content-length: " + length(body)+ crlf + - - //format_headers(headers) + - crlf + - body, - - // - 3 - send it to remote - - // - // Send the HTTP request, and receive the answer: - // - (if print_dump then - ( - print("----- request ----\n"); - print(request); - print("\n") - ) else unique); - - if write(conn, to_byte_array(request)) is - { - failure then failure, - success(_) then receive_new(print_dump, conn) - }. - - //wait the answer - - - global define One - xml_rpc_test - ( - List(String) args - )= - if xml_rpc_new_client("mail.calexium.com:33610", true, basic("admin","the secret passsword"), "Anubis XML-RPC", "127.0.0.1") is - { - failure then println(" xml_rpc_test new client failure"), - success(rpc_client) then - forget(xml_rpc_client_execute(false, rpc_client, "/Settings", "list_domains", empty_param)) - //forget(xml_rpc_client_execute(true, rpc_client, "/Settings", "delete_domain", parameters([parameter[string("amisdefontainebleau.org")]]))) - //forget(xml_rpc_client_execute(true, rpc_client, "/Settings", "create_domain", empty_param)) - }. - diff --git a/web/CXM_xml_rpc_parser.anubis b/web/CXM_xml_rpc_parser.anubis deleted file mode 100644 index 8e53bbc..0000000 --- a/web/CXM_xml_rpc_parser.anubis +++ /dev/null @@ -1,481 +0,0 @@ -/* - * Created by PyramIDE. - * User: Totoro - * Date: 06/07/2013 - * Time: 01:13 - * - */ - -read xlib/web/CXM_xml_rpc_types.anubis -read tools/streams.anubis -read tools/basis.anubis -read system/string.anubis -read system/convert.anubis - -type XML_RPC_Token: - none, - token(String token). - -define Maybe(XML_RPC_value) read_value(Stream stream). - -define XML_RPC_Token - _next_xml_token - ( - Stream stream, - List(Word8) so_far, - Bool in_token - )= - if read_byte(stream) is - { - failure then none, //can't read on stream !! - success(b) then - //println("["+implode([b])+"]"); - if in_token then - if b = '>' then //just found the end of bracket, so we return the token in LOWER case - with tok = to_lower(implode(reverse(so_far))), - //println("found tag "+tok); - token(tok) - else - _next_xml_token(stream, [b . so_far], in_token) - else - if b = '<' then //just found the begin of token - _next_xml_token(stream, [], true) - else - _next_xml_token(stream, so_far, in_token) - } - . - - - -define XML_RPC_Token - next_xml_token - ( - Stream stream - )= _next_xml_token(stream, [], false). - -define Maybe(String) - _xml_tag_content - ( - Stream stream, - String tag, //tag to match - List(Word8) so_far, - List(Word8) content, - Bool in_first_token, - Bool in_content, - Bool in_last_token - - )= - if read_byte(stream) is - { - failure then failure, //can't read on stream !! - success(b) then - if in_first_token then - if b = '>' then //just found the end of bracket, so we return the token in LOWER case - if to_lower(implode(reverse(so_far))) = tag then - _xml_tag_content(stream, tag, [], [], false, true, false) - else - failure - else - _xml_tag_content(stream, tag, [b . so_far], content, in_first_token, in_content, in_last_token) - else if in_content then - if b = '<' then //just found the begin bracket, - if read_byte(stream) is - { - failure then failure, //can't read on stream !! - success(_b) then - if _b = '/' then //can't find / => syntax error - _xml_tag_content(stream, tag, [], content, false, false, true) - else - failure - } - else - _xml_tag_content(stream, tag, [], [b . content], false, true, false) - else if in_last_token then - if b = '>' then //just found the end of bracket, so we return the token in LOWER case - if to_lower(implode(reverse(so_far))) = tag then - with _content = implode(reverse(content)), - println("Tag ["+tag+"] content found ["+_content+"]"); - success(_content) - else - failure - else - _xml_tag_content(stream, tag, [b . so_far], content, false, false, true) - - else - if b = '<' then //just found the begin of token - _xml_tag_content(stream, tag, [], [], true, false, false) - else - _xml_tag_content(stream, tag, [], [], false, false, false) - } - . -define Maybe(String) - xml_pair_tag_content - ( - Stream stream, - String tag - )= _xml_tag_content( stream, tag, [], [], false, false, false). - -define Maybe(String) - xml_tag_content - ( - Stream stream, - String tag - )= _xml_tag_content( stream, tag, [], [], false, true, false). - - /***** ARRAY functions ******/ - -define Maybe(List(XML_RPC_value)) - read_values - ( - Stream stream, - List(XML_RPC_value) so_far - )= - if read_value(stream) is - { - failure then failure, - success(value) then - if next_xml_token(stream) is - { - none then failure, - token(token) then - - if token = "value" then //there is another value we read it - read_values(stream, [value . so_far]) - else - unput_string("<"+token+">", stream); - success(reverse([value . so_far])) - } - }. - -define Maybe(List(XML_RPC_value)) - read_data - ( - Stream stream - )= - if next_xml_token(stream) is - { - none then failure, - token(token) then - if token = "data" then - if next_xml_token(stream) is - { - none then failure, - token(token) then - if token = "value" then - if read_values(stream, []) is - { - failure then failure - success(values) then - if next_xml_token(stream) is - { - none then failure, - token(token) then - if token = "/data" then - success(values) - else - failure - } - } - // mean empty array - else if token = "/data" then - success([]) - else - failure - } - else - failure - }. - -define Maybe(XML_RPC_value) - read_array - ( - Stream stream - )= - if read_data(stream) is - { - failure then failure - success(values) then - if next_xml_token(stream) is - { - none then failure, - token(token) then - if token = "/array" then - success(array(array(values))) - else - failure - } - }. - - /***** STRUCT functions ******/ - -define Maybe(List(XML_RPC_struct_member)) - read_members - ( - Stream stream, - List(XML_RPC_struct_member) so_far - )= - if xml_pair_tag_content(stream, "name") is - { - failure then failure, - success(member_name) then - if next_xml_token(stream) is - { - none then failure, - token(tok) then - if tok = "value" then - if read_value(stream) is - { - failure then failure, - success(value) then - if next_xml_token(stream) is - { - none then failure, - token(tok) then - if tok = "/member" then - if next_xml_token(stream) is - { - none then failure, - token(tok) then - if tok = "member" then //there is another member in structure, we read it - read_members(stream, [member(member_name, value) . so_far]) - else if tok = "/struct" then //End of structrue found - //println("End struct"); - success(reverse([member(member_name, value) . so_far])) //return all members in right order - else - failure //unexpected token - } - else - failure - } - } - else - failure - } - } . - -define Maybe(XML_RPC_value) - read_struct - ( - Stream stream - )= - if next_xml_token(stream) is - { - none then failure, - token(token) then - //there is member hence read it - if token = "member" then - - if read_members(stream, []) is - { - failure then failure - success(members_list) then success(struct(members(members_list))) - } - //the immediate following token is . Hence this is an empty struct - else if token = "/struct" then - success(struct(members([]))) - else - failure - }. - -define Maybe(XML_RPC_value) - read_value - ( - Stream stream - )= - if next_xml_token(stream) is - { - none then failure, - token(token) then - with value = if token = "string" then - if xml_tag_content(stream, "string") is - { - failure then failure, - success(v) then success(string(v)) - } - else if token = "int" then - if xml_tag_content(stream, "int") is - { - failure then failure, - success(v) then - if decimal_scan(v) is - { - failure then failure, - success(int_v) then success(int(truncate_to_Word32(int_v))) - } - } - else if token = "i4" then - if xml_tag_content(stream, "i4") is - { - failure then failure, - success(v) then - if decimal_scan(v) is - { - failure then failure, - success(int_v) then success(int(truncate_to_Word32(int_v))) - } - } - else if token = "boolean" then - if xml_tag_content(stream, "boolean") is - { - failure then failure, - success(v) then success(bool(to_Bool(v))) - } - else if token = "double" then - if xml_tag_content(stream, "string") is - { - failure then failure, - success(v) then success(double(0.0)) - } - else if token = "datetime" then - if xml_tag_content(stream, "string") is - { - failure then failure, - success(v) then success(datetime(v)) - } - else if token = "base64" then - if xml_tag_content(stream, "base64") is - { - failure then failure, - success(b64) then success(base64(b64)) - } - else if token = "struct" then read_struct(stream) - else if token = "array" then read_array(stream) - else if token = "nil/" then success(nil) - else - println("Unknown token ["+token+"]"); - failure, - if next_xml_token(stream) is - { - none then failure - token(token) then - if token = "/value" then - value - else - failure - } - }. - -define Maybe(XML_RPC_parameter) - in_value - ( - Stream stream, - List(XML_RPC_value) so_far - )= - if next_xml_token(stream) is - { - none then failure, - token(tok) then - if tok = "value" then - if read_value(stream) is - { - failure then failure, - success(value) then in_value(stream, [ value. so_far]) - } - else if tok = "/param" then - success(parameter(reverse(so_far))) - else - failure - }. - -define Maybe(XML_RPC_value) - in_fault - ( - Stream stream, - )= - if next_xml_token(stream) is - { - none then failure, - token(tok) then - if tok = "value" then - if read_value(stream) is - { - failure then failure, - success(value) then - if next_xml_token(stream) is - { - none then failure, - token(tok) then - if tok = "/fault" then - success(value) - else - failure - } - } - else - failure - }. - -define Maybe(XML_RPC_parameters) - in_param - ( - Stream stream, - List(XML_RPC_parameter) so_far - )= - if next_xml_token(stream) is - { - none then failure, - token(tok) then - if tok = "param" then - if in_value(stream, []) is - { - failure then failure, - success(param) then in_param(stream, [ param . so_far]) - } - - else if tok = "/params" then - success(parameters(reverse(so_far))) - else - failure - } - . - -define Maybe(XML_RPC_response) - in_params - ( - Stream stream - )= - if next_xml_token(stream) is - { - none then failure, - token(tok) then - if tok = "params" then - if in_param(stream, []) is - { - failure then failure, - success(resp) then success(ok(resp)) - } - else if tok = "fault" then - if in_fault(stream) is - { - failure then failure, - success(resp) then success(fault(resp)) - } - else - failure - } - - . - -public define Maybe(XML_RPC_response) - xml_rpc_get_response - ( - String response - )= - with stream = make_stream(response), - if next_xml_token(stream) is - { - none then failure - token(tok) then - if tok = "?xml version='1.0'?" then - if next_xml_token(stream) is - { - none then failure - token(_tok) then - if _tok = "methodresponse" then - in_params(stream) - else - failure - } - else - failure - }. diff --git a/web/CXM_xml_rpc_types.anubis b/web/CXM_xml_rpc_types.anubis deleted file mode 100644 index 6f2dd06..0000000 --- a/web/CXM_xml_rpc_types.anubis +++ /dev/null @@ -1,113 +0,0 @@ -/* - * Created by PyramIDE. - * User: Totoro - * Date: 06/07/2013 - * Time: 15:27 - */ - -transmit tools/basis.anubis - -public type XML_RPC_struct:... -public type XML_RPC_array:... - -public type XML_RPC_value: - int(Word32), - bool(Bool), - string(String), - double(Float), - datetime(String), - base64(String), - struct(XML_RPC_struct), - array(XML_RPC_array), - nil. - -public type XML_RPC_array: - array(List(XML_RPC_value)). - -public type XML_RPC_struct_member: - member(String name, XML_RPC_value value). - -public type XML_RPC_struct: - members(List(XML_RPC_struct_member)). - -public type XML_RPC_parameter: - parameter(List(XML_RPC_value)). - -public type XML_RPC_parameters: - parameters(List(XML_RPC_parameter)). - -public type XML_RPC_response: - ok(XML_RPC_parameters params), - fault(XML_RPC_value fault). - -public define XML_RPC_value -/* convert a list of String to XML_RPC_array -*/ - to_XML_RPC_array - ( - List(String) l_strings - )= - array(array(map((String _str) |-> string(_str), l_strings))). - - -public define Maybe(XML_RPC_parameter) - get_first_parameter - ( - XML_RPC_parameters params - )= - since params is parameters(param_list), - if param_list is - { - [] then failure, - [h . t] then success(h) - }. - -public define Maybe(XML_RPC_struct) - get_first_struct - ( - List(XML_RPC_parameter) params - )= - if params is - { - [] then failure, - [h . t] then - since h is parameter(values), - if values is - { - [] then get_first_struct(t), - [val . _ ] then - if val is struct(content) then - success(content) - else - get_first_struct(t) - } - }. - -public define Maybe(XML_RPC_value) - get_member - ( - List(XML_RPC_struct_member) struct, - String member_name - )= - if struct is - { - [] then failure, - [h . t] then - since h is member(name, value), - if name = member_name then - success(value) - else - get_member(t, member_name) - }. - -public define XML_RPC_struct - struct_add_member - ( - XML_RPC_struct rpc_struc, - String name, - XML_RPC_value value - )= - since rpc_struc is members(members_list), - members([member(name, value) . members_list]) - . - diff --git a/web/XL_web_stepper.anubis b/web/XL_web_stepper.anubis deleted file mode 100644 index 7b4fde5..0000000 --- a/web/XL_web_stepper.anubis +++ /dev/null @@ -1,339 +0,0 @@ -/* - * Created by PyramIDE. - * User: フランスのトトロ aka (David RENÉ) - * Date: 24/04/2020 - * Time: 15:12 - * © David RENÉ - */ - -transmit xlib/web/CXM_jquery.anubis -transmit xlib/web/types/XL_web_stepper.anubis -transmit xlib/web/controllers_web_site.anubis -read xlib/web/CXM_page_message.anubis -read xlib/web/jQuery/CXM_jquery_button.anubis -read xlib/web_controllers/language/language_management.anubis -read xlib/web/widgets/icons_set.anubis - -public define Maybe(WEB_Stepper) - get_stepper_by_uid - ( - String _uid, - List(WEB_Stepper) steppers - )= - if steppers is - { - [] then - println("get_stepper_by_uid: stepper uid ["+_uid+"] not found"); - failure, - [h . t] then - if h.uid = _uid then - println("get_stepper_by_uid: stepper uid ["+_uid+"] FOUND"); - success(h) - else - get_stepper_by_uid(_uid, t) - } -. - -public define Maybe(WEB_Stepper) - get_stepper - ( - List(Web_arg) _lwa, - List(WEB_Stepper) steppers - )= - if get_String(_lwa, "stepper_uid") is - { - failure then - println("get_stepper: stepper_uid not found"); - failure - success(stepper_uid) then get_stepper_by_uid(stepper_uid, steppers) - } -. - -public define Maybe(WEB_Step) - get_current_step - ( - List(WEB_Step) steps, - String current_step - )= - if steps is - { - [] then - println("get_current_step ["+current_step+"] not found"); - failure, - [h . t] then - if h.name = current_step then - success(h) - else - if get_current_step(h.childs, current_step) is - { - failure then get_current_step(t, current_step), - success(step) then success(step) - } - } -. - -public define Maybe(WEB_Step) - get_step - ( - List(Web_arg) _lwa, - List(WEB_Step) steps, - )= - if get_String(_lwa, "step") is - { - failure then failure - success(step) then get_current_step(steps, step) - } -. - -public define HTML_Partial_Content - web_stepper_button - ( - WEB_Step _step, - WEB_Step_Session stp_session, - (String)->String _T - )= - partial_content( - div(class("stepper_buttons"), - _step.buttons(stp_session, _T))) -. - -public define HTML_Partial_Content - web_stepper_main_view - ( - WEB_Step _step, - WEB_Step_Session stp_session, - (String)->String _T - )= - partial_content( - div(class("stepper_main_view"), - _step.view(stp_session, _T))) -. - -public define HTML_Partial_Content - web_stepper_message - ( - WEB_Step_Session stp_session, - (String)->String _T - )= - with page_msg = get_Page_Message(stp_session.session.fields, _T), - //if there is no message return empty to avoid to have an empty div with padding - if page_msg = no_message then - partial_empty - else - partial_content( - div(class("stepper_message"), - show_page_message(page_msg))) -. - -public define HTML_Partial_Content - web_stepper_full_description - ( - WEB_Step current_step, - (String)->String _T - )= - if current_step.full_description = "" then - partial_content(empty) - else - partial_content( - div(class("stepper_full_description"), - text(_T(current_step.full_description)))) -. - -public define Bool - is_current - ( - WEB_Step step, - WEB_Step current_step - )= - current_step.name = step.name -. - -public define Bool - is_active - ( - WEB_Step step, - WEB_Step current_step - )= - step.index < current_step.index -. - -public define HTML_Partial_Content - web_stepper_crumble - ( - WEB_Stepper _stepper, - WEB_Step _current_step, - (String) -> String _T - )= - partial_content( - div(class("stepper_crumble"), - div(class("multi-step"), - ul(class("multi-step-list"), - - map((WEB_Step step) |-> - with active = if is_active(step, _current_step) then " active" else "", - current = if is_current(step, _current_step) then " current" else "", - with go = if is_active(step, _current_step) then - with url = format_web_action_name_to_js(_stepper.web_controller, [("stepper_uid",_stepper.uid), ("step",step.name), ("step_a", "go")]), - event(onclick, "stepper_go("+url+");") - else - empty, - - li([class("multi-step-item"+active+current), - go], - div(class("item-wrap"), - p(class("item-title"), - text(_T(to_upper(step.name))) - ) - ) - ) - , - _stepper.steps - ) - - ) - ) - ) - ) -. - -public define HTML_Partial_Content - web_stepper_view - ( - WEB_Stepper _stepper, - WEB_Step _current_step, - WEB_Step_Session stp_session, - (String)->String _T - )= - println("web_stepper_view _current_step.name ["+_current_step.name+"]"); - - partial_content([ - css(css_file("xlib/css/stepper.css")), - js(js_file("xlib/js/stepper.js")), - js_inline(jquery_ready("$('#stepper_form').on('submit', function(e) { e.stopPropagation(); return false; });")) - ], [ - div([id("stepper"), class("stepper")], [ - form([id("stepper_form")],[ - hidden("step", _current_step.name), //add current step name as hidden argument - hidden("stepper_uid",_stepper.uid), //add stepper_uid as hidden argument - //construct bread crumb line - partial(web_stepper_crumble(_stepper, _current_step, _T)), - partial(web_stepper_full_description(_current_step, _T)), - partial(web_stepper_message(stp_session, _T)), - partial(web_stepper_main_view(_current_step, stp_session, _T)), //OK - partial(web_stepper_button(_current_step, stp_session, _T)) - ]) - ]) - ]) - -. - -public define HTML_Partial_Content - web_stepper_view - ( - WEB_Stepper stepper, - WEB_Step_Session stp_session, - (String)->String _T - )= - println("web_stepper_view without step. stp_session.current_step ["+stp_session.current_step+"]"); - if get_current_step(stepper.steps, stp_session.current_step) is - { - failure then partial_content(empty) - success(_current_step) then web_stepper_view(stepper, _current_step, stp_session, _T) - } -. - -public define WEB_Controller_Result - manage_stepper_action - ( - List(Web_arg) _lwa, - WEB_Session _web_session, - WEB_Stepper _stepper, - WEB_Step _step - )= - with stepper_session = web_step_session(_step.name, get_Session(_web_session.fields, _stepper.uid, session(_stepper.uid, empty_fields_list))), - _T = make_translate_function(_web_session), - println("manage_stepper_action step_session\n"+dump_Session_Field_list(*stepper_session.session.fields,"")); - - with action = get_String(_lwa, "step_a", "N/A"), - println("manage_stepper_action ["+action+"]"); - if action = "submit" then - println("manage_stepper_action submit step["+_step.name+"]"); - with new_session = _step.submit(stepper_session, _web_session), - //TODO must store new session in WEB session - println("store new_session\n"+dump_Session(new_session.session,"")); - replace_Session(_web_session.fields, _stepper.uid, new_session.session); - ajax(_web_session, web_stepper_view(_stepper, new_session, _T)) - -// ajax(_session, no_content) - else if action = "go" then - set_Page_Message(stepper_session.session.fields, no_message); - replace_Session(_web_session.fields, _stepper.uid, stepper_session.session); - ajax(_web_session, web_stepper_view(_stepper, stepper_session, _T)) - else if action = "init" then - ajax(_web_session, no_content) - else - ajax(_web_session, no_content) -. - -public define WEB_Controller_Result - manage_stepper - ( - WEB_Session _web_session, - List(WEB_Stepper) _steppers - )= - with _lwa = *_web_session.web_request.lwa, - println("manage_stepper"); - if get_stepper(_lwa, _steppers) is - { - failure then - println("stepper not found"); - ajax(_web_session, no_content), - success(stepper) then - //get session of the stepper - if get_String(_lwa, "step") is - { - failure then - println("manage_stepper step not found "); - ajax(_web_session, no_content) - success(step_name) then - println("manage_stepper step_name = "+step_name); - if step_name = "start" then - with _T = make_translate_function(_web_session), - with initial_step_session = stepper.start(_web_session), - println("store initial_step_session\n"+dump_Session(initial_step_session.session,"")); - replace_Session(_web_session.fields, stepper.uid, initial_step_session.session); - ajax(_web_session, web_stepper_view(stepper, initial_step_session, _T)) - else - - if get_current_step(stepper.steps, step_name) is - { - failure then ajax(_web_session, no_content), - success(step) then - manage_stepper_action(_lwa, _web_session, stepper, step) - } - } - - } -. - -public define HTML_Partial_Content - stepper_submit_button - ( - String label, - WEB_Action_Name wan, - String submit_action, - List((String, String)) extra_args - )= - with url = format_web_action_name_to_js(wan,[("step_a", "submit"), ("submit_a",submit_action) . extra_args]), - jquery_button(jquery_img_button(icn16_check, label, "", jQuery_actioner(same, jqscript("stepper_submit("+url+");")), left)) -. - -public define HTML_Partial_Content - stepper_submit_button - ( - String label, - WEB_Action_Name wan, - String submit_action, - )= - stepper_submit_button(label, wan, submit_action, []) -. diff --git a/web/common.anubis b/web/common.anubis index e6faa50..cbc9bc5 100644 --- a/web/common.anubis +++ b/web/common.anubis @@ -231,7 +231,7 @@ public type Redirections: Now, you may also want to recover web argument values which have been encoded (by 'web_arg_encode'). In this case, use the following: -read CXM_web_arg_encode.anubis +read web_arg_encode.anubis public define Maybe($T) diff --git a/web/controllers_web_site.anubis b/web/controllers_web_site.anubis index 542da26..06ec207 100644 --- a/web/controllers_web_site.anubis +++ b/web/controllers_web_site.anubis @@ -151,7 +151,7 @@ define HTTP_Answer // content of page sequence([ - preformated([size(14)],"Anubis Web Server - Standard Lib v1.14.0.0 - Anubis language v1.14"), + preformated([size(14)],"Anubis Web Server - Standard Lib v1.19.0.0 - Anubis language v1.19"), preformated([size(12)],"Error "+to_String(http_status)), preformated([size(12)],"Internal message :"+message), br, diff --git a/web/dojo.anubis b/web/dojo.anubis new file mode 100644 index 0000000..b0826f4 --- /dev/null +++ b/web/dojo.anubis @@ -0,0 +1,828 @@ +/* + * Created by PyramIDE. + * User: Steve Marechal + * Date: 11/06/2008 + * Time: 09:54 + * + */ + +read tools/basis.anubis +read tools/base64.anubis +read locale/L3LanguageInfo.anubis +read system/string.anubis +read system/logger.anubis + +read xlib/web/common.anubis +read xlib/web/making_a_web_site.anubis +read xlib/web/multihost_http_server.anubis + read xlib/net_services_protocols/logger_service.anubis + +public type Dojo_Grid_Data : + grid_data(String). + +public type Position_Direction: + brup, + brleft, + blup, + blright, + trdown, + trleft, + tldown, + tlright. + +define String + pos_dir_to_str + ( + Position_Direction pos + )= + if pos is + { + brup then "br-up", + brleft then "br-left", + blup then "bl-up", + blright then "bl-right", + trdown then "tr-down", + trleft then "tr-left", + tldown then "tl-down", + tlright then "tl-right" + }. + + + +public define HTML_Off_Form + dojo_button + ( + String name, + String execute, + String id, + ) + = + literal(" + ") +. + +public type Dojo_Input_Type: + file, + text, + password. + +public type InputDial: + input_dial(HTML_Id id, Dojo_Input_Type input_type, String label, Maybe(String) class), + input_date(HTML_Id id, String label), + input_combo(HTML_Id id, String label, List((List(CoreAttrs), WebArgValue, String)) list_data), + input_check(HTML_Id id, String label, Bool checked), + input_hidden(HTML_Id id, WebArgValue value). + + +define List(HTML_Off_Form) + format_list_data + ( + List((List(CoreAttrs), WebArgValue, String)) list_data, + List(HTML_Off_Form) result_list + )= + if list_data is + { + [] then result_list, + [h . t] then + if h is (_, wa, label) then + format_list_data(t, [literal("") . result_list]) + }. + +public define HTML_Off_Form + dojo_combobox + ( + WebArgName the_name, + HTML_Id the_id, + String label, + List((List(CoreAttrs), WebArgValue, String)) list_data, + )= + sequence([ + literal(" + ") + ]). + +define HTML_Off_Form + _maybe_label + ( + String label_text, + HTML_Id html_id + ) = + if length(label_text) > 0 then literal("") + else literal(""). + +public define HTML_Off_Form + dojo_checkbox + ( + WebArgName the_name, + HTML_Id the_id, + String label, + WebArgValue val, + Bool checked, + )= + sequence([ + _maybe_label(label, the_id), + literal(""), + ]). + + +define HTML_Off_Form + input_in_dialog + ( + InputDial input_data + )= + if input_data is + { + input_dial(html_id, input, label, class) then + sequence([ + literal("
"), + literal("
") + ]), + + input_date(html_id, label) then + sequence([ + literal("
"), + literal("
+
" + ) + ]), + + input_combo(the_id, label, list_data) then + sequence([ + literal("
"), + dojo_combobox(wan(the_id.id), the_id, label, list_data), + literal("
") + ]), + + input_check(the_id, label, checked) then + sequence([ + literal("
"), + dojo_checkbox(wan(the_id.id), the_id, label, wav("1"), checked), + literal("
"), + ]), + + input_hidden(the_id, val) then + literal(""), + } +. + +define List(HTML_Off_Form) + inputs_in_dialog + ( + List(InputDial) inputs_data + )= + if inputs_data is + { + [] then [], + [h . t] then [input_in_dialog(h) . inputs_in_dialog(t)] + }. + +public define HTML_Off_Form + dijit_dialog + ( + String name, + String dialog_id, + String execute, + String ok_label, + Maybe(String) cancel, + List(InputDial) inputs_data, + Maybe(String) do_cancel + ) + = + sequence([ + div([attr("dojoType", "dijit.Dialog"), id(dialog_id), title(name), attr("execute", execute)], + sequence([ + sequence(inputs_in_dialog(inputs_data)), + literal("" + + if cancel is + { + failure then "", + success(cancel_label) then "" + }), + br, + ]) + ) + ]) +. + +public define HTML_Off_Form + dojo_dialog + ( + String name, + String dialog_id, + String execute, + String ok_label, + Maybe(String) cancel, + List(InputDial) inputs_data, + Maybe(String) do_cancel + ) + = + sequence[ + dojo_button(name,"dijit.byId('"+dialog_id+"').show()", dialog_id + "_button"), + dijit_dialog(name, dialog_id, execute, ok_label, cancel, inputs_data, do_cancel) + ] +. + + + + +public type DojoGridEditor: + inputEditor, + boolEditor, + selectEditor(List(String) options), + alwaysOnEditor. + +public type DojoGridDefaultColumn: + dojo_grid_default_column( + String styles, + Maybe(String) width, + Maybe(DojoGridEditor) editor). + +public type DojoGridColumn: + dojo_grid_column( String label, + String field_name, + Maybe(String) width, + Maybe(DojoGridEditor) editor). + +public type DojoGridView: + dojo_grid_view( + Maybe(DojoGridDefaultColumn) default_column, + List(DojoGridColumn) columns). + +public type DojoGridLayout: + dojo_grid_layout( + Maybe(String) selectable_row_header_width, + List(DojoGridView) views). + +define String to_String(DojoGridEditor editor) = + "editor: " + + if editor is + { + inputEditor then "dojox.grid.editors.Input", + boolEditor then "dojox.grid.editors.Bool", + selectEditor(options) then "dojox.grid.editors.Select, options: [" + join(",", map((String o) |-> "\"" + o + "\"", options)) + "]", + alwaysOnEditor then "dojox.grid.editors.AlwaysOn" + }. + +define String to_String(DojoGridView view) = + "{ " + (if view.default_column is success(col) then + (if col is dojo_grid_default_column(styles, mb_width, mb_editor) then + "defaultCell: {" + + "styles: \"" + styles + "\"" + + (if mb_width is success(w) then ", width=\"" + w + "\"" else "") + + (if mb_editor is success(e) then ", " + to_String(e) else "") + + "}, ") + else "") + + "cells: [[" + join(",", map((DojoGridColumn col) |-> + if col is dojo_grid_column(label, field, mb_width, mb_editor) then + "{" + + "name: \"" + label + "\"" + + "field: \"" + field + "\"" + + (if mb_width is success(w) then ", width=\"" + w + "\"" else "") + + (if mb_editor is success(e) then ", " + to_String(e) else "") + + "}", + view.columns)) + "]]" + +"}". + + +public define String + dojo_make_grid_script + ( + HTML_Id html_id, + DojoGridLayout layout, + String layout_name, + String store_name, + Bool can_edit + ) + = +"". + +public define HTML_Off_Form + dojo_make_grid_script + ( + HTML_Id html_id, + List(String) columns, + Bool can_edit + ) + = + literal( +""). + +public define HTML_Off_Form + dojo_grid + ( + HTML_Id html_id, + Int rowsPerPage, + List(Table_Option) attributes, + )= + table([attr("dojoType", "dojox.grid.DataGrid"), attr("id", html_id.id), attr("jsId", html_id.id), + class("soria"), attr("singleClickEdit", "true"), attr("rowsPerPage", to_decimal(rowsPerPage)) . attributes], + empty, [], empty). + + +public define HTML_Off_Form + dojo_grid + ( + HTML_Id html_id, + List(CoreAttrs) attributes, +// List(GridColumn) columns, + String colum1, + String colum2, + String colum3, + String colum4, + Bool can_edit + ) + = + sequence([ + literal( + +""), + div([id(html_id.id) . attributes /*attr("dojoType", "dojox.Grid"), */]), + ]). +//
"). + + +public define HTML_Off_Form + dojo_message_box + ( + HTML_Off_Form name1, + HTML_Off_Form name2, + )= + sequence([ + br, + div([class("message_box")], [ + div([id("node3"), class("box nopad hidden")], name1), + div([id("node4"), class("box two nopad")], name2), + ]), + br, + ]). + + + +public define HTML_Off_Form + dojo_tooltip + ( + String title, + String keyword, + ) = + actioner(same,same, link([id("dojo_tip_" + keyword),class("dojoToolTip")],title, success(title)), "show_address_mailing", [("address_mailing", keyword)], []). + //actioner(same, same, push_button([id("dojo_tip_" + keyword), class("in"), event(onclick,"new_search(this)")], keyword), "", [], []). + + +public type BorderContainerRegion: + center, + top, + bottom, + leading, + trailing, + left, + right. + +define String + to_String + ( + BorderContainerRegion region + )= + if region is + { + center then "center", + top then "top", + bottom then "bottom", + leading then "leading", + trailing then "trailing", + left then "left", + right then "right" + }. + +public type BorderContainerDesign: + headline, + sidebar. + +define String + to_String + ( + BorderContainerDesign design + )= + if design is + { + headline then "headline", + sidebar then "sidebar" + }. + + +public define HTML_Off_Form + dojo_ContentPane + ( + List(CoreAttrs) attributes, + BorderContainerRegion region, + Bool splitter, + HTML_Off_Form content + ) = + div([ attr("dojoType", "dijit.layout.ContentPane"), + attr("region", to_String(region)), + attr("splitter", if splitter then "true" else "false") . attributes ], + content). + +public define HTML_In_Form + dojo_ContentPane + ( + List(CoreAttrs) attributes, + BorderContainerRegion region, + Bool splitter, + HTML_In_Form content + ) = + div([ attr("dojoType", "dijit.layout.ContentPane"), + attr("region", to_String(region)), + attr("splitter", if splitter then "true" else "false") . attributes ], + content). + +public define HTML_Off_Form + dojo_TabContainer + ( + List(CoreAttrs) attributes, + HTML_Off_Form content + ) = + div([attr("dojoType", "dijit.layout.TabContainer") . attributes ], + content). + + +public define HTML_Off_Form + dojo_BorderContainer + ( + List(CoreAttrs) attributes, + Maybe(String) the_title, + BorderContainerDesign design, + Bool live_splitter, + Bool persist, + Bool closable, + String container, + HTML_Off_Form content + ) = + with the_attributes = (List(CoreAttrs)) [attr("dojoType", "dijit.layout.BorderContainer"), attr("dojoAttachPoint", container), + attr("design", to_String(design)), attr("liveSplitters", live_splitter), attr("persist", persist), + attr("closable",closable) . attributes ], + total_attributes = if the_title is + { + failure then the_attributes, + success(t) then [title(t) . the_attributes] + }, + div(total_attributes, content). + +public define HTML_In_Form + dojo_BorderContainer + ( + List(CoreAttrs) attributes, + Maybe(String) the_title, + BorderContainerDesign design, + Bool live_splitter, + Bool persist, + Bool closable, + String container, + HTML_In_Form content + ) = + with the_attributes = (List(CoreAttrs)) [attr("dojoType", "dijit.layout.BorderContainer"), attr("dojoAttachPoint", container), + attr("design", to_String(design)), attr("liveSplitters", live_splitter), attr("persist", persist), + attr("closable",closable) . attributes ], + total_attributes = if the_title is + { + failure then the_attributes, + success(t) then [title(t) . the_attributes] + }, + div(total_attributes, content). + +public define HTML_Off_Form + dojo_tree + ( + List(CoreAttrs) attributes, + )= + div(attributes). + + + +public define HTML_Off_Form + dojo_Toolbar + ( + List(CoreAttrs) attributes, + HTML_Off_Form content + )= + div([attr("dojoType", "dijit.Toolbar") . attributes ], + content). + + +public define HTML_Off_Form + dojo_tooltip + ( + List(CoreAttrs) attributes, +// List(Text_Option) txt_attr, + HTML_Id html_id, + String label, + HTML_Off_Form tooltip_content, + )= + sequence([ + text([id(html_id.id)], label), + div([id(html_id.id + "_tt"), attr("connectId", html_id.id), attr("dojoType", "dijit.Tooltip") . attributes], tooltip_content) + ]). + + +public define HTML_Off_Form + dojo_button + ( + HTML_Id html_id, +// Maybe(String) class, + String name, + String iconclass, + Maybe(String) tip_msg, + String execute, + )= + literal(" + " + + if tip_msg is + { + failure then "", + success(tip) then + "" + tip + "" + }). + +public define HTML_In_Form + dojo_button + ( + HTML_Id html_id, +// Maybe(String) class, + String name, + String iconclass, + Maybe(String) tip_msg, + String execute, + )= + literal(" + " + + if tip_msg is + { + failure then "", + success(tip) then + "" + tip + "" + }). + + +public define HTML_Off_Form + dojo_declaration + ( + String name, + List(CoreAttrs) attributes, + HTML_Off_Form content + )= + div([attr("dojoType", "dijit.Declaration"), attr("widgetClass", name) . attributes ], + content). + + +public define HTML_In_Form + dojo_declaration + ( + String name, + List(CoreAttrs) attributes, + HTML_In_Form content + )= + div([attr("dojoType", "dijit.Declaration"), attr("widgetClass", name) . attributes ], + content). + +public define HTML_Off_Form + dojo_editor + ( + List(CoreAttrs) attributes, + HTML_Id html_id, + WebArgName input_name, + HTML_Off_Form text, + )= + div([id(html_id.id), attr("name", input_name.name), attr("dojoType", "dijit.Editor") + ,attr("extraPlugins", "['|', 'foreColor','hiliteColor',{name:'dojox.editor.plugins.FontChoice', command:'fontName', generic:true},'fontSize','formatBlock','|','createLink','insertImage']") + . attributes], text). + + public define HTML_In_Form + dojo_button + ( + HTML_Id html_id, + String name, + String iconclass, + Maybe(String) tip_msg, + String execute, + )= + literal(" + " + + if tip_msg is + { + failure then "", + success(tip) then + "" + tip + "" + }). + +public define HTML_In_Form + dojo_checkbox + ( + List(CoreAttrs) attributes, + WebArgName name, + HTML_Id id, + String label_str, + Bool checked, + )= + check_box_r([attr("dojoType", "dijit.form.CheckBox") . attributes] , label(label_str, no_help), id, name, checked). + +public define HTML_In_Form + dojo_combobox + ( + List(CoreAttrs) attributes, + WebArgName name, + HTML_Id id, + String label_str, + List((List(CoreAttrs),WebArgValue,String)) list_data, + InitialValue selected, + )= + // selector_c([attr("dojoType", "dijit.form.ComboBox") . attributes], label, id, name, 1, list_data, selected, non_mandatory). + selector_c([attr("dojoType", "dijit.form.ComboBox") . attributes], label(label_str, no_help), id, name, 1, list_data, selected). + +public define HTML_Off_Form + dojo_toaster + ( + List(CoreAttrs) attributes, + HTML_Id html_id, + String message_topic, + Position_Direction position_direction, + Bool separator, + Maybe(Int) duration + )= + div(append(append(if separator then [attr("separator","<hr>")] + else [], + if duration is + { + failure then [], + success(dur) then [attr("duration", abs_to_decimal(dur))] + }), + [attr("dojoType", "dojox.widget.Toaster"), attr("messageTopic", message_topic), + attr("positionDirection", pos_dir_to_str(position_direction)), id(html_id.id) + . attributes ]), + literal("")). + +public define HTML_Off_Form + dojo_progressBar + ( + List(CoreAttrs) attributes, +// List(Text_Option) attributes_text, + HTML_Id html_id, + String label + )= + sequence([ + text([id("text_" + html_id.id), class("progress_bar")], label), + div([id(html_id.id), class("progress_bar"), attr("indeterminate", "true"), attr("dojoType", "dijit.ProgressBar") . attributes], literal("")) + ]). + +public define HTML_Off_Form + dojo_progressBar + ( + List(CoreAttrs) attributes, +// List(Text_Option) attributes_text, + HTML_Id html_id, + String label, + Int progress, + Int maximum + )= + sequence([ + text([id("text_" + html_id.id), class("progress_bar")], label), + div([id(html_id.id), + class("progress_bar"), + attr("maximum", abs_to_decimal(maximum)), + attr("progress", abs_to_decimal(progress)), + attr("dojoType", "dijit.ProgressBar") . attributes]) + ]). + +define Maybe(Int) + string_to_month + ( + String month_s + )= + with month = to_lower(month_s), + if month = "jan" then success(1) + else if month = "feb" then success(2) + else if month = "mar" then success(3) + else if month = "apr" then success(4) + else if month = "may" then success(5) + else if month = "jun" then success(6) + else if month = "jul" then success(7) + else if month = "aug" then success(8) + else if month = "sep" then success(9) + else if month = "oct" then success(10) + else if month = "nov" then success(11) + else if month = "dec" then success(12) + else failure + . + + +// 'Thu Jan 14 2010 00:00:00 GMT+0100' must be replaced by '2010-01-14 00:00:00' + + + +public define Maybe(String) + dojo_date_to_db_datetime + ( + String data + )= + with list_data = split_by_token(data, ' '), + if nth(2, list_data) is + { + failure then failure, + success(day) then + if nth(1, list_data) is + { + failure then failure, + success(month) then + if nth(3, list_data) is + { + failure then failure, + success(year) then + if nth(4, list_data) is + { + failure then failure, + success(hour) then + if string_to_month(month) is + { + failure then failure, + success(month_int) then + success(year+"-"+month_int+"-"+day+" "+hour) + } + } + } + } + }. + +public define List(HTML_Head_Tag) + dojo_defaults + = + [ + // js(js_file("js/dojo/dojo.js", [attr("djConfig", "parseOnLoad: true, isDebug: " + (if debug_mode then "true" else "false") + ", usePlainJson: true")])), + js(js_file("js/dojo/dojo/dojo.js", [attr("djConfig", "parseOnLoad: true, isDebug: false, usePlainJson: true")])), + js(js_file("js/dojo/dijit/dijit.js")), + //css(css_file("js/dojo/dojo/resources/dojo.css")) + ]. + + +public define List(HTML_Head_Tag) + dojo_init + ( + String web_dir, + String theme_name + ) + = + with _theme_name = if file_exists(web_dir+"/public/js/dojo/dijit/themes/"+theme_name+"/"+theme_name+".css")then theme_name else "claro", + [ css(css_file("js/dojo/dijit/themes/"+_theme_name+"/"+_theme_name+".css")) . + [ css(css_file("js/dojo/dijit/themes/"+_theme_name+"/"+_theme_name+"_rtl.css")) . dojo_defaults ] + ] + . diff --git a/web/dropzone.anubis b/web/dropzone.anubis new file mode 100644 index 0000000..e937422 --- /dev/null +++ b/web/dropzone.anubis @@ -0,0 +1,59 @@ + Make use of the DropzoneJS library (www.dropzonejs.com) to build highly customizable dropzones that provides drag’n’drop file uploads with image previews + + TODO: + Complete dropzone options and features binding + + Authors: Julien Verneuil (06/04/2016) + David René (2017/08/12) + +read tools/basis.anubis +read system/string.anubis +read xlib/web/making_a_web_site.anubis +read xlib/web/jquery.anubis + +public define HTML_Partial_Content + dropzone + ( + String dropzone_form_name, + String dict_default_message, + String dict_file_too_big, + String param_name, + String init, + WEB_Action_Name submit_action, + List((String,String)) extra_ops, + ) = + with dropzone_form_id = to_lower(dropzone_form_name+"_"+generate_random_string(15)), + partial_content( + [ js(js_file("xlib/js/dropzone.js")), + css(css_file("xlib/css/dropzone.css")), + js_script(" + Dropzone.options." + to_Camel_case(dropzone_form_id) + " = { + dictDefaultMessage : \"" + dict_default_message + "\", + dictFileTooBig : \"" + dict_file_too_big + "\", + timeout : 864000, + paramName : \"" + param_name + + ( if init = "" then + "\"" + else + "\", + init: "+init + )+" + }; + $('#"+dropzone_form_id+"').dropzone(); " + ) + ], + form(dropzone_form_id, [class("dropzone")], submit_action, extra_ops, empty) + ) +. + +public define HTML_Partial_Content + dropzone + ( + String dropzone_form_name, + String dict_default_message, + String dict_file_too_big, + String param_name, + WEB_Action_Name submit_action + )= + dropzone(dropzone_form_name, dict_default_message, dict_file_too_big, param_name, "", submit_action, []) +. diff --git a/web/fonts/awesome.anubis b/web/fonts/awesome.anubis index 8c368e9..658a381 100644 --- a/web/fonts/awesome.anubis +++ b/web/fonts/awesome.anubis @@ -6,7 +6,7 @@ * © David RENÉ */ -read xlib/web/CXM_making_a_web_site.anubis +read xlib/web/making_a_web_site.anubis public type Font_Awesome: awesome( diff --git a/web/generic_form.anubis b/web/generic_form.anubis new file mode 100644 index 0000000..853fb66 --- /dev/null +++ b/web/generic_form.anubis @@ -0,0 +1,471 @@ + + + + *Project* The Anubis Project + + *Title* + + *Copyright* Copyright (c) Alain Prouté 2005. + + + *Author* Alain Prouté + + + + In this file we rationalize the construction of forms. + + + +read CXM_making_a_web_site.anubis +read tools/basis.anubis + + +public type Mandatory: // used to mark fields as mandatory. + mandatory, + non_mandatory. + +public type Width: + small, + narrow, + wide, + custom(Int). + +public type FormFieldWidth: + auto, + custom(Int). + + + + Sorts of fields that you can put in a form: + +public type FormField: + + //--- title field --------------------------------------------------------------------- + title (String text), + title (Int text_size, + String text), + title_f (List(Text_Option) -> HTML_In_Form), + + //--- message field ------------------------------------------------------------------- + message (Result(String,String) msg), + message_f (Result(List(Text_Option) -> HTML_In_Form,List(Text_Option) -> HTML_In_Form)), + + //--- text input field ---------------------------------------------------------------- + input (WebArgName web_arg_name, + String tag, + Width width, + InitialValue init_value, + Mandatory mandatory), + input (WebArgName web_arg_name, + Width width, + InitialValue init_value), + input_f (WebArgName web_arg_name, + List(Text_Option) -> HTML_In_Form tag, + Width width, + InitialValue init_value, + Mandatory mandatory), + + //--- password input field ------------------------------------------------------------ + password_input (WebArgName web_arg_name, + String tag, + Mandatory mandatory), + password_input_f (WebArgName web_arg_name, + List(Text_Option) -> HTML_In_Form tag, + Mandatory mandatory), + + //--- explanation field --------------------------------------------------------------- + explain (String text), + explain (String text, + FormFieldWidth width), + explain_f (List(Text_Option) -> HTML_In_Form), + + //--- selector field ------------------------------------------------------------------ + selector (WebArgName web_arg_name, + String tag, + List(String) items, + Maybe(InitialValue) selected, + Mandatory mandatory), + selector_f (WebArgName web_arg_name, + List(Text_Option) -> HTML_In_Form, + List(String) items, + Maybe(InitialValue) selected, + Mandatory mandatory), + selector_c (WebArgName web_arg_name, + String tag, + List((List(CoreAttrs), WebArgValue, String)) items, + Maybe(InitialValue) selected, + Mandatory mandatory), + + + + //--- checkbox field ------------------------------------------------------------------ + checkbox (WebArgName web_arg_name, + String tag, + Bool checked, + Mandatory mandatory), + // the same one, but with the tag on the right of the checkbox + checkboxr (WebArgName web_arg_name, + String tag, + Bool checked, + Mandatory mandatory), + checkbox_f (WebArgName web_arg_name, + List(Text_Option) -> HTML_In_Form, + Bool checked, + Mandatory mandatory), + + //--- radio-button field -------------------------------------------------------------- + radio_button (WebArgName web_arg_name, + WebArgValue web_arg_value, + String tag, + Bool checked, + Mandatory mandatory), + // the same one, but with the tag on the right of the radio_button + radio_buttonr (WebArgName web_arg_name, + WebArgValue web_arg_value, + String tag, + Bool checked, + Mandatory mandatory), + + //--- text area field ----------------------------------------------------------------- + text_area (WebArgName web_arg_name, + InitialValue initial_text), + text_area (WebArgName web_arg_name, + String tag, + InitialValue initial_text), + text_area (WebArgName web_arg_name, + String tag, + InitialValue initial_text, + Int width, + Int height), + + //--- fields table -------------------------------------------------------------------- + fields_table (String tag, + List(FormField) fields), + + //--- fields line --------------------------------------------------------------------- + fields_line (String tag, + List(FormField) fields), + fields_line (List(FormField) fields), + + //--- preview field ------------------------------------------------------------------- + preview (String html_text), + + //--- submit button ------------------------------------------------------------------- + submit (String action_name, + Maybe(String) label, + String button_text, + List((String,String)) extra_operands). + + + Convenience functions: + +public define FormField title(List(Text_Option) -> HTML_In_Form f) = title_f(f). +public define FormField + message(Result(List(Text_Option) -> HTML_In_Form,List(Text_Option) -> HTML_In_Form) f) = message_f(f). +public define FormField input(WebArgName web_arg_name, + List(Text_Option) -> HTML_In_Form tag, + Width width, + InitialValue init_value, + Mandatory mandatory) + = input_f(web_arg_name,tag,width,init_value,mandatory). +public define FormField password_input(WebArgName web_arg_name, + List(Text_Option) -> HTML_In_Form tag, + Mandatory mandatory) + = password_input_f(web_arg_name,tag,mandatory). +public define FormField explain(List(Text_Option) -> HTML_In_Form f) = explain_f(f). +public define FormField selector(WebArgName web_arg_name, + List(Text_Option) -> HTML_In_Form f, + List(String) items, + Maybe(InitialValue) selected, + Mandatory mandatory) + = selector_f(web_arg_name,f,items,selected,mandatory). +public define FormField checkbox(WebArgName web_arg_name, + List(Text_Option) -> HTML_In_Form f, + Bool checked, + Mandatory mandatory) + = checkbox_f(web_arg_name,f,checked,mandatory). + + Make the form itself with: + +public define HTML_Off_Form + generic_form + ( + String form_name, + RGB background_color, + Int width, + List(FormField) fields + ). + + + + --- That's all for the public part ! -------------------------------------------------- + +// TO DO update code of CXM generic form +define HTML_Row(HTML_In_Form) + format_form_field + ( + FormField ff + ) = + with star = (Mandatory m) |-> (HTML_In_Form)text([color(rgb(255,0,0)),size(12)], + if m is + { + mandatory then "*", + non_mandatory then "" + }), + row( + if ff is + { + title(t) then (List(HTML_Cell(HTML_In_Form))) + [ + cell([columns(3),h_center],text([size(16),bold,color(rgb(0,0,0))],t)) + ], + + title(s,t) then (List(HTML_Cell(HTML_In_Form))) + [ + cell([columns(3),h_center],text([size(s),bold,color(rgb(0,0,0))],t)) + ], + + title_f(t) then (List(HTML_Cell(HTML_In_Form))) + [ + cell([columns(3),h_center],t([size(16),bold,color(rgb(0,0,0))])) + ], + + message(r) then (List(HTML_Cell(HTML_In_Form))) if r is + { + error(msg) then [cell([columns(3),h_center], + text([size(10),color(rgb(240,0,0))],msg))] + ok(msg) then [cell([columns(3),h_center], + text([size(10),color(rgb(0,150,0))],msg))] + }, + + message_f(r) then (List(HTML_Cell(HTML_In_Form))) if r is + { + error(msg) then [cell([columns(3),h_center], + msg([size(10),color(rgb(240,0,0))]))] + ok(msg) then [cell([columns(3),h_center], + msg([size(10),color(rgb(0,150,0))]))] + }, + + input(wan,tag,w,init,mand) then (List(HTML_Cell(HTML_In_Form))) + [ + cell([right ], text([size(10)],tag)), + cell([width(7) ], star(mand)), + cell([left ], text_input([], "",html_Id(""), wan, init,if w is + { + small then 10, + narrow then 50, + wide then 70, + custom(n) then n + })) + ], + + input(wan,w,init) then (List(HTML_Cell(HTML_In_Form))) + [ + cell([left,columns(3) ], text_input([], "", html_Id(""), wan,init,if w is + { + small then 10, + narrow then 30, + wide then 70, + custom(n) then n + })) + ], + + input_f(wan,tag,w,init,mand) then (List(HTML_Cell(HTML_In_Form))) + [ + cell([right ], tag([size(10)])), + cell([width(7) ], star(mand)), + cell([left ], text_input([], "", html_Id(""),wan,init,if w is + { + small then 15, + narrow then 30, + wide then 70, + custom(n) then n + })) + ], + + password_input(wan,tag,mand) then (List(HTML_Cell(HTML_In_Form))) + [ + cell([right ], text([size(10)],tag)), + cell([width(7) ], star(mand)), + cell([left ], password_input([], "",html_Id(""), wan, init(""), 30)) + ], + + password_input_f(wan,tag,mand) then (List(HTML_Cell(HTML_In_Form))) + [ + cell([right ], tag([size(10)])), + cell([width(7) ], star(mand)), + cell([left ], password_input([], "",html_Id(""), wan, init(""), 30)) + ], + + explain(t) then (List(HTML_Cell(HTML_In_Form))) + [ + cell([columns(3),h_center], + table([nude],[row(cell([width(500)], + paragraph([/*justified,*/size(10),color(rgb(0,100,0))],literal(t))))])) + ], + + explain(t,w) then (List(HTML_Cell(HTML_In_Form))) + [ + cell([columns(3),h_center], + table([nude],[row(cell( + if w is + { + auto then [], + custom(i) then [width(i)] + }, + paragraph([/*justified,*/size(10),color(rgb(0,100,0))], literal(t))))])) + ], + + explain_f(t) then (List(HTML_Cell(HTML_In_Form))) + [ + cell([columns(3),h_center], + table([nude],[row(cell([width(500)], + t([/*justified,*/size(10),color(rgb(0,100,0))])))])) + ], + + selector(wan,tag,items,selected,mand) then (List(HTML_Cell(HTML_In_Form))) + [ + cell([right ], text([size(10)],tag)), + cell([width(7)], star(mand)), + cell([left ], if selected is + { + failure then selector([], "", html_Id(""), wan,1,items) + success(sel) then selector([], "", html_Id(""), wan,1,items, sel) + }) + ], + + selector_f(wan,tag,items,selected,mand) then (List(HTML_Cell(HTML_In_Form))) + [ + cell([right ], tag([size(10)])), + cell([width(7)], star(mand)), + cell([left ], if selected is + { + failure then selector([], "", html_Id(""), wan,1,items) + success(sel) then selector([], "", html_Id(""), wan,1,items, sel) + }) + ], + + selector_c(wan,tag,items,selected,mand) then (List(HTML_Cell(HTML_In_Form))) + [ + cell([right ], text([size(10)],tag)), + cell([width(7)], star(mand)), + cell([left ], if selected is + { + failure then selector_c([], "", html_Id(""), wan,1,items) + success(sel) then selector_c([], "", html_Id(""), wan,1,items,sel) + }) + ], + + checkbox(wan,tag,checked,mand) then (List(HTML_Cell(HTML_In_Form))) + [ + cell([right ], text([size(10)],tag)), + cell([width(7)], star(mand)), + cell([left ], check_box([], "",html_Id(""),wan, wav(wan.name),checked)) + ], + + checkboxr(wan,tag,checked,mand) then (List(HTML_Cell(HTML_In_Form))) + [ + cell([right ], check_box([], "",html_Id(""),wan, wav(wan.name),checked)), + cell([width(7)], star(mand)), + cell([left ], text([size(10)],tag)) + ], + + checkbox_f(wan,tag,checked,mand) then (List(HTML_Cell(HTML_In_Form))) + [ + cell([right ], tag([size(10)])), + cell([width(7)], star(mand)), + cell([left ], check_box([], "",html_Id(""),wan,wav(wan.name),checked)) + ], + + radio_button(wan,wav,tag,checked,mand) then (List(HTML_Cell(HTML_In_Form))) + [ + cell([right ], text([size(10)],tag)), + cell([width(7)], star(mand)), + cell([left ], radio_button([], "", html_Id(""), wan, wav, checked)) + ], + + radio_buttonr(wan,wav,tag,checked,mand) then (List(HTML_Cell(HTML_In_Form))) + [ + cell([right ], radio_button([], "", html_Id(""), wan, wav, checked)), + cell([width(7)], star(mand)), + cell([left ], text([size(10)],tag)) + ], + + text_area(wan,tx) then (List(HTML_Cell(HTML_In_Form))) + [ + cell([h_center,columns(3)],text_area([wrap_lines],wan,tx,75,10)) + ], + + text_area(wan,tag,tx) then (List(HTML_Cell(HTML_In_Form))) + [ + cell([right,top], text([size(10)],tag)), + cell([width(7)], text([],"")), + cell([h_center],text_area([wrap_lines],wan,tx,75,10)) + ], + + text_area(wan,tag,tx,w,h) then (List(HTML_Cell(HTML_In_Form))) + [ + cell([right,top], text([size(10)],tag)), + cell([width(7)], text([],"")), + cell([h_center],text_area([wrap_lines],wan,tx,w,h)) + ], + + fields_table(tag,fields) then (List(HTML_Cell(HTML_In_Form))) + [ + cell([right,top], text([size(10)],tag)), + cell([width(7)], text([],"")), + cell([left,top], table([],map((FormField ff2) |-> format_form_field(ff2),fields))) + ], + + fields_line(tag,fields) then (List(HTML_Cell(HTML_In_Form))) + [ + cell([right,top], text([size(10)],tag)), + cell([width(7)], text([],"")), + cell([left,top], table([nude],[row([], //border(0,0,3,rgb(0,0,0)) + map((FormField ff2) |-> cell([top],table([nude],[format_form_field(ff2)])),fields))])) + ], + + fields_line(fields) then (List(HTML_Cell(HTML_In_Form))) + [ + cell([left,top,columns(3)], table([nude],[row([], + map((FormField ff2) |-> cell([top],table([nude],[format_form_field(ff2)])),fields))])) + ], + + preview(html_text) then (List(HTML_Cell(HTML_In_Form))) + [ + cell([top,left,columns(3),background_color(rgb(255,255,255))], + table([border(0,8,0,rgb(0,0,0))], + [row(cell([left,top,height(200)],literal(html_text)))])) + ], + + submit(action_name,mb_label,button_text,extra_operands) then (List(HTML_Cell(HTML_In_Form))) + [ + cell([columns(3),right],actioner(same, + if mb_label is + { + failure then same, + success(n) then same(n) + }, + submit([], button_text), + action_name, + extra_operands)) + ] + }). + + + +// TO DO update code of CXM generic form +public define HTML_Off_Form + generic_form + ( + String form_name, + RGB bg_color, + Int w, + List(FormField) fields + ) = + table([border(0,0,5,bg_color),percentage_width(100), + background_color(bg_color)],[row(cell([h_center], + form(form_name,[],table([border(0,2,0,bg_color)], + map(format_form_field, fields)))))]). + + diff --git a/web/generic_login.anubis b/web/generic_login.anubis new file mode 100644 index 0000000..f1db55d --- /dev/null +++ b/web/generic_login.anubis @@ -0,0 +1,116 @@ + + + + + Rationalisation de la gestion des logins et des mots de passe + +read CXM_common.anubis +read CXM_making_a_web_site.anubis +read CXM_generic_form.anubis + + + + + *** (1) Connection sur site scurise + + ou formulaire de saisie du login et du mot de passe + + + Le formulaire de saisie du login et du mot de passe pour se connecter un site https + se compose : + .1. d'un ventuel message pour alerter que la paire (login,passwd) est errone, + .2. du formulaire proprement dit pour lequel il faut donner : + - le titre du formulaire + - les textes figurant devant les 2 texts input + - le text du bouton submit + - le nom de l'action, + - la couleur de fond + + + +public define HTML_Off_Form + login_form + ( + String wrong_message, + RGB background_color, + String title_text, + String pseudo_text, + String passwd_text, + String submit_text, + String login_action + ). + + + + + *** (2) Vrification de la saisie + + +public define Maybe($User) + check_login_passwd + ( + String -> Maybe($User) check_pseudo, + $User -> ByteArray get_passwd, + List(Web_arg) lwa + ). + + + + --- That's all for the public part ! -------------------------------------------------- + + + + *** [1] Connection sur site scurise + +public define HTML_Off_Form + login_form + ( + String wrong_message, + RGB background_color, + String title_text, + String pseudo_text, + String passwd_text, + String submit_text, + String login_action + ) = + generic_form + ("login_form",background_color,700, + [ + title (title_text), + explain (wrong_message), + input ("pseudo",pseudo_text,narrow,"",mandatory), + password_input ("passwd",passwd_text,mandatory), + submit (login_action,failure,submit_text,[]) + ]). + + + + *** [2] Vrification de la saisie + +public define Maybe($User) + check_login_passwd + ( + String -> Maybe($User) check_pseudo, + $User -> ByteArray get_passwd, + List(Web_arg) lwa + ) = + if web_arg_value(lwa,"pseudo") is + { + not_found then failure, + found(ps) then + if web_arg_value(lwa,"passwd") is + { + not_found then failure, + found(pwd) then + if check_pseudo(ps) is + { + failure then failure, + success(user) then + if sha1(to_byte_array(pwd))=get_passwd(user) + then success(user) + else failure + } + }}. + + + diff --git a/web/generic_table.anubis b/web/generic_table.anubis new file mode 100644 index 0000000..23cfcd6 --- /dev/null +++ b/web/generic_table.anubis @@ -0,0 +1,786 @@ + + *Project* The Anubis Project + + *Title* Generic table page. + + *Copyright* Copyright (c) Alain Prouté 2004. + + + *Author* Alain Prouté + *Author* Olivier Duvernois + + + + ---------------------------------------------------------------------------------------- + + + + +read tools/basis.anubis +read CXM_common.anubis +read CXM_making_a_web_site.anubis + + + The purpose is to print on a html browser a table from a List($Data) using the function + 'generic_table()' describe below. + + Note : the explanations are only given for HTML_Item and its components. But they are + also available for HTML_Form and HTML_Element and their components. + + + A table may have the following look : + + +-----+----------+--------+-----------------------+ ............... + | | | | name 3 | + | num | name1 | name2 |-----------+-----------+ columns_name + | | | | name 31 | name 32 | + +-----+----------+--------+-----------+-----------+ ............... + | 1 | data11 | data12 | data131 | data132 | line 1 with background color a + +-----+----------+--------+-----------+-----------+ ............... + | 2 | data21 | data22 | data231 | data232 | line 2 with background color b + +-----+----------+--------+-----------+-----------+ ............... + | 3 | data31 | data32 | data331 | data332 | line 3 with background color a + +-----+----------+--------+-----------+-----------+ ............... + + | n | datan1 | datan2 | datan31 | datan32 | line n with background color ? + +-----+----------+--------+-----------+-----------+ ............... + |total| total1 | | | total32 | total line + +-----+----------+--------+-----------+-----------+ ............... + + For the total-line, assuming that datax1 to dataxn and datax32 to datan32 are numbers + (Int, Float or Maybe(Float)). + + + The columns name are just a List(Item_Row). + + The column 'num' is in the case you want to enumerate your data. The existence of this + column depends on the line function. + + Lines are given by the function : (RGB color,Int num,$Data d) -> Item_Row + + where : - (RGB)color is the color of the background of the row (the 'a color' or 'b + color'); + - (Int)num the number of the data (to enumerate). + + So, this function must be written something like : + + (RGB color, Int num,$Data d) |-> + row([background_color(color)], // and of course possibly other row-options + [ + cell([], (Int -> $HTML)(num) ) + . ($Data -> List(Cell))d // how data is printed in cells + ]). + + But, for the above convenient function with no enumeration, you can only write : + + (RGB color, $Data d) |-> + row([background_color(color)], // and of course possibly other row-options + ($Data -> List(Cell))d // how data is printed in cells + ). + + + If you want to sum by column your data, use the following type : + +public type Total_Line($Data,$Upplet,$Row): + no_total, + total + ( + ($Upplet,$Data) -> $Upplet sum_functions, + $Upplet -> $Row print_total_line, + $Upplet initial_value + ). + + $Row is for HTML_Row($HTML). + $Upplet represents the components of $Data that will be sum. + + Example : + with the above sheme table, $Data is something like : + type $Data + data + ( + Data1 d1, + Data2 d2 + Data3 d3 + ). + and type Data3: + data3 + ( + Data31 d31, + Data32 d32 + ). + + So $Upplet will be (Data1,Data32) : sums are wanted for those 2 datum + + The function ($Upplet,$Data) -> $Upplet will be written like : + ($Upplet u,$Data d) -> if u is (u1,u2) then (u1+d1(d), u2+d32(d3(d))) + + (if of course (Data1 + Data1) and (Data32 + Data32) are defined). + + + + - Several columns - + ------------------- + + If you want to print your data on sevaral columns (i.e. considering the above table + scheme as a column), you must specify the number of columns. You will obtain : + + Here is a List($Data) : l = [a,b,c,d,e,f,g,h,i,j,k,l,m]; + and f : (RGB,Int,$Data) -> Item_Row + You want to print this list on 3 columns. + The result will be : + + + +-----------+-----------+-----------+ + | col.names | col.names | col.names | + +-----------+-----------+-----------+ + | f(a) | f(f) | f(k) | + +-----------+-----------+-----------+ + | f(b) | f(g) | f(l) | + +-----------+-----------+-----------+ Each column is a table as defined + | f(c) | f(h) | f(m) | above. + +-----------+-----------+-----------+ + | f(d) | f(i) | | + +-----------+-----------+-----------+ + | f(e) | f(j) | | + +-----------+-----------+-----------+ + + + If several columns are required, it's also asked for spaces between two colums. + + So use the following type : + +public type HowManyColumns: + _1, + several (Int col_nb, + Int spacer). + + + + + - Now the Generic table definition - + ------------------------------------ + + Here is the most customizable generic table. Below, they are some convenience functions. + +public define HTML_Off_Form + generic_table + ( + List($Data) data, + List(Table_Option) lto, + List(HTML_Row(HTML_Off_Form)) columns_name, + HowManyColumns number_of_columns, + (RGB,Int,$Data) -> HTML_Row(HTML_Off_Form) line_format, + RGB a_color, + RGB b_color, + Total_Line($Data,$Upplet,HTML_Row(HTML_Off_Form)) total_line + ). + +public define HTML_In_Form + generic_table + ( + List($Data) data, + List(Table_Option) lto, + List(HTML_Row(HTML_In_Form)) columns_name, + HowManyColumns number_of_columns, + (RGB,Int,$Data) -> HTML_Row(HTML_In_Form) line_format, + RGB a_color, + RGB b_color, + Total_Line($Data,$Upplet,HTML_Row(HTML_In_Form)) total_line + ). + + + + Note : + List(Table_Option) : if you choose 'nude' (i.e. border(0,0,0)), don't forget a + horizontal spacer between the cells contain in the 'line_format' row. If you don't put + any, each data will be closer to the next one. + + + + - Convenience functions - + ------------------------- + + 1/ Table without multicolumns, enumeration and total-line: + +public define HTML_Off_Form + generic_table + ( + List($Data) data, + List(Table_Option) lto, + List(HTML_Row(HTML_Off_Form)) columns_name, + (RGB,$Data) -> HTML_Row(HTML_Off_Form) line_format, + RGB a_color, + RGB b_color + ). + +public define HTML_In_Form + generic_table + ( + List($Data) data, + List(Table_Option) lto, + List(HTML_Row(HTML_In_Form)) columns_name, + (RGB,$Data) -> HTML_Row(HTML_In_Form) line_format, + RGB a_color, + RGB b_color + ). + + + + 2/ Table with total-line and without multicolumns, enumeration. + + +public define HTML_Off_Form + generic_table + ( + List($Data) data, + List(Table_Option) lto, + List(HTML_Row(HTML_Off_Form)) columns_name, + (RGB,$Data) -> HTML_Row(HTML_Off_Form) line_format, + RGB a_color, + RGB b_color, + Total_Line($Data,$Upplet,HTML_Row(HTML_Off_Form)) total_line + ). + +public define HTML_In_Form + generic_table + ( + List($Data) data, + List(Table_Option) lto, + List(HTML_Row(HTML_In_Form)) columns_name, + (RGB,$Data) -> HTML_Row(HTML_In_Form) line_format, + RGB a_color, + RGB b_color, + Total_Line($Data,$Upplet,HTML_Row(HTML_In_Form)) total_line + ). + + + 3/ Table with multicolumns, enumeration, but without total + +public define HTML_Off_Form + generic_table + ( + List($Data) data, + List(Table_Option) lto, + List(HTML_Row(HTML_Off_Form)) columns_name, + HowManyColumns number_of_columns, + (RGB,Int,$Data) -> HTML_Row(HTML_Off_Form) line_format, + RGB a_color, + RGB b_color + ). + +public define HTML_In_Form + generic_table + ( + List($Data) data, + List(Table_Option) lto, + List(HTML_Row(HTML_In_Form)) columns_name, + HowManyColumns number_of_columns, + (RGB,Int,$Data) -> HTML_Row(HTML_In_Form) line_format, + RGB a_color, + RGB b_color + ). + + + + 4/ Table with multicolumns and without enumeration & total + +public define HTML_Off_Form + generic_table + ( + List($Data) data, + List(Table_Option) lto, + List(HTML_Row(HTML_Off_Form)) columns_name, + HowManyColumns number_of_columns, + (RGB,$Data) -> HTML_Row(HTML_Off_Form) line_format, + RGB a_color, + RGB b_color + ). + +public define HTML_In_Form + generic_table + ( + List($Data) data, + List(Table_Option) lto, + List(HTML_Row(HTML_In_Form)) columns_name, + HowManyColumns number_of_columns, + (RGB,$Data) -> HTML_Row(HTML_In_Form) line_format, + RGB a_color, + RGB b_color + ). + + + --- That's all for public part. ------------------------------------------------------------------------- + + + When the datum $Data must be presented on several columns, the initial list must be + re-composed : sot the type Print_Table. + +type Print_Table($Data): + print_table + ( + $Data data, + Int num + ). + + + *** Transform List($Data) into List(Print_Table($Data)) + + +define (List(Print_Table($Data)),List($Data)) + get_n_elements + ( + List($Data) l, + List(Print_Table($Data)) result, + Int n, + Int ct, // counter + Int num + ) = + if l is + { + [] then (reverse(result),[]), + [h . t] then + if ct = n + then (reverse([print_table(h,num+1) . result]),t) + else get_n_elements(t,[print_table(h,num+1) . result],n,ct+1,num+1) + }. + + +define List(List(Print_Table($Data))) + short_lists + ( + List($Data) l, + Int nb, // number of element of short list + Int ct // counter for numbering data (initialized at 0) + ) = + if get_n_elements(l,[],nb,1,ct) is (result,unused) + then if unused is + { + [] then [result], + [_ . _] then [result . short_lists(unused,nb,ct+nb)] + }. + + + - Generic row - + --------------- + +define (List(HTML_Row($HTML)),$Upplet) + generic_rows + ( + List(Print_Table($Data)) lpt, + (RGB,Int,$Data) -> HTML_Row($HTML) line_format, + RGB a_color, + RGB b_color, + ($Upplet,$Data) -> $Upplet do_sum, + List(HTML_Row($HTML)) rows, + $Upplet sum + ) = + if lpt is + { + [] then (reverse(rows),sum), + [h . t] then + generic_rows(t,line_format,b_color,a_color,do_sum, + [line_format(a_color,num(h),data(h)) . rows],do_sum(sum,data(h))) + }. + + + + - HTML_In_Form - + ---------------- + +define List(HTML_Cell(HTML_In_Form)) + generic_cells + ( + List(List(Print_Table($Data))) print_data, + List(Table_Option) lto, + List(HTML_Row(HTML_In_Form)) names, + (RGB,Int,$Data) -> HTML_Row(HTML_In_Form) line_format, + RGB a_color, + RGB b_color, + ($Upplet,$Data) -> $Upplet do_sum, + $Upplet -> HTML_Row(HTML_In_Form) total_line, + $Upplet value, + Int spacer + ) = + if print_data is + { + [] then (List(HTML_Cell(HTML_In_Form))) [], + [h . t] then + if generic_rows(h,line_format,a_color,b_color,do_sum,(List(HTML_Row(HTML_In_Form)))[],value) is + (rows,new_value) then + if t is [] + then [cell([top],table(lto,names+rows+[total_line(new_value)]))] + else [ + cell([top],table(lto,append(names,rows))) + . if spacer = 0 + then generic_cells + (t,lto,names,line_format,a_color,b_color,do_sum,total_line,new_value,spacer) + else [cell([width(spacer)],text([],"")) + . generic_cells + (t,lto,names,line_format,a_color,b_color,do_sum,total_line,new_value,spacer)] + ] + }. + +//public define Int +// Int x (mod Int y) +// = +// if x / y is +// { +// failure then 0, +// success(result) then +// if result is (q, r) then r +// }. +// + + +public define HTML_In_Form + generic_table + ( + List($Data) l, + List(Table_Option) lto, + List(HTML_Row(HTML_In_Form)) names, + HowManyColumns hm_col, + (RGB,Int,$Data) -> HTML_Row(HTML_In_Form) line_format, + RGB a_color, + RGB b_color, + Total_Line($Data,$Upplet,HTML_Row(HTML_In_Form)) total_line + ) = + table([], + if l is [] + then [] + else + with nbl = length(l), + [ + row([], + if total_line is + { + no_total then + with col_nb = if hm_col is + { + _1 then 1, + several(n,_) then n + }, + with spacer = if hm_col is + { + _1 then 0, + several(n,sp) then sp + }, + generic_cells + (short_lists(l,nbl\col_nb + if (nbl (mod col_nb)) > 0 then 1 else 0,0), + lto,names,line_format,a_color,b_color, + (One u,$Data d) |-> unique,(One _) |-> row([],[]),unique,spacer), + total(sum_fct,total_line,init) then + with col_nb = if hm_col is + { + _1 then 1, + several(n,_) then n + }, + with spacer = if hm_col is + { + _1 then 0, + several(n,sp) then sp + }, + generic_cells + ( + short_lists(l,nbl\col_nb + if (nbl (mod col_nb)) > 0 then 1 else 0,0), + lto,names,line_format,a_color,b_color, + sum_fct,total_line,init,spacer + ) + }) + ]). + + + - HTML_Off_Form - + ---------------- + +define List(HTML_Cell(HTML_Off_Form)) + generic_cells + ( + List(List(Print_Table($Data))) print_data, + List(Table_Option) lto, + List(HTML_Row(HTML_Off_Form)) names, + (RGB,Int,$Data) -> HTML_Row(HTML_Off_Form) line_format, + RGB a_color, + RGB b_color, + ($Upplet,$Data) -> $Upplet do_sum, + $Upplet -> HTML_Row(HTML_Off_Form) total_line, + $Upplet value, + Int spacer + ) = + if print_data is + { + [] then (List(HTML_Cell(HTML_Off_Form))) [], + [h . t] then + if generic_rows(h,line_format,a_color,b_color,do_sum,(List(HTML_Row(HTML_Off_Form)))[],value) is + (rows,new_value) then + if t is [] + then [cell([top],table(lto,(names+rows+[total_line(new_value)])))] + else [ + cell([top],table(lto,append(names,rows))) + . if spacer =0 + then generic_cells + (t,lto,names,line_format,a_color,b_color,do_sum,total_line,new_value,spacer) + else [cell([width(spacer)],text([],"")) + . generic_cells + (t,lto,names,line_format,a_color,b_color,do_sum,total_line,new_value,spacer)] + ] + }. + +public define HTML_Off_Form + generic_table + ( + List($Data) l, + List(Table_Option) lto, + List(HTML_Row(HTML_Off_Form)) names, + HowManyColumns hm_col, + (RGB,Int,$Data) -> HTML_Row(HTML_Off_Form) line_format, + RGB a_color, + RGB b_color, + Total_Line($Data,$Upplet,HTML_Row(HTML_Off_Form)) total_line + ) = + table([], + with nbl = length(l), + [ + row([], + if total_line is + { + no_total then + with col_nb = if hm_col is + { + _1 then 1, + several(n,_) then n + }, + with spacer = if hm_col is + { + _1 then 0, + several(n,sp) then sp + }, + generic_cells + ( + short_lists(l,nbl\col_nb + if (nbl (mod col_nb)) > 0 then 1 else 0,0), + lto,names,line_format,a_color,b_color, + (One u,$Data d) |-> unique,(One _) |-> row([],[]),unique,spacer + ), + total(sum_fct,total_line,init) then + with col_nb = if hm_col is + { + _1 then 1, + several(n,_) then n + }, + with spacer = if hm_col is + { + _1 then 0, + several(n,sp) then sp + }, + generic_cells + ( + short_lists(l,nbl\col_nb + if (nbl (mod col_nb)) > 0 then 1 else 0,0), + lto,names,line_format,a_color,b_color, + sum_fct,total_line,init,spacer + ) + }) + ]). + + + + - Convenience functions : + +public define HTML_Off_Form + generic_table + ( + List($Data) data, + List(Table_Option) lto, + List(HTML_Row(HTML_Off_Form)) columns_name, + (RGB,$Data) -> HTML_Row(HTML_Off_Form) line_format, + RGB a_color, + RGB b_color + ) = + generic_table + ( + (List($Data)) data, + (List(Table_Option)) lto, + (List(HTML_Row(HTML_Off_Form))) columns_name, + (HowManyColumns) _1, + ((RGB,Int,$Data) -> HTML_Row(HTML_Off_Form)) (RGB r,Int n,$Data d) |-> line_format(r,d), + (RGB) a_color, + (RGB) b_color, + (Total_Line($Data,$Data,HTML_Row(HTML_Off_Form))) no_total + ). + +public define HTML_In_Form + generic_table + ( + List($Data) data, + List(Table_Option) lto, + List(HTML_Row(HTML_In_Form)) columns_name, + (RGB,$Data) -> HTML_Row(HTML_In_Form) line_format, + RGB a_color, + RGB b_color + ) = + generic_table + ( + (List($Data)) data, + (List(Table_Option)) lto, + (List(HTML_Row(HTML_In_Form))) columns_name, + (HowManyColumns) _1, + ((RGB,Int,$Data) -> HTML_Row(HTML_In_Form)) (RGB r,Int n,$Data d) |-> line_format(r,d), + (RGB) a_color, + (RGB) b_color, + (Total_Line($Data,$Data,HTML_Row(HTML_In_Form))) no_total + ). + + + 2/ Table with total-line and without multicolumns, enumeration. + + +public define HTML_Off_Form + generic_table + ( + List($Data) data, + List(Table_Option) lto, + List(HTML_Row(HTML_Off_Form)) columns_name, + (RGB,$Data) -> HTML_Row(HTML_Off_Form) line_format, + RGB a_color, + RGB b_color, + Total_Line($Data,$Upplet,HTML_Row(HTML_Off_Form)) total_line + ) = + generic_table + ( + (List($Data)) data, + (List(Table_Option)) lto, + (List(HTML_Row(HTML_Off_Form))) columns_name, + (HowManyColumns) _1, + ((RGB,Int,$Data) -> HTML_Row(HTML_Off_Form)) (RGB r,Int n,$Data d) |-> line_format(r,d), + (RGB) a_color, + (RGB) b_color, + (Total_Line($Data,$Upplet,(HTML_Row(HTML_Off_Form)))) total_line + ). + +public define HTML_In_Form + generic_table + ( + List($Data) data, + List(Table_Option) lto, + List(HTML_Row(HTML_In_Form)) columns_name, + (RGB,$Data) -> HTML_Row(HTML_In_Form) line_format, + RGB a_color, + RGB b_color, + Total_Line($Data,$Upplet,HTML_Row(HTML_In_Form)) total_line + ) = + generic_table + ( + (List($Data)) data, + (List(Table_Option)) lto, + (List(HTML_Row(HTML_In_Form))) columns_name, + (HowManyColumns) _1, + ((RGB,Int,$Data) -> HTML_Row(HTML_In_Form)) (RGB r,Int n,$Data d) |-> line_format(r,d), + (RGB) a_color, + (RGB) b_color, + (Total_Line($Data,$Upplet,(HTML_Row(HTML_In_Form)))) total_line + ). + + + + + 3/ Table with multicolumns, enumeration, but without total + +public define HTML_Off_Form + generic_table + ( + List($Data) data, + List(Table_Option) lto, + List(HTML_Row(HTML_Off_Form)) columns_name, + HowManyColumns number_of_columns, + (RGB,Int,$Data) -> HTML_Row(HTML_Off_Form) line_format, + RGB a_color, + RGB b_color + ) = + generic_table + ( + (List($Data)) data, + (List(Table_Option)) lto, + (List(HTML_Row(HTML_Off_Form))) columns_name, + (HowManyColumns) number_of_columns, + ((RGB,Int,$Data) -> HTML_Row(HTML_Off_Form)) (RGB r,Int n,$Data d) |-> line_format(r,n,d), + (RGB) a_color, + (RGB) b_color, + (Total_Line($Data,$Data,(HTML_Row(HTML_Off_Form)))) no_total + ). + + +public define HTML_In_Form + generic_table + ( + List($Data) data, + List(Table_Option) lto, + List(HTML_Row(HTML_In_Form)) columns_name, + HowManyColumns number_of_columns, + (RGB,Int,$Data) -> HTML_Row(HTML_In_Form) line_format, + RGB a_color, + RGB b_color + ) = + generic_table + ( + (List($Data)) data, + (List(Table_Option)) lto, + (List(HTML_Row(HTML_In_Form))) columns_name, + (HowManyColumns) number_of_columns, + ((RGB,Int,$Data) -> HTML_Row(HTML_In_Form)) (RGB r,Int n,$Data d) |-> line_format(r,n,d), + (RGB) a_color, + (RGB) b_color, + (Total_Line($Data,$Data,(HTML_Row(HTML_In_Form)))) no_total + ). + + + + 4/ Table with multicolumns and without enumeration & total + +public define HTML_Off_Form + generic_table + ( + List($Data) data, + List(Table_Option) lto, + List(HTML_Row(HTML_Off_Form)) columns_name, + HowManyColumns number_of_columns, + (RGB,$Data) -> HTML_Row(HTML_Off_Form) line_format, + RGB a_color, + RGB b_color + ) = + generic_table + ( + (List($Data)) data, + (List(Table_Option)) lto, + (List(HTML_Row(HTML_Off_Form))) columns_name, + (HowManyColumns) number_of_columns, + ((RGB,Int,$Data) -> HTML_Row(HTML_Off_Form)) (RGB r,Int n,$Data d) |-> line_format(r,d), + (RGB) a_color, + (RGB) b_color, + (Total_Line($Data,$Data,(HTML_Row(HTML_Off_Form)))) no_total + ). + + +public define HTML_In_Form + generic_table + ( + List($Data) data, + List(Table_Option) lto, + List(HTML_Row(HTML_In_Form)) columns_name, + HowManyColumns number_of_columns, + (RGB,$Data) -> HTML_Row(HTML_In_Form) line_format, + RGB a_color, + RGB b_color + ) = + generic_table + ( + (List($Data)) data, + (List(Table_Option)) lto, + (List(HTML_Row(HTML_In_Form))) columns_name, + (HowManyColumns) number_of_columns, + ((RGB,Int,$Data) -> HTML_Row(HTML_In_Form)) (RGB r,Int n,$Data d) |-> line_format(r,d), + (RGB) a_color, + (RGB) b_color, + (Total_Line($Data,$Data,(HTML_Row(HTML_In_Form)))) no_total + ). + + + + diff --git a/web/http_get.anubis b/web/http_get.anubis new file mode 100644 index 0000000..9330af4 --- /dev/null +++ b/web/http_get.anubis @@ -0,0 +1,318 @@ + *Project* The Anubis Project + + *Title* Getting a document from the Web. + + *Copyright* Copyright (c) Alain Prouté 2001. + + + *Author* Alain Prouté + + + + *Overview* + This file defines the function 'http_get' which retrieves a document from the world + wide web (a similar function 'https_get' for secured documents is defined in + 'https_get.anubis'). The function simulates the behavior of a browser, at least just + what is needed to retrieve the document. It does not display the document, but returns + it (if found) in the form of a string. It also returns the response line from the + server, and the list af all HTTP headers. + + The function 'http_get' takes the following arguments: + + - the name of the server to which the request is to be sent, + - the name (including the path) of the document on this server, + - a list of headers to be added to mandatory standard headers, + - a list of 'arguments' in the form of pairs of strings '(name,value)' to be sent as + the body of the request. + + + The result returned by 'http_get' has the following type, which defines the problems + which may happen: + + +read tools/basis.anubis +read system/string.anubis +transmit xlib/web/common.anubis +transmit xlib/web/http_get_common.anubis + + +public type HTTP_GET_Result: + cannot_resolve_server_name(DNS_Result), + cannot_connect_to_server(NetworkConnectError), + transmission_problem, + request_refused_by_server, + ok(String response, // HTTP response line from the server + List(HTTP_header) headers, // HTTP headers received from the server + String document). // The HTML document itself + + +public define HTTP_GET_Result + http_get + ( //-------- example: ----------------------- + String server_name, // "www.machin.com" + String document_name, // "/truc/bidule.html" + List(HTTP_header) headers, // [http_header("Cookie","..."),...] + List(HTTP_argument) arguments // [http_argument("ga","bu"),...] + ). + + The same one without the 'headers' argument: + +public define HTTP_GET_Result + http_get + ( //-------- example: ----------------------- + String server_name, // "www.machin.com" + String document_name, // "/truc/bidule.html" + List(HTTP_argument) arguments // [http_argument("ga","bu"),...] + ) = http_get(server_name,document_name,[],arguments). + + + + This file also defines the command 'http_get' to be used directly from the system + prompt. To learn about the syntax, just type 'http_get' at the system prompt, or have + a look at the end of this file + + --- That's all for public definitions. ------------------------------------------------ + + + + We need two functions for sending and receiving bytes. + +define Maybe(One) + send + ( + RWStream conn, // where to send the text + String text, // the text to be sent + Word32 n // start sending at character number 'n' in 'text' + ) = + if nth(to_Int(n),text) is + { + failure then success(unique), + success(c) then + if conn <- c is + { + failure then failure, + success(_) then send(conn,text,n+1) + } + }. + +define Maybe(String) + receive_text_chunk + ( + RWStream conn, + List(Word8) so_far, + Word32 count + ) = + if count = 1000 then + success(implode(reverse(so_far))) + else if *conn is // *conn waits for data to be readable from connection + { + failure then success(implode(reverse(so_far))), // means 'connection closed by peer' + success(c) then + receive_text_chunk(conn, [c . so_far], count+1) + }. + + +define HTTP_GET_Result + receive + ( + RWStream conn, + String headers, + String text_so_far, + Bool double_crlf_seen + ) = + if receive_text_chunk(conn,[],0) is + { + failure then if separate_headers(headers) is + { + [ ] then ok("",[],text_so_far), + [h . t] then if h is http_header(a,b) then ok(a,t,text_so_far) + }, + + success(s) then + if s = "" then + if separate_headers(headers) is + { + [ ] then ok("",[],text_so_far), + [h . t] then if h is http_header(a,b) then ok(a,t,text_so_far) + } + else + with new_s = text_so_far+s, + if double_crlf_seen then + with len = length(s), + println("content received : "+len+" bytes"); + receive(conn, headers, new_s, true) + else if has_double_crlf(new_s) is + { + failure then + receive(conn, headers, new_s, false), + success(n) then + //extract the begin of data + if sub_string(new_s,n+4,length(new_s)-n-4) is + { + failure then alert, + success(s1) then + //extract end of the header + if sub_string(new_s, 0, n) is + { + failure then alert, + success(h) then receive(conn, h, s1, true) + } + } + } + }. + + + + The next function has a valid TCP/IP connection to the server, and tries to retrieve + the document. + + +define HTTP_GET_Result + http_get + ( + Bool print_all, + RWStream conn, + String server_name, + String document_name, + List(HTTP_header) headers, + List(HTTP_argument) arguments, + ) = + // + // Send the HTTP request, and receive the answer: + // + with body = format_http_args(arguments), + with request = (if arguments = [] then "GET " else "POST ") + + document_name + " HTTP/1.1" + crlf + + "Host: " + server_name + crlf + + "Accept-Charset: iso-8859-1,*,utf-8" + crlf + + (if arguments = [] then "" + else "Content-type: application/x-www-form-urlencoded" + crlf + + "Content-length: " + to_decimal(length(body))+ crlf) + + format_headers(headers) + + crlf + + body, + (if print_all then + ( + print("----- request ----\n"); + print(request); + print("\n") + ) else unique); + if send(conn,request,0) is + { + failure then transmission_problem, + success(_) then receive(conn,"","",false) + }. + + + The next function retrieves the document using the numerical (resolved) server address. + +define HTTP_GET_Result + http_get + ( + Bool print_all, + Word32 server_addr, + Word32 server_port, + String server_name, + String document_name, + List(HTTP_header) headers, + List(HTTP_argument) arguments, + ) = + // + // try to connect to the server before sending the request + // + if (Result(NetworkConnectError,RWStream))connect(server_addr,server_port) is + { + error(e) then cannot_connect_to_server(e), + ok(conn) then http_get(print_all,conn,server_name,document_name,headers,arguments) + }. + + +public define HTTP_GET_Result + http_get + ( + Bool print_all, + String server_name, + String document_name, + List(HTTP_header) headers, + List(HTTP_argument) arguments, + ) = + if separate_name_port(server_name,80) is (name,port) then + // + // resolve server name and call 'http_get' with numeric server address: + // + with a = dns(name), + if a is ok(addr) + then http_get(print_all,addr,port,name,document_name,headers,arguments) + else cannot_resolve_server_name(a). + + + Now, here is our public tool: + +public define HTTP_GET_Result + http_get + ( + String server_name, + String document_name, + List(HTTP_header) headers, + List(HTTP_argument) arguments, + ) = http_get(false,server_name,document_name,headers,arguments). + + + + Finally, we construct the executable module 'http_get': + +define One + recall_syntax = + print("\nUsage: http_get [options] =
... - ...\n"); + print(" Options are:\n"); + print(" -print_all print request, response line, headers and document\n"); + print(" (default is to print only the document)\n"). + + + + + global define One + http_get + ( + List(String) args + ) = + if args is + { + [ ] then recall_syntax, + [server . t] then if t is + { + [ ] then recall_syntax, + [document . rest] then + with print_all = member(rest,"-print_all"), + headers = get_headers(rest), + arguments = get_arguments(rest), + if http_get(print_all,server,document,headers,arguments) is + { + cannot_resolve_server_name(dns_error) then + print("Cannot resolve server name: " + format(dns_error) + ".\n"), + + cannot_connect_to_server(connect_error) then + print("Cannot connect to server: " + format(connect_error) + ".\n"), + + transmission_problem then + print("Transmission problem.\n"), + + request_refused_by_server then + print("The request has been refused by server: " + server + ".\n"), + + ok(response,headers1,document1) then + ( + if print_all + then ( + print("\n----- response ----\n"); + print(response); + print("\n----- headers -----\n"); + print_headers(headers1); + print("----- document ----\n") + ) else unique + ); + print(document1) // on the screen (use a redirection to get it in a file) + } + } + }. + diff --git a/web/https_get.anubis b/web/https_get.anubis new file mode 100644 index 0000000..1b1e029 --- /dev/null +++ b/web/https_get.anubis @@ -0,0 +1,390 @@ + + *Project* The Anubis Project + + *Title* Getting a document from the secured Web. + + *Copyright* Copyright (c) Alain Prouté 2001. + + + *Author* Alain Prouté + + + *Overview* + This file defines the function 'https_get' which retrieve a document from the world + wide web in secured mode (HTTPS). The function is analogous to 'http_get', to be found + in 'web/http_get.anubis'. + + The function simulates the behavior of a browser, at least just what is needed to + retrieve the document. It does not display the document, but returns it (if found) in + the form of a string. + + The function 'https_get' takes the following operands: + + - the name of the server to which the request is to be sent, + - the name (including the path) of the document on this server, + - a list of headers to be added to mandatory standard headers, + - a list of 'arguments' to be sent as the body of the request (web arguments). + - an accept policy function (see below), for accepting X.509 certificates in case of + a problem. + + The result returned by 'https_get' has the following type, which defines the problems + which may happen: + + +read tools/basis.anubis +read system/string.anubis +//read html.anubis +read CXM_http_get_common.anubis +//read http_server.anubis +read CXM_common.anubis + + +public type HTTPS_GET_Result: + cannot_resolve_server_name(DNS_Result), + ssl_connect_error(SSLConnectError), + transmission_problem, + request_refused_by_server, + ok(String response, + List(HTTP_header) headers, + String document). + + Cookies are among headers. See 'web/cookies.anubis' for cookies handling. + + + Note: The types 'DNS_Result' and 'SSLConnectError' are defined in 'predefined.anubis'. + +public define HTTPS_GET_Result + https_get + ( + String server_name, + String document_name, + List(HTTP_header) headers, + List(HTTP_argument) arguments, + (Maybe(X509)) -> Bool accept_policy + ). + + The same one without the 'headers' argument: + +public define HTTPS_GET_Result + https_get + ( + String server_name, + String document_name, + List(HTTP_argument) arguments, + (Maybe(X509)) -> Bool accept_policy + ) = https_get(server_name,document_name,[],arguments,accept_policy). + + The main difference with 'http_get' is the presence of the 'accept_policy' + argument. 'accept_policy' is the function which determines your personal policy for + accepting a server certificate, if it is the case that either this certificate is + invalid (or missing), or if its common name does not match the server name, that is to + say if 'open_SSL_connection' (defined in 'predefined.anubis') did not already accept + it. + + 'X509' is an 'opaque' type defined in 'predefined.anubis'. It is 'opaque' in the sens + that no alternative of this type is directly accessible to you (despite the fact that + the type is public). + + An accept policy function takes (maybe) an X.509 certificate as its unique argument, so + that the decision may be taken with the suspect certificate at hand. It must return + 'true' for accepting, and 'false' for refusing. + + You may use the following default accept policy function: + +public define Bool + default_accept_policy + ( + Maybe(X509) suspect_certificate + ) = false. + + That is, never accept a certificate which cannot be successfully verified by + 'open_SSL_connection'. Notice that this is not a paranoid behavior, but a normal + behavior. Nevertheless, you still have the possibility to weaken this behavior by + using another accept policy function. Be very careful when writing this function, + because this may weaken your security. This function may for example show the + certificate and ask for user input for accepting it. It may also check the certificate + fingerprint against a data base, etc... + + Another accept policy function is defined in this file: + +public define Bool + command_line_accept_policy + ( + Maybe(X509) suspect_certificate + ). + + It is used by the command line module 'https_get.adm'. If the certificate is not + accepted by 'open_SSL_connection', this function prints the certificate on the screen, + and ask the user for acceptation. It also asks the user for accepting the certificate + for ever. + + It is likely that you will need an accept policy function of your own. See the + definition of 'command_line_accept_policy' below for information and + 'predefined.anubis' for the tools enabling the manipulation of X.509 certificates. + Certificates that you trust are stored into the directory declared under the symbol + 'ca' (for 'Certificate Authorities') in your configuration file. Any certificate + present in this directory is trusted without any condition. + + This file defines the module 'https_get' to be used directly from the command line. To + learn about the syntax, just type 'https_get' at the system prompt, or have a look at + the end of this file. + + + + + --- That's all for public definitions. ------------------------------------------------ + + + + + + + + +define Maybe(String) + receive_text_chunk + ( + SSL_Connection conn + ) = + read(conn,100,1000). + + + + +define HTTPS_GET_Result + receive + ( + SSL_Connection conn, + String headers, + String text_so_far, + Bool double_crlf_seen + ) = + if receive_text_chunk(conn) is + { + failure then if separate_headers(headers) is + { + [ ] then ok("",[],text_so_far), + [h . t] then if h is http_header(a,b) then ok(a,t,text_so_far) + }, + + success(s) then + if s = "" + then if separate_headers(headers) is + { + [ ] then ok("",[],text_so_far), + [h . t] then if h is http_header(a,b) then ok(a,t,text_so_far) + } + else with new_s = text_so_far+s, + if double_crlf_seen + then receive(conn,headers,new_s,true) + else if has_double_crlf(new_s) is + { + failure then receive(conn,headers,new_s,false), + success(n) then + if sub_string(new_s,n+4,length(new_s)-n-4) is + { + failure then alert, + success(s1) then + if sub_string(new_s,0,n) is + { + failure then alert, + success(h) then receive(conn,h,s1,true) + } + } + } + }. + + + + The next function has a valid SSL connection to the server, and tries to retrieve the + document. + +define HTTPS_GET_Result + https_get + ( + Bool print_all, + SSL_Connection conn, + String server_name, + String document_name, + List(HTTP_header) headers, + List(HTTP_argument) arguments + ) = + // + // Send the HTTP request, and receive the answer: + // + with body = format_http_args(arguments), + with request = (if arguments = [] then "GET " else "POST ") + + document_name + " HTTP/1.0" + crlf + + "Host: " + server_name + crlf + + "Accept-Charset: iso-8859-1,*,utf-8" + crlf + + (if arguments = [] then "" + else "Content-type: application/x-www-form-urlencoded" + crlf + + "Content-length: " + to_decimal(length(body))+ crlf) + + format_headers(headers) + + crlf + + body, + (if print_all then + ( + print("Sending request:\n"); + print(request); + print("\n") + ) else unique); + if write(conn,request) is + { + failure then transmission_problem, + success(_) then receive(conn,"","",false) + }. + + + The next function retrieves the document using the numerical (resolved) server address. + +define HTTPS_GET_Result + https_get + ( + Bool print_all, + Word32 server_addr, + Word32 server_port, + String server_name, + String document_name, + List(HTTP_header) headers, + List(HTTP_argument) arguments, + (Maybe(X509)) -> Bool accept_policy + ) = + if open_SSL_connection(server_name,server_addr,server_port,accept_policy) is + { + error(msg) then ssl_connect_error(msg), + ok(conn) then https_get(print_all,conn,server_name,document_name,headers,arguments) + }. + + + +define HTTPS_GET_Result + https_get + ( + Bool print_all, + String server_name, + String document_name, + List(HTTP_header) headers, + List(HTTP_argument) arguments, + (Maybe(X509)) -> Bool accept_policy + ) = + if separate_name_port(server_name,443) is (name,port) then + // + // resolve server name and call 'https_get' with numeric server address: + // + with a = dns(name), + if a is ok(addr) + then https_get(print_all,addr,port,name,document_name,headers,arguments,accept_policy) + else cannot_resolve_server_name(a). + + + + Now, here is our public tool: + +public define HTTPS_GET_Result + https_get + ( + String server_name, + String document_name, + List(HTTP_header) headers, + List(HTTP_argument) arguments, + (Maybe(X509)) -> Bool accept_policy + ) = https_get(false,server_name,document_name,headers,arguments,accept_policy). + + + + + + Finally, we construct the command line executable module 'https_get.adm': + +define One + syntax_https_get = + print("\nUsage: https_get [options] =
... ...\n"); + print(" Options are:\n"); + print(" -print_all print request, response line, headers and document\n"); + print(" (default is to print only the document)\n"). + + + + + Below is our accept policy function for the command line module. This function may + serve as a model for your own accept policy function. + +public define Bool + command_line_accept_policy + ( + Maybe(X509) mbcert + ) = + if mbcert is + { + failure then + print("No server certificate or invalid server certificate.\n"); + print("Do you want to trust this site anyway ? [Y/N]\n"); + yes, // this is the same as 'if yes then true else false' + + success(cert) then + print(to_string(cert)); + print("\nDo you want to accept the above certificate ? [Y/N]\n"); + if yes + then ( + print("Do you want to accept this certificate for ever ? [Y/N]\n"); + if yes + then (if trust_for_ever(cert) is + { + ca_directory_not_found then print("'ca' directory not found.\n"), + cannot_create_file then print("cannot create file.\n"), + cannot_create_symbolic_link then print("cannot create symbolic link.\n"), + write_error then print("write error.\n"), + ok then unique + }; true) + else true + ) + else false + }. + + +global define One + https_get + ( + List(String) args + ) = + if args is + { + [ ] then syntax_https_get, + [server . t] then if t is + { + [ ] then syntax_https_get, + [document . rest] then + with print_all = member(rest,"-print_all"), + headers = get_headers(rest), + arguments = get_arguments(rest), + if https_get(print_all,server,document,headers,arguments,command_line_accept_policy) is + { + cannot_resolve_server_name(dns_error) then + print("Cannot resolve server name: " + format(dns_error) + ".\n"), + + ssl_connect_error(connect_error) then + print("SSL connect error: " + format(connect_error) + ".\n"), + + transmission_problem then + print("Transmission problem.\n"), + + request_refused_by_server then + print("The request has been refused by server: " + server + ".\n"), + + ok(response,headers1,document1) then + ( + if print_all + then ( + print("\n----- response ----\n"); + print(response); + print("\n----- headers -----\n"); + print_headers(headers1); + print("----- document ----\n") + ) else unique + ); + print(document1) // on the screen (use a redirection to get it in a file) + } + } + }. + diff --git a/web/jQuery/jq_animate.anubis b/web/jQuery/jq_animate.anubis index 4efb926..d5cdbed 100644 --- a/web/jQuery/jq_animate.anubis +++ b/web/jQuery/jq_animate.anubis @@ -65,12 +65,12 @@ read tools/basis.anubis read tools/printable_tree.anubis -read xlib/web/CXM_making_a_web_site.anubis -read xlib/web/CXM_json.anubis -read xlib/web/CXM_jquery.anubis -read xlib/web/jQuery/CXM_jquery_easing.anubis +read xlib/web/making_a_web_site.anubis +read xlib/web/json.anubis +read xlib/web/jquery.anubis +read xlib/web/jQuery/jq_easing.anubis -read xlib/web/CXM_style_tools.anubis +read xlib/web/style_tools.anubis read xlib/web/js_tools.anubis public type AnimatableCSSStyle: @@ -130,9 +130,9 @@ public type JQueryAnimation: type JQueryFormattedAnimation: formatted_animation(String id, String trigger_name, JsonValue stop_anim_id, JsonValue css_props, JsonValue options). -define HTML_Head_Tag required_js = js(js_file("js/cxm/cxm_jquery_animate.js")). +define HTML_Head_Tag required_js = js(js_file("xlib/js/jquery_animate.js")). -define String js_anim_function_name = "CalexiumToolBox.CXM_Animate.animate". +define String js_anim_function_name = "Xlib.CXM_Animate.animate". define List(JsonMember) animatables_to_json_members diff --git a/web/jQuery/jq_button.anubis b/web/jQuery/jq_button.anubis index 6708e21..b35cb32 100644 --- a/web/jQuery/jq_button.anubis +++ b/web/jQuery/jq_button.anubis @@ -286,7 +286,7 @@ public define HTML_Partial_Content )= with uid = generate_random_string(10), - js_confirm_dialog_data_obj = "CalexiumToolBox.data.confirm_dialog['" + uid + "']", + js_confirm_dialog_data_obj = "Xlib.data.confirm_dialog['" + uid + "']", js_data = js_confirm_dialog_data_obj + " = { title: " + to_JS_String(dlg_title) + ", text: " + to_JS_String(dlg_text) + ", @@ -294,7 +294,7 @@ public define HTML_Partial_Content cancel: " + to_JS_String(dlg_cancel) + "};", button_name = uid, - _actioner = jQuery_actioner(same, jqscript("CalexiumToolBox.make_confirm_dialog(this, " /*+ to_js_string("/?a=" + url + format_extra_operands(extra_ops))+*/ + to_JS_String(jquery_button_get_onclick_action(actioner)) + ");")), + _actioner = jQuery_actioner(same, jqscript("Xlib.make_confirm_dialog(this, " /*+ to_js_string("/?a=" + url + format_extra_operands(extra_ops))+*/ + to_JS_String(jquery_button_get_onclick_action(actioner)) + ");")), partial_content([ js(js_file("js/cxm/cxm.js")), @@ -322,7 +322,7 @@ public define HTML_Partial_Content since button is jquery_img_button(img_url, button_label, button_name, actioner, orientation), with uid = generate_random_string(10), - js_confirm_dialog_data_obj = "CalexiumToolBox.data.confirm_dialog['" + uid + "']", + js_confirm_dialog_data_obj = "Xlib.data.confirm_dialog['" + uid + "']", js_data = js_confirm_dialog_data_obj + " = { title: " + to_JS_String(dlg_title) + ", text: " + to_JS_String(dlg_text) + ", @@ -330,7 +330,7 @@ public define HTML_Partial_Content cancel: " + to_JS_String(dlg_cancel) + "};", _button_name = uid, - _actioner = jQuery_actioner(same, jqscript("CalexiumToolBox.make_confirm_dialog(this, " + to_JS_String(jquery_button_get_onclick_action(actioner)) +");")), + _actioner = jQuery_actioner(same, jqscript("Xlib.make_confirm_dialog(this, " + to_JS_String(jquery_button_get_onclick_action(actioner)) +");")), partial_content([ js(js_file("js/cxm/cxm.js")), diff --git a/web/jQuery/jq_dialog.anubis b/web/jQuery/jq_dialog.anubis index f076b44..5270098 100644 --- a/web/jQuery/jq_dialog.anubis +++ b/web/jQuery/jq_dialog.anubis @@ -130,7 +130,7 @@ public define String WEB_Action_Name action, List((String,String)) extra_ops )= - "CalexiumToolBox.jq_dialog_load('"+id(dialog_id)+"',"+format_web_action_name_to_js(action, extra_ops)+");" + "Xlib.jq_dialog_load('"+id(dialog_id)+"',"+format_web_action_name_to_js(action, extra_ops)+");" . @@ -150,7 +150,7 @@ define String JQuery_dialog_id dialog_id, String params )= - with js_function = "CalexiumToolBox.jquery_dialog_click('"+id(dialog_id)+"', "+(if length(params)=0 then "''" else params) +");", + with js_function = "Xlib.jquery_dialog_click('"+id(dialog_id)+"', "+(if length(params)=0 then "''" else params) +");", if mb_html is { failure then js_function, diff --git a/web/jQuery/jq_flot.anubis b/web/jQuery/jq_flot.anubis index 07472a6..332543a 100644 --- a/web/jQuery/jq_flot.anubis +++ b/web/jQuery/jq_flot.anubis @@ -6,7 +6,7 @@ * © David RENÉ */ -read xlib/web/CXM_making_a_web_site.anubis +read xlib/web/making_a_web_site.anubis public define List(HTML_Head_Tag) jq_flot_init diff --git a/web/jQuery/jq_radio.anubis b/web/jQuery/jq_radio.anubis index 7881ea2..272fd46 100644 --- a/web/jQuery/jq_radio.anubis +++ b/web/jQuery/jq_radio.anubis @@ -6,10 +6,10 @@ * © Calexium */ -transmit xlib/web/CXM_making_a_web_site.anubis -transmit xlib/web/CXM_jquery.anubis -transmit xlib/web/jQuery/CXM_jquery_button.anubis -transmit xlib/web/jQuery/CXM_jquery_icons.anubis +transmit xlib/web/making_a_web_site.anubis +transmit xlib/web/jquery.anubis +transmit xlib/web/jQuery/jq_button.anubis +transmit xlib/web/jQuery/jq_icons.anubis transmit xlib/web/js_tools.anubis transmit tools/basis.anubis transmit system/string.anubis diff --git a/web/jQuery/jq_tabs.anubis b/web/jQuery/jq_tabs.anubis index b08ceac..d78a185 100644 --- a/web/jQuery/jq_tabs.anubis +++ b/web/jQuery/jq_tabs.anubis @@ -90,8 +90,8 @@ public define HTML_Partial_Content $(this).attr('value', ui.newTab.index()); }); - if (typeof CalexiumToolBox !== 'undefined' && typeof CalexiumToolBox.jq_tab_activate !== 'undefined') { - CalexiumToolBox.jq_tab_activate(event, ui); + if (typeof Xlib !== 'undefined' && typeof Xlib.jq_tab_activate !== 'undefined') { + Xlib.jq_tab_activate(event, ui); } }, create: function( event, ui ) { diff --git a/web/jquery.anubis b/web/jquery.anubis index f614f70..1dcd483 100644 --- a/web/jquery.anubis +++ b/web/jquery.anubis @@ -92,7 +92,7 @@ public define String }+ "$('#"+form+"').submit();\n", jqformload(form_id, target_id, web_action, extra_args) then - "CalexiumToolBox.jq_form_submit_and_load('"+form_id+"', '"+format_web_action_name(web_action, extra_args)+"', '"+target_id+"');\n" + "Xlib.jq_form_submit_and_load('"+form_id+"', '"+format_web_action_name(web_action, extra_args)+"', '"+target_id+"');\n" jqlink(control_action, extra_ops) then if control_action is { @@ -121,7 +121,7 @@ public define String }+ "$('#"+form+"').submit();\n", jqformload(form_id, target_id, web_action, extra_args) then - "CalexiumToolBox.jq_form_submit_and_load('"+form_id+"', '"+format_web_action_name(web_action, extra_args)+"', '"+target_id+"');\n" + "Xlib.jq_form_submit_and_load('"+form_id+"', '"+format_web_action_name(web_action, extra_args)+"', '"+target_id+"');\n" jqlink(control_action, extra_ops) then if control_action is { @@ -150,7 +150,7 @@ public define String }+ "$('#"+form+"').submit();\n", jqformload(form_id, target_id, web_action, extra_args) then - "CalexiumToolBox.jq_form_submit_and_load('"+form_id+"', '"+format_web_action_name(web_action, extra_args)+"', '"+target_id+"');\n" + "Xlib.jq_form_submit_and_load('"+form_id+"', '"+format_web_action_name(web_action, extra_args)+"', '"+target_id+"');\n" jqlink(control_action, extra_ops) then if control_action is { diff --git a/web/js/cxm_jquery_animate.js b/web/js/cxm_jquery_animate.js deleted file mode 100644 index 0c1bdc4..0000000 --- a/web/js/cxm_jquery_animate.js +++ /dev/null @@ -1,116 +0,0 @@ -/* - Animation of HTML elements style. - - Requirement: - jquery - jquery-ui (if you want to use advanced animating functions, ie: easing) - - Usage: - CalexiumToolBox.CXM_Animate.animate(selector, trigger_type, css_props, options, second_options); - - Arguments: - - selector - JQuery selector (string), animation and event will be applied to HTML elements matched by the selector. - - * Example: - - "#element_id" - or - ".class_name" - - - anims - Array of animations object - - Example: - [ - { - id: "my_animation", - event: "mouseover" - stop_anims_id: [], - props: { width: 64, height: 64 }, - options: { easing: "linear", duration: 2000 } - } - } - - Note: - Options properties are the same as the jquery "animate" method options. -*/ - -$(document).ready(function () { - if (window.CalexiumToolBox === undefined) { - CalexiumToolBox = {}; - } - - if (CalexiumToolBox.CXM_Animate === undefined) { - CalexiumToolBox.CXM_Animate = { - animate: null // see below - }; - } - - CalexiumToolBox.CXM_Animate.animate = function (selector, anims) { - $(selector).each(function() { - var elem = $(this), - - grouped_anims = { - - }, - - initial_css_props = {};; - - // group/register anims by events - $(anims).each(function (index, anim) { - var anim_group = grouped_anims[anim.event]; - - if (anim_group === undefined) { - anim_group = grouped_anims[anim.event] = []; - } - - anim_group.push(anim); - }); - - // iterate over all props of each anims and store the initial state of each css props of the element - // this is done only once for the group of anims and it happen only if one anim props is empty which mean it animate back to element initial state at initialization - for (i = 0; i < anims.length; i += 1) { - if (jQuery.isEmptyObject(anims[i].props) && jQuery.isEmptyObject(initial_css_props)) { - for (j = 0; j < anims.length; j += 1) { - $.each(anims[j].props, function (key, value) { - initial_css_props[key] = elem.css(key).replace('px', ''); - }); - } - - anims[i].props = initial_css_props; - - break; - } - } - - // now for each event groups, bind the event - $.each(grouped_anims, function (key, anims) { - elem.bind(key, - function() { - var anim_object, options, - id, i, j; - - // setup each animations - for (i = 0; i < anims.length; i += 1) { - anim_object = anims[i]; - options = anim_object.options, - stop_anims_id = anim_object.stop_anims_id; - - // stop if needed specific anims determined by a list of ids - if (stop_anims_id !== undefined) { - for (id = 0; id < stop_anims_id.length; id += 1) { - elem.stop(stop_anims_id[id], true); - } - } - - options.queue = anim_object.id; - - elem.animate(anim_object.props, options).dequeue(anim_object.id); - } - } - ); - }); - }); - }; -}); diff --git a/web/js/jquery_animate.js b/web/js/jquery_animate.js new file mode 100644 index 0000000..ecf8559 --- /dev/null +++ b/web/js/jquery_animate.js @@ -0,0 +1,116 @@ +/* + Animation of HTML elements style. + + Requirement: + jquery + jquery-ui (if you want to use advanced animating functions, ie: easing) + + Usage: + Xlib.CXM_Animate.animate(selector, trigger_type, css_props, options, second_options); + + Arguments: + - selector + JQuery selector (string), animation and event will be applied to HTML elements matched by the selector. + + * Example: + + "#element_id" + or + ".class_name" + + - anims + Array of animations object + + Example: + [ + { + id: "my_animation", + event: "mouseover" + stop_anims_id: [], + props: { width: 64, height: 64 }, + options: { easing: "linear", duration: 2000 } + } + } + + Note: + Options properties are the same as the jquery "animate" method options. +*/ + +$(document).ready(function () { + if (window.Xlib === undefined) { + Xlib = {}; + } + + if (Xlib.CXM_Animate === undefined) { + Xlib.CXM_Animate = { + animate: null // see below + }; + } + + Xlib.CXM_Animate.animate = function (selector, anims) { + $(selector).each(function() { + var elem = $(this), + + grouped_anims = { + + }, + + initial_css_props = {};; + + // group/register anims by events + $(anims).each(function (index, anim) { + var anim_group = grouped_anims[anim.event]; + + if (anim_group === undefined) { + anim_group = grouped_anims[anim.event] = []; + } + + anim_group.push(anim); + }); + + // iterate over all props of each anims and store the initial state of each css props of the element + // this is done only once for the group of anims and it happen only if one anim props is empty which mean it animate back to element initial state at initialization + for (i = 0; i < anims.length; i += 1) { + if (jQuery.isEmptyObject(anims[i].props) && jQuery.isEmptyObject(initial_css_props)) { + for (j = 0; j < anims.length; j += 1) { + $.each(anims[j].props, function (key, value) { + initial_css_props[key] = elem.css(key).replace('px', ''); + }); + } + + anims[i].props = initial_css_props; + + break; + } + } + + // now for each event groups, bind the event + $.each(grouped_anims, function (key, anims) { + elem.bind(key, + function() { + var anim_object, options, + id, i, j; + + // setup each animations + for (i = 0; i < anims.length; i += 1) { + anim_object = anims[i]; + options = anim_object.options, + stop_anims_id = anim_object.stop_anims_id; + + // stop if needed specific anims determined by a list of ids + if (stop_anims_id !== undefined) { + for (id = 0; id < stop_anims_id.length; id += 1) { + elem.stop(stop_anims_id[id], true); + } + } + + options.queue = anim_object.id; + + elem.animate(anim_object.props, options).dequeue(anim_object.id); + } + } + ); + }); + }); + }; +}); diff --git a/web/load_content.anubis b/web/load_content.anubis index ac99e44..e5dc54e 100644 --- a/web/load_content.anubis +++ b/web/load_content.anubis @@ -9,7 +9,7 @@ read system/convert.anubis read xlib/web/types/making_a_web_site.anubis read xlib/web/web_action.anubis -//read xlib/web/CXM_jquery.anubis +//read xlib/web/jquery.anubis read xlib/web/js_tools.anubis public define String @@ -21,7 +21,7 @@ public define String Bool replace )= - "Xlib.ajax_load_content('"+target+"', '"+format_web_action_name(web_action, extra_args)+"', "+to_String(replace)+");" + "Xlib.load_content('"+target+"', '"+format_web_action_name(web_action, extra_args)+"', "+to_String(replace)+");" . public define String @@ -32,7 +32,7 @@ public define String List((String,String)) extra_args, Bool replace )= - to_JS_String("Xlib.ajax_load_content('"+target+"', "+format_web_action_name_to_js(web_action, extra_args)+", "+to_String(replace)+")") + to_JS_String("Xlib.load_content('"+target+"', "+format_web_action_name_to_js(web_action, extra_args)+", "+to_String(replace)+")") . public define String diff --git a/web/making_a_web_site.anubis b/web/making_a_web_site.anubis index 7661d54..5101596 100644 --- a/web/making_a_web_site.anubis +++ b/web/making_a_web_site.anubis @@ -366,7 +366,7 @@ public define List(HTTP_header) = //println("Set-Cookie state_"+website_name+"="+state_name); [ - http_header("Set-Cookie", "session_"+website_name+"="+session_name) + http_header("Set-Cookie", "session_"+website_name+"="+session_name+"; SameSite=Strict") ] . @@ -2362,7 +2362,7 @@ public define String 'web_arg_encode'. The name of the file into which the state is saved is the concatenation of "s" and the name of the state. -read CXM_web_arg_encode.anubis +read web_arg_encode.anubis The tool below constructs the function which is able to save a state on the server's disk. diff --git a/web/mime.anubis b/web/mime.anubis new file mode 100644 index 0000000..1700df9 --- /dev/null +++ b/web/mime.anubis @@ -0,0 +1,70 @@ + + *Project* The Anubis Project + + *Title* MIME Types definition. + + *Copyright* Copyright (c) Alain Prouté 2005. + + + *Authors* Alain Prouté + David René + + +read tools/base64.anubis +read tools/basis.anubis +read system/string.anubis + + public type MIME: + mime(String type, + String sybtype, + List(String) file_extensions). + + + public define Bool + MIME x = MIME y + = + if x is mime(x_type, x_subtype, _) then + if y is mime(y_type, y_subtype, _) then + insensitive_equal(x_type, y_type) & insensitive_equal(x_subtype, y_subtype). + + public define List(MIME) + known_mime_types + = + [ + mime("application", "octet-stream", [".exe"]), + mime("application", "x-pdf", [".pdf"]), + mime("image", "bmp", [".bmp"]), + mime("image", "gif", [".gif"]), + mime("image", "jpeg", [".jpg", ".jpeg"]), + mime("image", "png", [".png"]), + mime("image", "x-icon", [".ico"]), + mime("text", "html", [".html", ".htm"]), + mime("text", "css", [".css"]), + mime("text", "javascript", [".js"]), + mime("text", "plain", [".txt", ".anubis", ".c", ".h", ".y", "/Makefile"]), + mime("text", "comma-separated-values", [".csv"]), + mime("application", "msword", [".doc"]), + mime("application", "octet-stream", [".emz", ".xml", ".mso", ".wmf", ".gz", ".rar", ".zip", ".card", ".ankh", ".adm", ".swf", ".downloaded"]), + mime("audio", "x-mpeg", [".mp3"]), + mime("video", "x-msvideo", [".avi"]), + mime("message", "rfc822", [".eml"]), + ]. + + public define String + to_String + ( + MIME mime_type + ) = + if mime_type is mime(type, subtype, _) then + type + "/" + subtype. + + public define String + to_MIME_text + ( + String charset, + String text + )= + if length(text) > 0 then + with text2 = "=?"+charset+"?B?"+to_string(base64_encode(to_byte_array(text)))+"?=", + find_and_replace(text2, implode([13,10]), implode([13,10,32])) + else "". diff --git a/web/multihost_http_server.anubis b/web/multihost_http_server.anubis index 7afedd3..a2dfea0 100644 --- a/web/multihost_http_server.anubis +++ b/web/multihost_http_server.anubis @@ -2469,7 +2469,7 @@ public define List(HTTP_header) = [ http_header("Date", format_http_date(now)), - http_header("Server", "Anubis Calexium Embedded Server v" + major_version_number + "." + minor_version_number), + http_header("Server", "Anubis Embedded Web Server v" + major_version_number + "." + minor_version_number), /*http_header("Connection", "close"), */ ]. diff --git a/web/piwik/CXM_piwik.anubis b/web/piwik/CXM_piwik.anubis deleted file mode 100644 index cc96340..0000000 --- a/web/piwik/CXM_piwik.anubis +++ /dev/null @@ -1,43 +0,0 @@ -/* - * Created by PyramIDE. - * User: Julien - * Date: 28/06/2016 - * Time: 11:50 - * - * Contain functions related to Piwik Analytics (Piwik 2.16.x) - * - * https://piwik.org/ - * - * To change this template use Tools | Options | Coding | Edit Standard Headers. - */ - -read xlib/web/CXM_making_a_web_site.anubis -read tools/basis.anubis - -// this js code is to include in the section of a webpage, it enable Piwik tracking for the given site/domains (Note: Only if the website was added to the Piwik tracker) -public define HTML_Head_Tag - piwik_js_code - ( - String piwik_tracker, - Int site_id, - List(String) piwik_domains - )= - meta(literal( - " - - - - - ")). diff --git a/web/piwik/piwik.anubis b/web/piwik/piwik.anubis new file mode 100644 index 0000000..124f463 --- /dev/null +++ b/web/piwik/piwik.anubis @@ -0,0 +1,43 @@ +/* + * Created by PyramIDE. + * User: Julien + * Date: 28/06/2016 + * Time: 11:50 + * + * Contain functions related to Piwik Analytics (Piwik 2.16.x) + * + * https://piwik.org/ + * + * To change this template use Tools | Options | Coding | Edit Standard Headers. + */ + +read xlib/web/making_a_web_site.anubis +read tools/basis.anubis + +// this js code is to include in the section of a webpage, it enable Piwik tracking for the given site/domains (Note: Only if the website was added to the Piwik tracker) +public define HTML_Head_Tag + piwik_js_code + ( + String piwik_tracker, + Int site_id, + List(String) piwik_domains + )= + meta(literal( + " + + + + + ")). diff --git a/web/style_tools.anubis b/web/style_tools.anubis new file mode 100644 index 0000000..776903b --- /dev/null +++ b/web/style_tools.anubis @@ -0,0 +1,18 @@ +public define String + format_rgba_to_style_color + ( + RGBA color + ) = + if color is + { + rgba(r, g, b, a) then + with alpha_str = + if to_Float(word32(word16(a, 0), word16(0, 0))) / 255.0 is + { + failure then "1", + success(v) then + float_to_string(v, 8) + }, + + "rgba(" + to_decimal(r) + "," + to_decimal(g) + "," + to_decimal(b) + "," + alpha_str + ");" + }. diff --git a/web/types/XL_web_stepper.anubis b/web/types/XL_web_stepper.anubis deleted file mode 100644 index 8cd6715..0000000 --- a/web/types/XL_web_stepper.anubis +++ /dev/null @@ -1,89 +0,0 @@ -/* - * Created by PyramIDE. - * User: フランスのトトロ aka (David RENÉ) - * Date: 23/04/2020 - * Time: 19:48 - * © David RENÉ - */ - - -transmit web_session.anubis -transmit xlib/generic/types/stepper.anubis - -public type WEB_Step:... - -// -//public type Step_status: -// initial, -// valid, -// no_valid. - - -public define WEB_Action_Name web_stepper_start = controller_action("web_stepper", "start"). - -public define List((String, String)) - stepper_args - ( - String uid, - String index, - List((String, String)) extra_args - )= - [("stepper_uid",uid), ("step", index) . extra_args] -. - -public define List((String, String)) - stepper_args - ( - String uid, - String index - )= - stepper_args(uid, index, []) -. - -public type Step_View_Status: - invisible, - locked, - selectable -. - -public type WEB_Step_Status: - web_step_status( - String step_name, - Int index, - Step_Status status, - Step_View_Status v_status - ) -. - -public type WEB_Step_Session: - web_step_session( - //List(WEB_Step_Status) web_steps_status, - String current_step, - Session session - ) -. - -public type WEB_Step: - web_step( - String name, //step name - String full_description, - Int index, //step index - String thread, //thread name like general, VoIP, etc. - List(WEB_Step) childs, - (WEB_Step_Session stp_session) -> WEB_Step_Status status, //return the step status - (WEB_Step_Session stp_session, (String)->String _T) -> HTML_Partial_Content view, //return the view according to WEB_Step_Session - (WEB_Step_Session stp_session, (String)->String _T) -> HTML_Partial_Content buttons, - (WEB_Step_Session stp_session, WEB_Session web_session) -> WEB_Step_Session submit, - ) -. - -public type WEB_Stepper: - web_stepper( - String name, //name of the stepper - String uid, //uid of the stepper (currently same as name) - WEB_Action_Name web_controller, - (WEB_Session web_session) -> WEB_Step_Session start, //start function to call at very first time - List(WEB_Step) steps //All available steps in stepper - //Step_Session session - ) -. diff --git a/web/types/web_stepper.anubis b/web/types/web_stepper.anubis new file mode 100644 index 0000000..8cd6715 --- /dev/null +++ b/web/types/web_stepper.anubis @@ -0,0 +1,89 @@ +/* + * Created by PyramIDE. + * User: フランスのトトロ aka (David RENÉ) + * Date: 23/04/2020 + * Time: 19:48 + * © David RENÉ + */ + + +transmit web_session.anubis +transmit xlib/generic/types/stepper.anubis + +public type WEB_Step:... + +// +//public type Step_status: +// initial, +// valid, +// no_valid. + + +public define WEB_Action_Name web_stepper_start = controller_action("web_stepper", "start"). + +public define List((String, String)) + stepper_args + ( + String uid, + String index, + List((String, String)) extra_args + )= + [("stepper_uid",uid), ("step", index) . extra_args] +. + +public define List((String, String)) + stepper_args + ( + String uid, + String index + )= + stepper_args(uid, index, []) +. + +public type Step_View_Status: + invisible, + locked, + selectable +. + +public type WEB_Step_Status: + web_step_status( + String step_name, + Int index, + Step_Status status, + Step_View_Status v_status + ) +. + +public type WEB_Step_Session: + web_step_session( + //List(WEB_Step_Status) web_steps_status, + String current_step, + Session session + ) +. + +public type WEB_Step: + web_step( + String name, //step name + String full_description, + Int index, //step index + String thread, //thread name like general, VoIP, etc. + List(WEB_Step) childs, + (WEB_Step_Session stp_session) -> WEB_Step_Status status, //return the step status + (WEB_Step_Session stp_session, (String)->String _T) -> HTML_Partial_Content view, //return the view according to WEB_Step_Session + (WEB_Step_Session stp_session, (String)->String _T) -> HTML_Partial_Content buttons, + (WEB_Step_Session stp_session, WEB_Session web_session) -> WEB_Step_Session submit, + ) +. + +public type WEB_Stepper: + web_stepper( + String name, //name of the stepper + String uid, //uid of the stepper (currently same as name) + WEB_Action_Name web_controller, + (WEB_Session web_session) -> WEB_Step_Session start, //start function to call at very first time + List(WEB_Step) steps //All available steps in stepper + //Step_Session session + ) +. diff --git a/web/web_arg_encode.anubis b/web/web_arg_encode.anubis new file mode 100644 index 0000000..0859f83 --- /dev/null +++ b/web/web_arg_encode.anubis @@ -0,0 +1,349 @@ + + *Project* The Anubis Project + + *Title* Encoding data for web argument values. + + *Copyright* Copyright (c) Alain Prouté 2002. + + + *Author* Alain Prouté + + + + *Overview* + This file contains encoding and decoding functions which allow to put any serializable + datum as the value of a web argument. The datum is serialized, and the result of + serialization (a byte array) is encoded in such a way that it can safely be used as the + value of a web argument. The encoding process is similar to the standard process + 'base64', but nevertheless different, because base64 is not suitable for that purpose. + + +public define String + web_arg_encode + ( + $T datum + ). + +public define Maybe($T) + web_arg_decode + ( + String encoded_value + ). + + Of course, since the type of the datum is not available from 'encoded_value', a term + like 'web_arg_decode(my_string)' must generally be explicitly typed, like this: + + (Maybe(MyType))web_arg_decode(my_string) + + + These functions are used for example in 'anubis/library/web/kernel.anubis'. + + + + + + --- That's all for the public part. --------------------------------------------------- + +read tools/basis.anubis +read system/convert.anubis + + Our algorithms are copy-pasted from 'base64.anubis' and slightly modified. The point is + twofold: + + (1) base64 encoding inserts carriage return (CR) and line feed (LF) characters every + 76 character, but CR and LF are not suitable in the values of a web argument, + + (2) the base64 alphabet uses '+' and '/', which are also not suitable in the value of + a web argument, because they have special meanings. + + Hence, we just have to modify the base64 algorithms, so as not to generate any CR or + LF, and use '-' and '_' instead of '+' and '/'. Also, we do not use padding characters + '=', which are needless (as remarked in 'anubis/library/tools/base64.anubis'). + + + + *** Encoding. ************************************************************************* + + Translate an index into a wa64 character. + +define Word8 + wa64_alphabet + ( + Word32 index // the index is assumed to be >= 0 and < 64 + ) = + if index -< 0 then print("Bad index [" + index + "] in wa64_alphabet()\n"); '_' else + if index -< 26 then truncate_to_Word8(index+'A') else + if index -< 52 then truncate_to_Word8(index-26+'a') else + if index -< 62 then truncate_to_Word8(index-52+'0') else + if index = 62 then '-' else + if index = 63 then '_' else + print("Bad index [" + index + "] in wa64_alphabet()\n"); '_'. + + + + Transform a group of 3 bytes into a group of 4 wa64 letters. + + +define Word32 + to_word32 + ( + Word8 x + ) = + word32(word16(x,0),0). + +define (Word8,Word8,Word8,Word8) + transform_group + ( + Word8 byte1, + Word8 byte2, + Word8 byte3 + ) = + with n1 = to_word32(byte1), + n2 = to_word32(byte2), + n3 = to_word32(byte3), + ( + wa64_alphabet(n1>>2), + wa64_alphabet(((n1&3)<<4)|(n2>>4)), + wa64_alphabet(((n2&15)<<2)|(n3>>6)), + wa64_alphabet(n3&63) + ). + + + Transform a group of two bytes. + +define ByteArray + two_mod_three + ( + ByteArray result, + Int result_index, + Word8 byte1, + Word8 byte2 + ) = + with n1 = to_word32(byte1), + n2 = to_word32(byte2), + forget(put(result,result_index ,wa64_alphabet(n1>>2))); + forget(put(result,result_index+1,wa64_alphabet(((n1&3)<<4)|(n2>>4)))); + forget(put(result,result_index+2,wa64_alphabet((n2&15)<<2))); + forget(put(result,result_index+4,0)); + result. + + + + Transform a 'group of one byte'. + +define ByteArray + one_mod_three + ( + ByteArray result, + Int result_index, + Word8 byte1 + ) = + with n1 = to_word32(byte1), + forget(put(result,result_index ,wa64_alphabet(n1>>2))); + forget(put(result,result_index+1,wa64_alphabet((n1&3)<<4))); + forget(put(result,result_index+4,0)); + result. + + + +define ByteArray + wa64_encode + ( + ByteArray ba, + Int ba_index, // index into byte array + ByteArray result, + Int result_index + ) = + if nth(ba_index,ba) is + { + failure then forget(put(result,result_index,0)); result, // no new block of 3 bytes + success(byte1) then + if nth(ba_index+1,ba) is + { + failure then one_mod_three(result,result_index,byte1), + success(byte2) then + if nth(ba_index+2,ba) is + { + failure then two_mod_three(result,result_index,byte1,byte2), + success(byte3) then + if transform_group(byte1,byte2,byte3) is (c1,c2,c3,c4) then + ( + forget(put(result,result_index,c1)); + forget(put(result,result_index+1,c2)); + forget(put(result,result_index+2,c3)); + forget(put(result,result_index+3,c4)); + wa64_encode(ba, + ba_index+3, + result, + result_index+4) + ) + } + } + }. + + + +define ByteArray + wa64_encode + ( + ByteArray ba + ) = + with l = length(ba), + wa64_encode(ba,0, + constant_byte_array((((l\57)+1)*76)+10,0),0). + + +public define String + web_arg_encode + ( + $T datum + ) = + to_string(wa64_encode(serialize(datum))). + + + + + + *** Decoding. ************************************************************************* + + See the comments in 'anubis/library/tools/base64.anubis'. + + Checking if a character belongs to the wa64 alphabet. If true, the function returns the + index of the character in the alphabet. + +define Maybe(Word32) + is_wa64_char + ( + Word8 c + ) = + with n = to_word32(c), + if ('A' +=< n & n +=< 'Z') then success(n - 'A') else + if ('a' +=< n & n +=< 'z') then success(n - 'a' + 26) else + if ('0' +=< n & n +=< '9') then success(n - '0' + 52) else + if n = '-' then success(62) else + if n = '_' then success(63) else + failure. + + + + Getting the next wa64 character from the input. The function returns the next position + for reading. The function does not return the character itself, but its index in the + alphabet. + +define Maybe((Int, // next position for reading + Word32)) // index of character in wa64 alphabet + get_next_character + ( + ByteArray ba, + Int n + ) = + if nth(n,ba) is + { + failure then failure, + success(c) then + if is_wa64_char(c) is + { + failure then failure, + success(i) then success((n+1,i)) + } + }. + + + Translating a group of characters into a group of bytes. + +type TranslateGroupResult_WebArg: + three_bytes (Int new_pos, Word8 b1, Word8 b2, Word8 b3), + two_bytes ( Word8 b1, Word8 b2 ), + one_byte ( Word8 b1 ), + zero_bytes, + error. + + +define TranslateGroupResult_WebArg + translate_group + ( + ByteArray ba, + Int n + ) = + if get_next_character(ba,n) is + { + failure then zero_bytes, + success(p1) then if p1 is (n1,i1) then + if get_next_character(ba,n1) is + { + failure then error, + success(p2) then if p2 is (n2,i2) then + if get_next_character(ba,n2) is + { + failure then // we don't check the padding characters + one_byte(truncate_to_Word8((i1<<2)|(i2>>4))), + success(p3) then if p3 is (n3,i3) then + if get_next_character(ba,n3) is + { + failure then + two_bytes(truncate_to_Word8((i1<<2)|(i2>>4)), + truncate_to_Word8(((i2&15)<<4)|(i3>>2))), + success(p4) then if p4 is (n4,i4) then + three_bytes(n4,truncate_to_Word8((i1<<2)|(i2>>4)), + truncate_to_Word8(((i2&15)<<4)|(i3>>2)), + truncate_to_Word8(((i3&3)<<6)|i4)) + } + } + } + }. + + +define Int // returns the size of the decoded array of bytes + translate_groups + ( + ByteArray source, + Int n, // position in source + ByteArray target, + Int m // position in target + ) = + if translate_group(source,n) is + { + three_bytes(n1,b1,b2,b3) then + forget(put(target,m,b1)); + forget(put(target,m+1,b2)); + forget(put(target,m+2,b3)); + translate_groups(source,n1,target,m+3), + + two_bytes(b1,b2) then + forget(put(target,m,b1)); + forget(put(target,m+1,b2)); + m+2, + + one_byte(b1) then + forget(put(target,m,b1)); + m+1, + + zero_bytes then + m, + + error then + m + }. + + +define ByteArray + wa64_decode + ( + ByteArray ba + ) = + with l = length(ba), + result = constant_byte_array(l,'0'), + truncate(result,translate_groups(ba,0,result,0)); + result. + +public define Maybe($T) + web_arg_decode + ( + String encoded_datum + ) = + (Maybe($T))unserialize(wa64_decode(to_byte_array(encoded_datum))). + + + + + diff --git a/web/web_stepper.anubis b/web/web_stepper.anubis new file mode 100644 index 0000000..d2fb75e --- /dev/null +++ b/web/web_stepper.anubis @@ -0,0 +1,339 @@ +/* + * Created by PyramIDE. + * User: フランスのトトロ aka (David RENÉ) + * Date: 24/04/2020 + * Time: 15:12 + * © David RENÉ + */ + +transmit xlib/web/jquery.anubis +transmit xlib/web/types/web_stepper.anubis +transmit xlib/web/controllers_web_site.anubis +read xlib/web/page_message.anubis +read xlib/web/jQuery/jq_button.anubis +read xlib/web_controllers/language/language_management.anubis +read xlib/web/widgets/icons_set.anubis + +public define Maybe(WEB_Stepper) + get_stepper_by_uid + ( + String _uid, + List(WEB_Stepper) steppers + )= + if steppers is + { + [] then + println("get_stepper_by_uid: stepper uid ["+_uid+"] not found"); + failure, + [h . t] then + if h.uid = _uid then + println("get_stepper_by_uid: stepper uid ["+_uid+"] FOUND"); + success(h) + else + get_stepper_by_uid(_uid, t) + } +. + +public define Maybe(WEB_Stepper) + get_stepper + ( + List(Web_arg) _lwa, + List(WEB_Stepper) steppers + )= + if get_String(_lwa, "stepper_uid") is + { + failure then + println("get_stepper: stepper_uid not found"); + failure + success(stepper_uid) then get_stepper_by_uid(stepper_uid, steppers) + } +. + +public define Maybe(WEB_Step) + get_current_step + ( + List(WEB_Step) steps, + String current_step + )= + if steps is + { + [] then + println("get_current_step ["+current_step+"] not found"); + failure, + [h . t] then + if h.name = current_step then + success(h) + else + if get_current_step(h.childs, current_step) is + { + failure then get_current_step(t, current_step), + success(step) then success(step) + } + } +. + +public define Maybe(WEB_Step) + get_step + ( + List(Web_arg) _lwa, + List(WEB_Step) steps, + )= + if get_String(_lwa, "step") is + { + failure then failure + success(step) then get_current_step(steps, step) + } +. + +public define HTML_Partial_Content + web_stepper_button + ( + WEB_Step _step, + WEB_Step_Session stp_session, + (String)->String _T + )= + partial_content( + div(class("stepper_buttons"), + _step.buttons(stp_session, _T))) +. + +public define HTML_Partial_Content + web_stepper_main_view + ( + WEB_Step _step, + WEB_Step_Session stp_session, + (String)->String _T + )= + partial_content( + div(class("stepper_main_view"), + _step.view(stp_session, _T))) +. + +public define HTML_Partial_Content + web_stepper_message + ( + WEB_Step_Session stp_session, + (String)->String _T + )= + with page_msg = get_Page_Message(stp_session.session.fields, _T), + //if there is no message return empty to avoid to have an empty div with padding + if page_msg = no_message then + partial_empty + else + partial_content( + div(class("stepper_message"), + show_page_message(page_msg))) +. + +public define HTML_Partial_Content + web_stepper_full_description + ( + WEB_Step current_step, + (String)->String _T + )= + if current_step.full_description = "" then + partial_content(empty) + else + partial_content( + div(class("stepper_full_description"), + text(_T(current_step.full_description)))) +. + +public define Bool + is_current + ( + WEB_Step step, + WEB_Step current_step + )= + current_step.name = step.name +. + +public define Bool + is_active + ( + WEB_Step step, + WEB_Step current_step + )= + step.index < current_step.index +. + +public define HTML_Partial_Content + web_stepper_crumble + ( + WEB_Stepper _stepper, + WEB_Step _current_step, + (String) -> String _T + )= + partial_content( + div(class("stepper_crumble"), + div(class("multi-step"), + ul(class("multi-step-list"), + + map((WEB_Step step) |-> + with active = if is_active(step, _current_step) then " active" else "", + current = if is_current(step, _current_step) then " current" else "", + with go = if is_active(step, _current_step) then + with url = format_web_action_name_to_js(_stepper.web_controller, [("stepper_uid",_stepper.uid), ("step",step.name), ("step_a", "go")]), + event(onclick, "stepper_go("+url+");") + else + empty, + + li([class("multi-step-item"+active+current), + go], + div(class("item-wrap"), + p(class("item-title"), + text(_T(to_upper(step.name))) + ) + ) + ) + , + _stepper.steps + ) + + ) + ) + ) + ) +. + +public define HTML_Partial_Content + web_stepper_view + ( + WEB_Stepper _stepper, + WEB_Step _current_step, + WEB_Step_Session stp_session, + (String)->String _T + )= + println("web_stepper_view _current_step.name ["+_current_step.name+"]"); + + partial_content([ + css(css_file("xlib/css/stepper.css")), + js(js_file("xlib/js/stepper.js")), + js_inline(jquery_ready("$('#stepper_form').on('submit', function(e) { e.stopPropagation(); return false; });")) + ], [ + div([id("stepper"), class("stepper")], [ + form([id("stepper_form")],[ + hidden("step", _current_step.name), //add current step name as hidden argument + hidden("stepper_uid",_stepper.uid), //add stepper_uid as hidden argument + //construct bread crumb line + partial(web_stepper_crumble(_stepper, _current_step, _T)), + partial(web_stepper_full_description(_current_step, _T)), + partial(web_stepper_message(stp_session, _T)), + partial(web_stepper_main_view(_current_step, stp_session, _T)), //OK + partial(web_stepper_button(_current_step, stp_session, _T)) + ]) + ]) + ]) + +. + +public define HTML_Partial_Content + web_stepper_view + ( + WEB_Stepper stepper, + WEB_Step_Session stp_session, + (String)->String _T + )= + println("web_stepper_view without step. stp_session.current_step ["+stp_session.current_step+"]"); + if get_current_step(stepper.steps, stp_session.current_step) is + { + failure then partial_content(empty) + success(_current_step) then web_stepper_view(stepper, _current_step, stp_session, _T) + } +. + +public define WEB_Controller_Result + manage_stepper_action + ( + List(Web_arg) _lwa, + WEB_Session _web_session, + WEB_Stepper _stepper, + WEB_Step _step + )= + with stepper_session = web_step_session(_step.name, get_Session(_web_session.fields, _stepper.uid, session(_stepper.uid, empty_fields_list))), + _T = make_translate_function(_web_session), + println("manage_stepper_action step_session\n"+dump_Session_Field_list(*stepper_session.session.fields,"")); + + with action = get_String(_lwa, "step_a", "N/A"), + println("manage_stepper_action ["+action+"]"); + if action = "submit" then + println("manage_stepper_action submit step["+_step.name+"]"); + with new_session = _step.submit(stepper_session, _web_session), + //TODO must store new session in WEB session + println("store new_session\n"+dump_Session(new_session.session,"")); + replace_Session(_web_session.fields, _stepper.uid, new_session.session); + ajax(_web_session, web_stepper_view(_stepper, new_session, _T)) + +// ajax(_session, no_content) + else if action = "go" then + set_Page_Message(stepper_session.session.fields, no_message); + replace_Session(_web_session.fields, _stepper.uid, stepper_session.session); + ajax(_web_session, web_stepper_view(_stepper, stepper_session, _T)) + else if action = "init" then + ajax(_web_session, no_content) + else + ajax(_web_session, no_content) +. + +public define WEB_Controller_Result + manage_stepper + ( + WEB_Session _web_session, + List(WEB_Stepper) _steppers + )= + with _lwa = *_web_session.web_request.lwa, + println("manage_stepper"); + if get_stepper(_lwa, _steppers) is + { + failure then + println("stepper not found"); + ajax(_web_session, no_content), + success(stepper) then + //get session of the stepper + if get_String(_lwa, "step") is + { + failure then + println("manage_stepper step not found "); + ajax(_web_session, no_content) + success(step_name) then + println("manage_stepper step_name = "+step_name); + if step_name = "start" then + with _T = make_translate_function(_web_session), + with initial_step_session = stepper.start(_web_session), + println("store initial_step_session\n"+dump_Session(initial_step_session.session,"")); + replace_Session(_web_session.fields, stepper.uid, initial_step_session.session); + ajax(_web_session, web_stepper_view(stepper, initial_step_session, _T)) + else + + if get_current_step(stepper.steps, step_name) is + { + failure then ajax(_web_session, no_content), + success(step) then + manage_stepper_action(_lwa, _web_session, stepper, step) + } + } + + } +. + +public define HTML_Partial_Content + stepper_submit_button + ( + String label, + WEB_Action_Name wan, + String submit_action, + List((String, String)) extra_args + )= + with url = format_web_action_name_to_js(wan,[("step_a", "submit"), ("submit_a",submit_action) . extra_args]), + jquery_button(jquery_img_button(icn16_check, label, "", jQuery_actioner(same, jqscript("stepper_submit("+url+");")), left)) +. + +public define HTML_Partial_Content + stepper_submit_button + ( + String label, + WEB_Action_Name wan, + String submit_action, + )= + stepper_submit_button(label, wan, submit_action, []) +. diff --git a/web/widgets/button.anubis b/web/widgets/button.anubis index 39f389c..ec89be6 100644 --- a/web/widgets/button.anubis +++ b/web/widgets/button.anubis @@ -209,7 +209,8 @@ define List(CoreAttrs) with ok_action = if load_content_target = "" then to_JS_String("Xlib.jq_query("+format_web_action_name_to_js(web_action, extra_ops)+")") else - to_JS_String("Xlib.ajax_load_content('"+load_content_target+"', "+format_web_action_name_to_js(web_action, extra_ops)+", true)"), + load_content_JS_String(load_content_target, web_action, extra_ops, true), + //to_JS_String("Xlib.ajax_load_content('"++"', "+format_web_action_name_to_js(web_action, extra_ops)+", true)"), core_attrs + [id(uid), style("cursor: pointer"), event(onclick, "Xlib.make_confirm_dialog(this, "+ ok_action +");")]. @@ -299,7 +300,7 @@ public define HTML_Partial_Content String load_content_target //if empty doesn't use load content ) = with uid = generate_random_string(20), - //with event_click = (CoreAttrs)event(onclick, "CalexiumToolBox.jq_query("+format_web_action_name_to_js(web_action, extra_ops)+")"), + //with event_click = (CoreAttrs)event(onclick, "Xlib.jq_query("+format_web_action_name_to_js(web_action, extra_ops)+")"), partial_content([js(js_file("xlib/js/xlib.js")), js_inline(jquery_ready(img_button_confirm_js(uid, dlg_title, dlg_text, dlg_ok, dlg_cancel)))], img(img_button_confirm_image_attrs(core_attrs, uid, web_action, extra_ops, load_content_target), img_path)) diff --git a/web/widgets/dashboard.anubis b/web/widgets/dashboard.anubis index d483cec..f7568cb 100644 --- a/web/widgets/dashboard.anubis +++ b/web/widgets/dashboard.anubis @@ -8,8 +8,8 @@ read tools/basis.anubis -read xlib/web/CXM_common.anubis -read xlib/web/CXM_making_a_web_site.anubis +read xlib/web/common.anubis +read xlib/web/making_a_web_site.anubis transmit css_helper.anubis diff --git a/web/widgets/fisheye_menu.anubis b/web/widgets/fisheye_menu.anubis index 7697a26..87e62f1 100644 --- a/web/widgets/fisheye_menu.anubis +++ b/web/widgets/fisheye_menu.anubis @@ -7,9 +7,9 @@ */ transmit tools/basis.anubis -transmit xlib/web/CXM_making_a_web_site.anubis -read xlib/web/jQuery/CXM_jquery_animate.anubis -read xlib/web/CXM_jquery.anubis +transmit xlib/web/making_a_web_site.anubis +read xlib/web/jQuery/jquery_animate.anubis +read xlib/web/jquery.anubis public type FisheyeEntry: fisheye_entry( diff --git a/web/widgets/icon.anubis b/web/widgets/icon.anubis index 0a46f5f..b6a6220 100644 --- a/web/widgets/icon.anubis +++ b/web/widgets/icon.anubis @@ -7,7 +7,7 @@ */ transmit xlib/web/fonts/awesome.anubis -read xlib/web/CXM_making_a_web_site.anubis +read xlib/web/making_a_web_site.anubis public type Icon: no_icon, diff --git a/web/widgets/left_menu_html.anubis b/web/widgets/left_menu_html.anubis index 342c114..4ee1d5f 100644 --- a/web/widgets/left_menu_html.anubis +++ b/web/widgets/left_menu_html.anubis @@ -7,8 +7,8 @@ */ transmit xlib/web/widgets/left_menu.anubis -read xlib/web/CXM_making_a_web_site.anubis -read xlib/web/CXM_web_action.anubis +read xlib/web/making_a_web_site.anubis +read xlib/web/web_action.anubis read xlib/web/load_content.anubis define List(HTML_Off_Form) @@ -33,7 +33,7 @@ define List(HTML_Off_Form) failure then p([class(item_class+_menu_id+"_icon"+if _menu_id=selected then " selected" else ""+ " "+join(" ", _classes))],actioner(same,same, link(_T(_text)),_action,_extra)), success(target_id) then p([class(item_class+"clickable "+_menu_id+"_icon"+if _menu_id=selected then " selected" else ""+ " "+join(" ", _classes)), -// event(onclick, "CalexiumToolBox.ajax_load_content('"+target_id+"', "+format_web_action_name_to_js(_action, _extra)+")")],text(_T(_text))), +// event(onclick, "Xlib.load_content('"+target_id+"', "+format_web_action_name_to_js(_action, _extra)+")")],text(_T(_text))), event(onclick, load_content(target_id, _action, _extra))],text(_T(_text))), } diff --git a/web/widgets/menu.anubis b/web/widgets/menu.anubis index 48aeae1..0c853ce 100644 --- a/web/widgets/menu.anubis +++ b/web/widgets/menu.anubis @@ -10,7 +10,7 @@ transmit tools/basis.anubis read system/string.anubis -read xlib/web/CXM_making_a_web_site.anubis +read xlib/web/making_a_web_site.anubis transmit xlib/web/widgets/icon.anubis public type Menu_Item: @@ -224,7 +224,7 @@ public define HTML_Partial_Content { no_menu then partial_content(empty), menu(items) then - partial_content([css(css_file("/css/cxm/cxm_menu.css"))], + partial_content([css(css_file("xlib/css/menu.css"))], //partial_content([css(css_file("/css/admin_theme.css"))], sequence(make_menu(_T, items, _direction))) }. diff --git a/web/widgets/pager.anubis b/web/widgets/pager.anubis index 1aba7d7..3a7c40f 100644 --- a/web/widgets/pager.anubis +++ b/web/widgets/pager.anubis @@ -6,8 +6,8 @@ * © David RENÉ */ -read xlib/web/CXM_making_a_web_site.anubis -read xlib/web/CXM_web_session.anubis +read xlib/web/making_a_web_site.anubis +read xlib/web/web_session.anubis public define HTML_Partial_Content control_panel_pager @@ -17,7 +17,7 @@ public define HTML_Partial_Content String next ) = - partial_content([js(js_file("js/cxm/cxm_pager.js"))], + partial_content([js(js_file("xlib/js/pager.js"))], div(id(pager_id), [ text(class("o_pager_current_page"),"0"), text("/"), diff --git a/web/xml_rpc.anubis b/web/xml_rpc.anubis new file mode 100644 index 0000000..75ab0e1 --- /dev/null +++ b/web/xml_rpc.anubis @@ -0,0 +1,418 @@ +/* + * Created by PyramIDE. + * User: Totoro + * Date: 29/06/2013 + * Time: 00:47 + * + */ + +read tools/base64.anubis +transmit tools/basis.anubis +read tools/connections.anubis +read system/convert.anubis +transmit system/string.anubis +read xlib/web/common.anubis +read xlib/web/http_get_common.anubis +read xlib/web/multihost_http_server.anubis +transmit xlib/web/xml_rpc_parser.anubis +transmit xlib/web/xml_rpc_types.anubis + + +define XML_RPC_parameters sysinfo_params = + parameters + [ + parameter[int(1)], + parameter[bool(true)], + parameter[string("This is a string")], + parameter[double(1.45)], + parameter[datetime("date to do")], + parameter[base64("Base 64 content")], + parameter[struct(members([ + member("1st member", int(2)), + member("2nd member", string("this is the 2nd string")) + ]))], + parameter[array(array([ + int(3), + string("3rd string") + ]))] + ]. + +define XML_RPC_parameters empty_param = parameters []. + +public type XML_RPC_Result: + cannot_resolve_server_name(DNS_Result), + cannot_connect_to_server(NetworkConnectError), + transmission_problem, + request_refused_by_server, + ok(String response, // HTTP response line from the server + List(HTTP_header) headers, // HTTP headers received from the server + String document). // The HTML document itself + +public type XML_RPC_Auth: + none, + basic(String login, String password). + +public type XML_RPC_client: + xml_rpc_client( + Connection conn, + XML_RPC_Auth auth, + String url, + String user_agent, + String host). + +define String + tab + ( + Int position + )= + to_string(constant_byte_array(position * 2, ' ')). + +define String format_struct(XML_RPC_struct structure, Int position). +define String format_array(XML_RPC_array array, Int position). + +define String format_int_value ( Word32 value) = ""+to_String(value)+"" + crlf. +define String format_boolean_value ( Bool value) = ""+to_String_value(value)+"" + crlf. +define String format_string_value ( String value) = ""+value+"" + crlf. +define String format_double_value ( Float value) = ""+float_to_string(value, 10)+"" + crlf. +define String format_datetime_value ( String value) = ""+value+"" + crlf. +define String format_base64_value ( String value) = ""+value+"" + crlf. +define String format_nil = "" + crlf. + + +define String + format_value + ( + XML_RPC_value rpc_value, + Int position + )= + with return = if rpc_value is + { + int(value) then format_int_value(value), + bool(value) then format_boolean_value(value), + string(value) then format_string_value(value), + double(value) then format_double_value(value), + datetime(value) then format_datetime_value(value), + base64(value) then format_base64_value(value), + struct(value) then format_struct(value, position + 1), + array(value) then format_array(value, position + 1), + nil then format_nil + }, + tab(position) + return. + + +define String + _format_struct + ( + String so_far, + List(XML_RPC_struct_member) members, + Int position + )= + if members is + { + [] then so_far, + [h . t] then + if h is member(name, val) then + _format_struct( so_far + tab(position) + "" + crlf + + tab(position + 1)+""+name+"" + crlf + + format_value(val, position + 1) + + tab(position + 1) + "" + crlf, + t, + position) + }. + +define String + format_struct + ( + XML_RPC_struct struct, + Int position + ) = + if struct is members(structure_members) then + /*tab(position) +*/ "" + crlf + + _format_struct("", structure_members, position+1)+ + tab(position + 1) + "" + crlf. + +define String + _format_array + ( + String so_far, + List(XML_RPC_value) values, + Int position + )= + if values is + { + [] then so_far, + [h . t] then _format_array( so_far + format_value(h, position), t, position) + }. + +define String + format_array + ( + XML_RPC_array arr, + Int position + ) + = + if arr is array(values) then + /*tab(position) +*/ "" + crlf + + tab(position + 1) + "" + crlf+ + _format_array("", values, position + 2)+ + tab(position+2)+"" + crlf + + tab(position + 1) + "" + crlf. + +public define String + format_xml_rpc_values + ( + List(XML_RPC_value) values, + Int position, + String so_far + )= + if values is + { + [] then so_far, + [ h . t ] then + format_xml_rpc_values(t, position, so_far + format_value(h, position)) + }. + +public define String + format_xml_rpc_parameter + ( + XML_RPC_parameter param, + Int position + )= + if param is parameter(values) then + format_xml_rpc_values(values, position, "") + . + + +define String + _format_xml_rpc_parameters + ( + String so_far, + List(XML_RPC_parameter) params, + Int position + )= + if params is + { + [] then so_far, + [ h . t ] then + _format_xml_rpc_parameters( so_far + tab(position) + "" + crlf + + format_xml_rpc_parameter(h, position + 1) + + tab(position+1) + "" + crlf, + t, + position) + }. + +public define String + format_xml_rpc_parameters + ( + XML_RPC_parameters params, + Int position + )= + if params is parameters(list_param) then + tab(position)+"" + crlf + + _format_xml_rpc_parameters("", list_param, position+1) + + tab(position+1)+"". + +public define String + format_xml_rpc_fault + ( + XML_RPC_value value, + Int position + )= + tab(position)+"" + crlf + + format_value(value, position+1) + + tab(position+1)+"". + +public define Bool + accept_policy + ( + Maybe(X509) suspect_certificate + ) = true. + +public define Maybe(XML_RPC_client) + xml_rpc_new_client + ( + String server_name, + Bool use_ssl, + XML_RPC_Auth auth, + String user_agent, + String host + )= + if separate_name_port(server_name, if use_ssl then 443 else 80) is (name, server_port) then + // + // resolve server name and call 'https_get' with numeric server address: + // + with a = dns(name), + if a is ok(server_addr) then + //connect to server with right protocol + if use_ssl then + //println("SSL "+server_port+ " "+server_name); + if open_SSL_connection(server_name, server_addr, server_port, accept_policy) is + { + error(msg) then failure, + ok(conn) then success(xml_rpc_client(ssl(conn), auth, server_name, user_agent, host)) + } + else + //println("TCP "+server_port+ " "+server_name); + if (Result(NetworkConnectError,RWStream))connect(server_addr, server_port) is + { + error(e) then failure, + ok(conn) then success(xml_rpc_client(tcp(conn), auth, server_name, user_agent, host)) + } + else + failure. +define Maybe(XML_RPC_response) + receive + ( + Bool print_dump, + Connection conn + )= + //TODO find the header and content-lenght to get full length of answer + + if read(conn, 16384, 5) is + { + error then println("Read error");failure, + timeout then println("Read timeout");failure, + ok(ba) then + with xml_response = to_string(ba), + typed_response = xml_rpc_get_response(xml_response), + (if print_dump then + + println("=== Server answer ==="+crlf + xml_response ); + println("=== XML_RPC Anubis interpretation ==="); + + if typed_response is + { + failure then println("Interpretation error"), + success(result) then + if result is + { + ok(ok_res) then println(format_xml_rpc_parameters(ok_res,1)), + fault(fault) then println(format_xml_rpc_fault(fault,1)) + } + + } + else unique); + typed_response + } + . + +define Maybe(XML_RPC_response) + receive_new + ( + Bool print_dump, + Connection conn + )= + //TODO find the header and content-lenght to get full length of answer + //construct a buffered connection + with b_con = http_buffered_connection(conn), + if skip_line(b_con) is + { + error(msg) then print(format(msg));failure, + ok(_) then + if read_http_headers(b_con) is + { + error(msg) then print(format(msg));failure, + ok(headers) then + if get_body_size(headers) is + { + error(msg) then print(format(msg));failure, + ok(body_size) then + if read_http_body(b_con, body_size, constant_byte_array(0,0), 1000) is + { + error(msg) then print(format(msg));failure, + ok(body) then + with xml_response = to_string(body), + with typed_response = xml_rpc_get_response(xml_response), + (if print_dump then + + println("=== Server answer ==="+crlf + xml_response); + println("=== XML_RPC Anubis interpretation ==="); + + if typed_response is + { + failure then println("Interpretation error"), + success(result) then + if result is + { + ok(ok_res) then println(format_xml_rpc_parameters(ok_res,1)), + fault(fault) then println(format_xml_rpc_fault(fault,1)) + } + + } + else unique); + typed_response + } + } + }} + . + +public define Maybe(XML_RPC_response) + xml_rpc_client_execute + ( + Bool print_dump, + XML_RPC_client client, + String url, + String method_name, + XML_RPC_parameters params + //(XML-string)->$T answer_handler //convert the xml answer to anubis type + )= + if client is xml_rpc_client(conn, auth, server_name, user_agent, host) then + //execute the method on remote server + // - 1 - Format the xml body to comply with XML RPC + with body = "" + crlf + + tab(1)+"" + crlf + + tab(2)+"" + method_name +"" + crlf + + format_xml_rpc_parameters(params, 2) + + tab(1)+"", + + // - 2 - Format the POST HTTP request + with request = "POST "+url+" HTTP/1.1"+ crlf + //HTTP/1.1 is very important because it allow to send multiple execute + "User-Agent: "+ user_agent + crlf + //with only one connection (keep-alive is default in http 1.1) + "Host: " + server_name + crlf + + "Content-type: text/xml" + crlf + + if auth is + { + none then "", + basic(login, pass) then "Authorization: Basic "+base64_encode(login+":"+pass)+ crlf + }+ + "Content-length: " + length(body)+ crlf + + + //format_headers(headers) + + crlf + + body, + + // - 3 - send it to remote + + // + // Send the HTTP request, and receive the answer: + // + (if print_dump then + ( + print("----- request ----\n"); + print(request); + print("\n") + ) else unique); + + if write(conn, to_byte_array(request)) is + { + failure then failure, + success(_) then receive_new(print_dump, conn) + }. + + //wait the answer + + + global define One + xml_rpc_test + ( + List(String) args + )= + if xml_rpc_new_client("mail.calexium.com:33610", true, basic("admin","the secret passsword"), "Anubis XML-RPC", "127.0.0.1") is + { + failure then println(" xml_rpc_test new client failure"), + success(rpc_client) then + forget(xml_rpc_client_execute(false, rpc_client, "/Settings", "list_domains", empty_param)) + //forget(xml_rpc_client_execute(true, rpc_client, "/Settings", "delete_domain", parameters([parameter[string("amisdefontainebleau.org")]]))) + //forget(xml_rpc_client_execute(true, rpc_client, "/Settings", "create_domain", empty_param)) + }. + diff --git a/web/xml_rpc_parser.anubis b/web/xml_rpc_parser.anubis new file mode 100644 index 0000000..90c4dc8 --- /dev/null +++ b/web/xml_rpc_parser.anubis @@ -0,0 +1,481 @@ +/* + * Created by PyramIDE. + * User: Totoro + * Date: 06/07/2013 + * Time: 01:13 + * + */ + +read xlib/web/xml_rpc_types.anubis +read tools/streams.anubis +read tools/basis.anubis +read system/string.anubis +read system/convert.anubis + +type XML_RPC_Token: + none, + token(String token). + +define Maybe(XML_RPC_value) read_value(Stream stream). + +define XML_RPC_Token + _next_xml_token + ( + Stream stream, + List(Word8) so_far, + Bool in_token + )= + if read_byte(stream) is + { + failure then none, //can't read on stream !! + success(b) then + //println("["+implode([b])+"]"); + if in_token then + if b = '>' then //just found the end of bracket, so we return the token in LOWER case + with tok = to_lower(implode(reverse(so_far))), + //println("found tag "+tok); + token(tok) + else + _next_xml_token(stream, [b . so_far], in_token) + else + if b = '<' then //just found the begin of token + _next_xml_token(stream, [], true) + else + _next_xml_token(stream, so_far, in_token) + } + . + + + +define XML_RPC_Token + next_xml_token + ( + Stream stream + )= _next_xml_token(stream, [], false). + +define Maybe(String) + _xml_tag_content + ( + Stream stream, + String tag, //tag to match + List(Word8) so_far, + List(Word8) content, + Bool in_first_token, + Bool in_content, + Bool in_last_token + + )= + if read_byte(stream) is + { + failure then failure, //can't read on stream !! + success(b) then + if in_first_token then + if b = '>' then //just found the end of bracket, so we return the token in LOWER case + if to_lower(implode(reverse(so_far))) = tag then + _xml_tag_content(stream, tag, [], [], false, true, false) + else + failure + else + _xml_tag_content(stream, tag, [b . so_far], content, in_first_token, in_content, in_last_token) + else if in_content then + if b = '<' then //just found the begin bracket, + if read_byte(stream) is + { + failure then failure, //can't read on stream !! + success(_b) then + if _b = '/' then //can't find / => syntax error + _xml_tag_content(stream, tag, [], content, false, false, true) + else + failure + } + else + _xml_tag_content(stream, tag, [], [b . content], false, true, false) + else if in_last_token then + if b = '>' then //just found the end of bracket, so we return the token in LOWER case + if to_lower(implode(reverse(so_far))) = tag then + with _content = implode(reverse(content)), + println("Tag ["+tag+"] content found ["+_content+"]"); + success(_content) + else + failure + else + _xml_tag_content(stream, tag, [b . so_far], content, false, false, true) + + else + if b = '<' then //just found the begin of token + _xml_tag_content(stream, tag, [], [], true, false, false) + else + _xml_tag_content(stream, tag, [], [], false, false, false) + } + . +define Maybe(String) + xml_pair_tag_content + ( + Stream stream, + String tag + )= _xml_tag_content( stream, tag, [], [], false, false, false). + +define Maybe(String) + xml_tag_content + ( + Stream stream, + String tag + )= _xml_tag_content( stream, tag, [], [], false, true, false). + + /***** ARRAY functions ******/ + +define Maybe(List(XML_RPC_value)) + read_values + ( + Stream stream, + List(XML_RPC_value) so_far + )= + if read_value(stream) is + { + failure then failure, + success(value) then + if next_xml_token(stream) is + { + none then failure, + token(token) then + + if token = "value" then //there is another value we read it + read_values(stream, [value . so_far]) + else + unput_string("<"+token+">", stream); + success(reverse([value . so_far])) + } + }. + +define Maybe(List(XML_RPC_value)) + read_data + ( + Stream stream + )= + if next_xml_token(stream) is + { + none then failure, + token(token) then + if token = "data" then + if next_xml_token(stream) is + { + none then failure, + token(token) then + if token = "value" then + if read_values(stream, []) is + { + failure then failure + success(values) then + if next_xml_token(stream) is + { + none then failure, + token(token) then + if token = "/data" then + success(values) + else + failure + } + } + // mean empty array + else if token = "/data" then + success([]) + else + failure + } + else + failure + }. + +define Maybe(XML_RPC_value) + read_array + ( + Stream stream + )= + if read_data(stream) is + { + failure then failure + success(values) then + if next_xml_token(stream) is + { + none then failure, + token(token) then + if token = "/array" then + success(array(array(values))) + else + failure + } + }. + + /***** STRUCT functions ******/ + +define Maybe(List(XML_RPC_struct_member)) + read_members + ( + Stream stream, + List(XML_RPC_struct_member) so_far + )= + if xml_pair_tag_content(stream, "name") is + { + failure then failure, + success(member_name) then + if next_xml_token(stream) is + { + none then failure, + token(tok) then + if tok = "value" then + if read_value(stream) is + { + failure then failure, + success(value) then + if next_xml_token(stream) is + { + none then failure, + token(tok) then + if tok = "/member" then + if next_xml_token(stream) is + { + none then failure, + token(tok) then + if tok = "member" then //there is another member in structure, we read it + read_members(stream, [member(member_name, value) . so_far]) + else if tok = "/struct" then //End of structrue found + //println("End struct"); + success(reverse([member(member_name, value) . so_far])) //return all members in right order + else + failure //unexpected token + } + else + failure + } + } + else + failure + } + } . + +define Maybe(XML_RPC_value) + read_struct + ( + Stream stream + )= + if next_xml_token(stream) is + { + none then failure, + token(token) then + //there is member hence read it + if token = "member" then + + if read_members(stream, []) is + { + failure then failure + success(members_list) then success(struct(members(members_list))) + } + //the immediate following token is . Hence this is an empty struct + else if token = "/struct" then + success(struct(members([]))) + else + failure + }. + +define Maybe(XML_RPC_value) + read_value + ( + Stream stream + )= + if next_xml_token(stream) is + { + none then failure, + token(token) then + with value = if token = "string" then + if xml_tag_content(stream, "string") is + { + failure then failure, + success(v) then success(string(v)) + } + else if token = "int" then + if xml_tag_content(stream, "int") is + { + failure then failure, + success(v) then + if decimal_scan(v) is + { + failure then failure, + success(int_v) then success(int(truncate_to_Word32(int_v))) + } + } + else if token = "i4" then + if xml_tag_content(stream, "i4") is + { + failure then failure, + success(v) then + if decimal_scan(v) is + { + failure then failure, + success(int_v) then success(int(truncate_to_Word32(int_v))) + } + } + else if token = "boolean" then + if xml_tag_content(stream, "boolean") is + { + failure then failure, + success(v) then success(bool(to_Bool(v))) + } + else if token = "double" then + if xml_tag_content(stream, "string") is + { + failure then failure, + success(v) then success(double(0.0)) + } + else if token = "datetime" then + if xml_tag_content(stream, "string") is + { + failure then failure, + success(v) then success(datetime(v)) + } + else if token = "base64" then + if xml_tag_content(stream, "base64") is + { + failure then failure, + success(b64) then success(base64(b64)) + } + else if token = "struct" then read_struct(stream) + else if token = "array" then read_array(stream) + else if token = "nil/" then success(nil) + else + println("Unknown token ["+token+"]"); + failure, + if next_xml_token(stream) is + { + none then failure + token(token) then + if token = "/value" then + value + else + failure + } + }. + +define Maybe(XML_RPC_parameter) + in_value + ( + Stream stream, + List(XML_RPC_value) so_far + )= + if next_xml_token(stream) is + { + none then failure, + token(tok) then + if tok = "value" then + if read_value(stream) is + { + failure then failure, + success(value) then in_value(stream, [ value. so_far]) + } + else if tok = "/param" then + success(parameter(reverse(so_far))) + else + failure + }. + +define Maybe(XML_RPC_value) + in_fault + ( + Stream stream, + )= + if next_xml_token(stream) is + { + none then failure, + token(tok) then + if tok = "value" then + if read_value(stream) is + { + failure then failure, + success(value) then + if next_xml_token(stream) is + { + none then failure, + token(tok) then + if tok = "/fault" then + success(value) + else + failure + } + } + else + failure + }. + +define Maybe(XML_RPC_parameters) + in_param + ( + Stream stream, + List(XML_RPC_parameter) so_far + )= + if next_xml_token(stream) is + { + none then failure, + token(tok) then + if tok = "param" then + if in_value(stream, []) is + { + failure then failure, + success(param) then in_param(stream, [ param . so_far]) + } + + else if tok = "/params" then + success(parameters(reverse(so_far))) + else + failure + } + . + +define Maybe(XML_RPC_response) + in_params + ( + Stream stream + )= + if next_xml_token(stream) is + { + none then failure, + token(tok) then + if tok = "params" then + if in_param(stream, []) is + { + failure then failure, + success(resp) then success(ok(resp)) + } + else if tok = "fault" then + if in_fault(stream) is + { + failure then failure, + success(resp) then success(fault(resp)) + } + else + failure + } + + . + +public define Maybe(XML_RPC_response) + xml_rpc_get_response + ( + String response + )= + with stream = make_stream(response), + if next_xml_token(stream) is + { + none then failure + token(tok) then + if tok = "?xml version='1.0'?" then + if next_xml_token(stream) is + { + none then failure + token(_tok) then + if _tok = "methodresponse" then + in_params(stream) + else + failure + } + else + failure + }. diff --git a/web/xml_rpc_types.anubis b/web/xml_rpc_types.anubis new file mode 100644 index 0000000..6f2dd06 --- /dev/null +++ b/web/xml_rpc_types.anubis @@ -0,0 +1,113 @@ +/* + * Created by PyramIDE. + * User: Totoro + * Date: 06/07/2013 + * Time: 15:27 + */ + +transmit tools/basis.anubis + +public type XML_RPC_struct:... +public type XML_RPC_array:... + +public type XML_RPC_value: + int(Word32), + bool(Bool), + string(String), + double(Float), + datetime(String), + base64(String), + struct(XML_RPC_struct), + array(XML_RPC_array), + nil. + +public type XML_RPC_array: + array(List(XML_RPC_value)). + +public type XML_RPC_struct_member: + member(String name, XML_RPC_value value). + +public type XML_RPC_struct: + members(List(XML_RPC_struct_member)). + +public type XML_RPC_parameter: + parameter(List(XML_RPC_value)). + +public type XML_RPC_parameters: + parameters(List(XML_RPC_parameter)). + +public type XML_RPC_response: + ok(XML_RPC_parameters params), + fault(XML_RPC_value fault). + +public define XML_RPC_value +/* convert a list of String to XML_RPC_array +*/ + to_XML_RPC_array + ( + List(String) l_strings + )= + array(array(map((String _str) |-> string(_str), l_strings))). + + +public define Maybe(XML_RPC_parameter) + get_first_parameter + ( + XML_RPC_parameters params + )= + since params is parameters(param_list), + if param_list is + { + [] then failure, + [h . t] then success(h) + }. + +public define Maybe(XML_RPC_struct) + get_first_struct + ( + List(XML_RPC_parameter) params + )= + if params is + { + [] then failure, + [h . t] then + since h is parameter(values), + if values is + { + [] then get_first_struct(t), + [val . _ ] then + if val is struct(content) then + success(content) + else + get_first_struct(t) + } + }. + +public define Maybe(XML_RPC_value) + get_member + ( + List(XML_RPC_struct_member) struct, + String member_name + )= + if struct is + { + [] then failure, + [h . t] then + since h is member(name, value), + if name = member_name then + success(value) + else + get_member(t, member_name) + }. + +public define XML_RPC_struct + struct_add_member + ( + XML_RPC_struct rpc_struc, + String name, + XML_RPC_value value + )= + since rpc_struc is members(members_list), + members([member(name, value) . members_list]) + . + -- libgit2 0.21.4