From f69037ea493a13e6687d7c068acb40bae87c4761 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Fri, 11 Oct 2013 17:15:28 -0400 Subject: New header file scheme to support FFI code in either of C or C++ [based on suggestion by Ron de Bruijn] --- include/urweb/urweb_cpp.h | 373 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 373 insertions(+) create mode 100644 include/urweb/urweb_cpp.h (limited to 'include/urweb/urweb_cpp.h') diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h new file mode 100644 index 00000000..91342933 --- /dev/null +++ b/include/urweb/urweb_cpp.h @@ -0,0 +1,373 @@ +#ifndef URWEB_CPP_H +#define URWEB_CPP_H + +#include + +#include "types_cpp.h" + +int uw_really_send(int sock, const void *buf, ssize_t len); +int uw_really_write(int fd, const void *buf, size_t len); + +extern uw_unit uw_unit_v; + +void uw_global_init(void); +void uw_app_init(uw_app*); + +void uw_client_connect(unsigned id, int pass, int sock, + int (*send)(int sockfd, const void *buf, size_t len), + int (*close)(int fd), + void *logger_data, uw_logger log_error); +void uw_prune_clients(struct uw_context *); +failure_kind uw_initialize(struct uw_context *); + +struct uw_context * uw_init(int id, void *logger_data, uw_logger log_debug); +void uw_close(struct uw_context *); +int uw_set_app(struct uw_context *, uw_app*); +uw_app *uw_get_app(struct uw_context *); +void uw_set_db(struct uw_context *, void*); +void *uw_get_db(struct uw_context *); +void uw_free(struct uw_context *); +void uw_reset(struct uw_context *); +void uw_reset_keep_request(struct uw_context *); +void uw_reset_keep_error_message(struct uw_context *); +char *uw_get_url_prefix(struct uw_context *); + +failure_kind uw_begin_init(struct uw_context *); +void uw_set_on_success(char *); +void uw_set_headers(struct uw_context *, char *(*get_header)(void *, const char *), void *get_header_data); +void uw_set_env(struct uw_context *, char *(*get_env)(void *, const char *), void *get_env_data); +failure_kind uw_begin(struct uw_context *, char *path); +failure_kind uw_begin_onError(struct uw_context *, char *msg); +void uw_login(struct uw_context *); +void uw_commit(struct uw_context *); +int uw_rollback(struct uw_context *, int will_retry); + +__attribute__((noreturn)) void uw_error(struct uw_context *, failure_kind, const char *fmt, ...); +char *uw_error_message(struct uw_context *); +void uw_set_error_message(struct uw_context *, const char *fmt, ...); +uw_Basis_string uw_dup_and_clear_error_message(struct uw_context *); +int uw_has_error(struct uw_context *); +void uw_push_cleanup(struct uw_context *, void (*func)(void *), void *arg); +void uw_pop_cleanup(struct uw_context *); + +void *uw_malloc(struct uw_context *, size_t); +void uw_begin_region(struct uw_context *); +void uw_end_region(struct uw_context *); +void uw_memstats(struct uw_context *); + +int uw_send(struct uw_context *, int sock); +int uw_print(struct uw_context *, int fd); +int uw_output(struct uw_context * ctx, int (*output)(void *data, const char *buf, size_t len), void *data); + +int uw_set_input(struct uw_context *, const char *name, char *value); +int uw_set_file_input(struct uw_context *, char *name, uw_Basis_file); + +char *uw_get_input(struct uw_context *, int name); +char *uw_get_optional_input(struct uw_context *, int name); +uw_Basis_file uw_get_file_input(struct uw_context *, int name); +void uw_enter_subform(struct uw_context *, int name); +void uw_leave_subform(struct uw_context *); +int uw_enter_subforms(struct uw_context *, int name); +int uw_next_entry(struct uw_context *); + +void uw_write(struct uw_context *, const char*); + +uw_Basis_source uw_Basis_new_client_source(struct uw_context *, uw_Basis_string); +uw_unit uw_Basis_set_client_source(struct uw_context *, uw_Basis_source, uw_Basis_string); + +void uw_set_script_header(struct uw_context *, const char*); +char *uw_Basis_get_settings(struct uw_context *, uw_unit); +char *uw_get_real_script(struct uw_context *); + +uw_Basis_string uw_Basis_maybe_onload(struct uw_context *, uw_Basis_string); +uw_Basis_string uw_Basis_maybe_onunload(struct uw_context *, uw_Basis_string); + +void uw_set_needs_push(struct uw_context *, int); +void uw_set_needs_sig(struct uw_context *, int); + +char *uw_Basis_htmlifyInt(struct uw_context *, uw_Basis_int); +char *uw_Basis_htmlifyFloat(struct uw_context *, uw_Basis_float); +char *uw_Basis_htmlifyString(struct uw_context *, uw_Basis_string); +char *uw_Basis_htmlifyBool(struct uw_context *, uw_Basis_bool); +char *uw_Basis_htmlifyTime(struct uw_context *, uw_Basis_time); +char *uw_Basis_htmlifySpecialChar(struct uw_context *, unsigned char); +char *uw_Basis_htmlifySource(struct uw_context *, uw_Basis_source); + +uw_unit uw_Basis_htmlifyInt_w(struct uw_context *, uw_Basis_int); +uw_unit uw_Basis_htmlifyFloat_w(struct uw_context *, uw_Basis_float); +uw_unit uw_Basis_htmlifyString_w(struct uw_context *, uw_Basis_string); +uw_unit uw_Basis_htmlifyBool_w(struct uw_context *, uw_Basis_bool); +uw_unit uw_Basis_htmlifyTime_w(struct uw_context *, uw_Basis_time); +uw_unit uw_Basis_htmlifySpecialChar_w(struct uw_context *, unsigned char); +uw_unit uw_Basis_htmlifySource_w(struct uw_context *, uw_Basis_source); + +char *uw_Basis_attrifyInt(struct uw_context *, uw_Basis_int); +char *uw_Basis_attrifyFloat(struct uw_context *, uw_Basis_float); +char *uw_Basis_attrifyString(struct uw_context *, uw_Basis_string); +char *uw_Basis_attrifyChar(struct uw_context *, uw_Basis_char); +char *uw_Basis_attrifyTime(struct uw_context *, uw_Basis_time); +char *uw_Basis_attrifyChannel(struct uw_context *, uw_Basis_channel); +char *uw_Basis_attrifyClient(struct uw_context *, uw_Basis_client); +char *uw_Basis_attrifyCss_class(struct uw_context *, uw_Basis_css_class); + +uw_unit uw_Basis_attrifyInt_w(struct uw_context *, uw_Basis_int); +uw_unit uw_Basis_attrifyFloat_w(struct uw_context *, uw_Basis_float); +uw_unit uw_Basis_attrifyString_w(struct uw_context *, uw_Basis_string); +uw_unit uw_Basis_attrifyChar_w(struct uw_context *, uw_Basis_char); + +char *uw_Basis_urlifyInt(struct uw_context *, uw_Basis_int); +char *uw_Basis_urlifyFloat(struct uw_context *, uw_Basis_float); +char *uw_Basis_urlifyString(struct uw_context *, uw_Basis_string); +char *uw_Basis_urlifyBool(struct uw_context *, uw_Basis_bool); +char *uw_Basis_urlifyTime(struct uw_context *, uw_Basis_time); +char *uw_Basis_urlifyChannel(struct uw_context *, uw_Basis_channel); +char *uw_Basis_urlifySource(struct uw_context *, uw_Basis_source); + +uw_unit uw_Basis_urlifyInt_w(struct uw_context *, uw_Basis_int); +uw_unit uw_Basis_urlifyFloat_w(struct uw_context *, uw_Basis_float); +uw_unit uw_Basis_urlifyString_w(struct uw_context *, uw_Basis_string); +uw_unit uw_Basis_urlifyBool_w(struct uw_context *, uw_Basis_bool); +uw_unit uw_Basis_urlifyTime_w(struct uw_context *, uw_Basis_time); +uw_unit uw_Basis_urlifyChannel_w(struct uw_context *, uw_Basis_channel); +uw_unit uw_Basis_urlifySource_w(struct uw_context *, uw_Basis_source); + +uw_Basis_unit uw_Basis_unurlifyUnit(struct uw_context * ctx, char **s); +uw_Basis_int uw_Basis_unurlifyInt(struct uw_context *, char **); +uw_Basis_float uw_Basis_unurlifyFloat(struct uw_context *, char **); +uw_Basis_string uw_Basis_unurlifyString(struct uw_context *, char **); +uw_Basis_string uw_Basis_unurlifyString_fromClient(struct uw_context *, char **); +uw_Basis_bool uw_Basis_unurlifyBool(struct uw_context *, char **); +uw_Basis_time uw_Basis_unurlifyTime(struct uw_context *, char **); + +uw_Basis_int uw_Basis_strlen(struct uw_context *, const char *); +uw_Basis_bool uw_Basis_strlenGe(struct uw_context *, uw_Basis_string, uw_Basis_int); +uw_Basis_char uw_Basis_strsub(struct uw_context *, const char *, uw_Basis_int); +uw_Basis_string uw_Basis_strsuffix(struct uw_context *, const char *, uw_Basis_int); +uw_Basis_string uw_Basis_strcat(struct uw_context *, const char *, const char *); +uw_Basis_string uw_Basis_mstrcat(struct uw_context * ctx, ...); +uw_Basis_int *uw_Basis_strindex(struct uw_context *, const char *, uw_Basis_char); +uw_Basis_int *uw_Basis_strsindex(struct uw_context *, const char *, const char *needle); +uw_Basis_string uw_Basis_strchr(struct uw_context *, const char *, uw_Basis_char); +uw_Basis_int uw_Basis_strcspn(struct uw_context *, const char *, const char *); +uw_Basis_string uw_Basis_substring(struct uw_context *, const char *, uw_Basis_int, uw_Basis_int); +uw_Basis_string uw_Basis_str1(struct uw_context *, uw_Basis_char); + +uw_Basis_string uw_strdup(struct uw_context *, const char *); +uw_Basis_string uw_maybe_strdup(struct uw_context *, const char *); +char *uw_memdup(struct uw_context *, const char *, size_t); + +uw_Basis_string uw_Basis_sqlifyInt(struct uw_context *, uw_Basis_int); +uw_Basis_string uw_Basis_sqlifyFloat(struct uw_context *, uw_Basis_float); +uw_Basis_string uw_Basis_sqlifyString(struct uw_context *, uw_Basis_string); +uw_Basis_string uw_Basis_sqlifyChar(struct uw_context *, uw_Basis_char); +uw_Basis_string uw_Basis_sqlifyBool(struct uw_context *, uw_Basis_bool); +uw_Basis_string uw_Basis_sqlifyTime(struct uw_context *, uw_Basis_time); +uw_Basis_string uw_Basis_sqlifyBlob(struct uw_context *, uw_Basis_blob); +uw_Basis_string uw_Basis_sqlifyChannel(struct uw_context *, uw_Basis_channel); +uw_Basis_string uw_Basis_sqlifyClient(struct uw_context *, uw_Basis_client); + +uw_Basis_string uw_Basis_sqlifyIntN(struct uw_context *, uw_Basis_int*); +uw_Basis_string uw_Basis_sqlifyFloatN(struct uw_context *, uw_Basis_float*); +uw_Basis_string uw_Basis_sqlifyStringN(struct uw_context *, uw_Basis_string); +uw_Basis_string uw_Basis_sqlifyBoolN(struct uw_context *, uw_Basis_bool*); +uw_Basis_string uw_Basis_sqlifyTimeN(struct uw_context *, uw_Basis_time*); + +char *uw_Basis_ensqlBool(uw_Basis_bool); +char *uw_Basis_ensqlTime(struct uw_context * ctx, uw_Basis_time); + +char *uw_Basis_jsifyString(struct uw_context *, uw_Basis_string); +char *uw_Basis_jsifyChar(struct uw_context *, uw_Basis_char); +char *uw_Basis_jsifyChannel(struct uw_context *, uw_Basis_channel); +char *uw_Basis_jsifyTime(struct uw_context *, uw_Basis_time); + +uw_Basis_string uw_Basis_intToString(struct uw_context *, uw_Basis_int); +uw_Basis_string uw_Basis_floatToString(struct uw_context *, uw_Basis_float); +uw_Basis_string uw_Basis_charToString(struct uw_context *, uw_Basis_char); +uw_Basis_string uw_Basis_boolToString(struct uw_context *, uw_Basis_bool); +uw_Basis_string uw_Basis_timeToString(struct uw_context *, uw_Basis_time); + +uw_Basis_int *uw_Basis_stringToInt(struct uw_context *, uw_Basis_string); +uw_Basis_float *uw_Basis_stringToFloat(struct uw_context *, uw_Basis_string); +uw_Basis_char *uw_Basis_stringToChar(struct uw_context *, uw_Basis_string); +uw_Basis_bool *uw_Basis_stringToBool(struct uw_context *, uw_Basis_string); +uw_Basis_time *uw_Basis_stringToTime(struct uw_context *, const char *); + +uw_Basis_int uw_Basis_stringToInt_error(struct uw_context *, uw_Basis_string); +uw_Basis_float uw_Basis_stringToFloat_error(struct uw_context *, uw_Basis_string); +uw_Basis_char uw_Basis_stringToChar_error(struct uw_context *, uw_Basis_string); +uw_Basis_bool uw_Basis_stringToBool_error(struct uw_context *, uw_Basis_string); +uw_Basis_time uw_Basis_stringToTime_error(struct uw_context *, const char *); +uw_Basis_blob uw_Basis_stringToBlob_error(struct uw_context *, uw_Basis_string, size_t); +uw_Basis_channel uw_Basis_stringToChannel_error(struct uw_context *, uw_Basis_string); +uw_Basis_client uw_Basis_stringToClient_error(struct uw_context *, uw_Basis_string); + +uw_Basis_time uw_Basis_unsqlTime(struct uw_context *, uw_Basis_string); + +uw_Basis_string uw_Basis_requestHeader(struct uw_context *, uw_Basis_string); + +void uw_write_header(struct uw_context *, uw_Basis_string); +void uw_clear_headers(struct uw_context *); + +uw_Basis_string uw_Basis_get_cookie(struct uw_context *, uw_Basis_string c); +uw_unit uw_Basis_set_cookie(struct uw_context *, uw_Basis_string prefix, uw_Basis_string c, uw_Basis_string v, uw_Basis_time *expires, uw_Basis_bool secure); +uw_unit uw_Basis_clear_cookie(struct uw_context *, uw_Basis_string prefix, uw_Basis_string c); + +uw_Basis_channel uw_Basis_new_channel(struct uw_context *, uw_unit); +uw_unit uw_Basis_send(struct uw_context *, uw_Basis_channel, uw_Basis_string); + +uw_Basis_client uw_Basis_self(struct uw_context *); + +uw_Basis_string uw_Basis_bless(struct uw_context *, uw_Basis_string); +uw_Basis_string uw_Basis_blessMime(struct uw_context *, uw_Basis_string); +uw_Basis_string uw_Basis_blessRequestHeader(struct uw_context *, uw_Basis_string); +uw_Basis_string uw_Basis_blessResponseHeader(struct uw_context *, uw_Basis_string); +uw_Basis_string uw_Basis_blessEnvVar(struct uw_context *, uw_Basis_string); + +uw_Basis_string uw_Basis_checkUrl(struct uw_context *, uw_Basis_string); +uw_Basis_string uw_Basis_checkMime(struct uw_context *, uw_Basis_string); +uw_Basis_string uw_Basis_checkRequestHeader(struct uw_context *, uw_Basis_string); +uw_Basis_string uw_Basis_checkResponseHeader(struct uw_context *, uw_Basis_string); +uw_Basis_string uw_Basis_checkEnvVar(struct uw_context *, uw_Basis_string); + +uw_Basis_string uw_Basis_getHeader(struct uw_context *, uw_Basis_string name); +uw_unit uw_Basis_setHeader(struct uw_context *, uw_Basis_string name, uw_Basis_string value); +uw_Basis_string uw_Basis_getenv(struct uw_context *, uw_Basis_string name); + +uw_Basis_string uw_unnull(uw_Basis_string); +uw_Basis_string uw_Basis_makeSigString(struct uw_context *, uw_Basis_string); +int uw_streq(uw_Basis_string, uw_Basis_string); +uw_Basis_string uw_Basis_sigString(struct uw_context *, uw_unit); + +uw_Basis_string uw_Basis_fileName(struct uw_context *, uw_Basis_file); +uw_Basis_string uw_Basis_fileMimeType(struct uw_context *, uw_Basis_file); +uw_Basis_blob uw_Basis_fileData(struct uw_context *, uw_Basis_file); +uw_Basis_int uw_Basis_blobSize(struct uw_context *, uw_Basis_blob); +uw_Basis_blob uw_Basis_textBlob(struct uw_context *, uw_Basis_string); + +uw_Basis_string uw_Basis_postType(struct uw_context *, uw_Basis_postBody); +uw_Basis_string uw_Basis_postData(struct uw_context *, uw_Basis_postBody); +void uw_noPostBody(struct uw_context *); +void uw_postBody(struct uw_context *, uw_Basis_postBody); +int uw_hasPostBody(struct uw_context *); +uw_Basis_postBody uw_getPostBody(struct uw_context *); + +void uw_mayReturnIndirectly(struct uw_context *); +__attribute__((noreturn)) void uw_return_blob(struct uw_context *, uw_Basis_blob, uw_Basis_string mimeType); +__attribute__((noreturn)) void uw_redirect(struct uw_context *, uw_Basis_string url); + +uw_Basis_time uw_Basis_now(struct uw_context *); +uw_Basis_time uw_Basis_addSeconds(struct uw_context *, uw_Basis_time, uw_Basis_int); +uw_Basis_int uw_Basis_diffInSeconds(struct uw_context *, uw_Basis_time, uw_Basis_time); +uw_Basis_int uw_Basis_toSeconds(struct uw_context *, uw_Basis_time); +uw_Basis_int uw_Basis_diffInMilliseconds(struct uw_context *, uw_Basis_time, uw_Basis_time); +uw_Basis_int uw_Basis_toMilliseconds(struct uw_context *, uw_Basis_time); +extern const uw_Basis_time uw_Basis_minTime; + +void uw_register_transactional(struct uw_context *, void *data, uw_callback commit, uw_callback rollback, uw_callback_with_retry free); + +void uw_check_heap(struct uw_context *, size_t extra); +char *uw_heap_front(struct uw_context *); +void uw_set_heap_front(struct uw_context *, char*); + +uw_Basis_string uw_Basis_unAs(struct uw_context *, uw_Basis_string); + +extern char *uw_sqlfmtInt; +extern char *uw_sqlfmtFloat; +extern int uw_Estrings, uw_sql_type_annotations; +extern char *uw_sqlsuffixString; +extern char *uw_sqlsuffixChar; +extern char *uw_sqlsuffixBlob; +extern char *uw_sqlfmtUint4; + +void *uw_get_global(struct uw_context *, char *name); +void uw_set_global(struct uw_context *, char *name, void *data, uw_callback free); + +uw_Basis_bool uw_Basis_isalnum(struct uw_context *, uw_Basis_char); +uw_Basis_bool uw_Basis_isalpha(struct uw_context *, uw_Basis_char); +uw_Basis_bool uw_Basis_isblank(struct uw_context *, uw_Basis_char); +uw_Basis_bool uw_Basis_iscntrl(struct uw_context *, uw_Basis_char); +uw_Basis_bool uw_Basis_isdigit(struct uw_context *, uw_Basis_char); +uw_Basis_bool uw_Basis_isgraph(struct uw_context *, uw_Basis_char); +uw_Basis_bool uw_Basis_islower(struct uw_context *, uw_Basis_char); +uw_Basis_bool uw_Basis_isprint(struct uw_context *, uw_Basis_char); +uw_Basis_bool uw_Basis_ispunct(struct uw_context *, uw_Basis_char); +uw_Basis_bool uw_Basis_isspace(struct uw_context *, uw_Basis_char); +uw_Basis_bool uw_Basis_isupper(struct uw_context *, uw_Basis_char); +uw_Basis_bool uw_Basis_isxdigit(struct uw_context *, uw_Basis_char); +uw_Basis_char uw_Basis_tolower(struct uw_context *, uw_Basis_char); +uw_Basis_char uw_Basis_toupper(struct uw_context *, uw_Basis_char); + +uw_Basis_int uw_Basis_ord(struct uw_context *, uw_Basis_char); +uw_Basis_char uw_Basis_chr(struct uw_context *, uw_Basis_int); + +uw_Basis_string uw_Basis_currentUrl(struct uw_context *); +void uw_set_currentUrl(struct uw_context *, char *); + +extern size_t uw_messages_max, uw_clients_max, uw_headers_max, uw_page_max, uw_heap_max, uw_script_max; +extern size_t uw_inputs_max, uw_cleanup_max, uw_subinputs_max, uw_deltas_max, uw_transactionals_max, uw_globals_max; + +extern size_t uw_database_max; + +extern int uw_time; + +void uw_set_deadline(struct uw_context *, int); +void uw_check_deadline(struct uw_context *); + +uw_Basis_unit uw_Basis_debug(struct uw_context *, uw_Basis_string); +uw_Basis_int uw_Basis_naughtyDebug(struct uw_context *, uw_Basis_string); + +void uw_set_client_data(struct uw_context *, void *); + +uw_Basis_int uw_Basis_rand(struct uw_context *); + +extern int uw_time_max, uw_supports_direct_status, uw_min_heap; + +failure_kind uw_runCallback(struct uw_context *, void (*callback)(struct uw_context *)); + +uw_Basis_string uw_Basis_timef(struct uw_context *, const char *fmt, uw_Basis_time); +uw_Basis_time uw_Basis_stringToTimef(struct uw_context *, const char *fmt, uw_Basis_string); +uw_Basis_time uw_Basis_stringToTimef_error(struct uw_context *, const char *fmt, uw_Basis_string); + +uw_Basis_string uw_Basis_crypt(struct uw_context *, uw_Basis_string key, uw_Basis_string salt); + +uw_Basis_bool uw_Basis_eq_time(struct uw_context *, uw_Basis_time, uw_Basis_time); +uw_Basis_bool uw_Basis_lt_time(struct uw_context *, uw_Basis_time, uw_Basis_time); +uw_Basis_bool uw_Basis_le_time(struct uw_context *, uw_Basis_time, uw_Basis_time); + +void uw_buffer_init(size_t max, uw_buffer *, size_t initial); +void uw_buffer_free(uw_buffer *); +void uw_buffer_reset(uw_buffer *); +int uw_buffer_check(uw_buffer *, size_t extra); +size_t uw_buffer_used(uw_buffer *); +size_t uw_buffer_avail(uw_buffer *); +int uw_buffer_append(uw_buffer *, const char *, size_t); + +void uw_setQueryString(struct uw_context *, uw_Basis_string); +uw_Basis_string uw_queryString(struct uw_context *); + +uw_Basis_time *uw_Basis_readUtc(struct uw_context *, uw_Basis_string); + +void uw_isPost(struct uw_context *); +uw_Basis_bool uw_Basis_currentUrlHasPost(struct uw_context *); +uw_Basis_bool uw_Basis_currentUrlHasQueryString(struct uw_context *); + +uw_Basis_string uw_Basis_fresh(struct uw_context *); + +uw_Basis_float uw_Basis_floatFromInt(struct uw_context *, uw_Basis_int); +uw_Basis_int uw_Basis_ceil(struct uw_context *, uw_Basis_float); +uw_Basis_int uw_Basis_trunc(struct uw_context *, uw_Basis_float); +uw_Basis_int uw_Basis_round(struct uw_context *, uw_Basis_float); + +uw_Basis_string uw_Basis_atom(struct uw_context *, uw_Basis_string); +uw_Basis_string uw_Basis_css_url(struct uw_context *, uw_Basis_string); +uw_Basis_string uw_Basis_property(struct uw_context *, uw_Basis_string); + +void uw_begin_initializing(struct uw_context *); +void uw_end_initializing(struct uw_context *); + +uw_Basis_string uw_Basis_fieldName(struct uw_context *, uw_Basis_postField); +uw_Basis_string uw_Basis_fieldValue(struct uw_context *, uw_Basis_postField); +uw_Basis_string uw_Basis_remainingFields(struct uw_context *, uw_Basis_postField); +uw_Basis_postField *uw_Basis_firstFormField(struct uw_context *, uw_Basis_string); + +#endif -- cgit v1.2.3 From ee27f397f8ae80bfdb230f8c06a2025289d0db56 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Wed, 27 Nov 2013 15:28:55 -0500 Subject: Add Connection and Content-length headers to raw HTTP responses --- include/urweb/urweb_cpp.h | 1 + src/c/http.c | 9 ++++++++- src/c/urweb.c | 4 ++++ 3 files changed, 13 insertions(+), 1 deletion(-) (limited to 'include/urweb/urweb_cpp.h') diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h index 91342933..4779b95a 100644 --- a/include/urweb/urweb_cpp.h +++ b/include/urweb/urweb_cpp.h @@ -58,6 +58,7 @@ void uw_memstats(struct uw_context *); int uw_send(struct uw_context *, int sock); int uw_print(struct uw_context *, int fd); int uw_output(struct uw_context * ctx, int (*output)(void *data, const char *buf, size_t len), void *data); +int uw_pagelen(struct uw_context *); int uw_set_input(struct uw_context *, const char *name, char *value); int uw_set_file_input(struct uw_context *, char *name, uw_Basis_file); diff --git a/src/c/http.c b/src/c/http.c index 48a042dc..ba9214c5 100644 --- a/src/c/http.c +++ b/src/c/http.c @@ -204,7 +204,14 @@ static void *worker(void *data) { on_success, on_failure, NULL, log_error, log_debug, sock, uw_really_send, close); - if (rr != KEEP_OPEN) uw_send(ctx, sock); + if (rr != KEEP_OPEN) { + char clen[100]; + + uw_write_header(ctx, "Connection: close\r\n"); + sprintf(clen, "Content-length: %d\r\n", uw_pagelen(ctx)); + uw_write_header(ctx, clen); + uw_send(ctx, sock); + } if (rr == SERVED || rr == FAILED) close(sock); diff --git a/src/c/urweb.c b/src/c/urweb.c index 447733be..82bbf39f 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -1282,6 +1282,10 @@ void uw_memstats(uw_context ctx) { printf("Heap: %lu/%lu\n", (unsigned long)uw_buffer_used(&ctx->heap), (unsigned long)uw_buffer_avail(&ctx->heap)); } +int uw_pagelen(uw_context ctx) { + return ctx->page.front - ctx->page.start; +} + int uw_send(uw_context ctx, int sock) { int n = uw_really_send(sock, ctx->outHeaders.start, ctx->outHeaders.front - ctx->outHeaders.start); -- cgit v1.2.3 From 8492b32b68c817deb9556e377b0a1b7fbdef22bf Mon Sep 17 00:00:00 2001 From: Patrick Hurst Date: Thu, 5 Dec 2013 11:36:06 -0500 Subject: Add basic year/month/day/hour/minute/second <-> time functions. --- include/urweb/urweb_cpp.h | 7 +++++++ lib/ur/basis.urs | 9 +++++++++ src/c/urweb.c | 45 +++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 61 insertions(+) (limited to 'include/urweb/urweb_cpp.h') diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h index 4779b95a..be9f9d16 100644 --- a/include/urweb/urweb_cpp.h +++ b/include/urweb/urweb_cpp.h @@ -262,6 +262,13 @@ uw_Basis_int uw_Basis_diffInSeconds(struct uw_context *, uw_Basis_time, uw_Basis uw_Basis_int uw_Basis_toSeconds(struct uw_context *, uw_Basis_time); uw_Basis_int uw_Basis_diffInMilliseconds(struct uw_context *, uw_Basis_time, uw_Basis_time); uw_Basis_int uw_Basis_toMilliseconds(struct uw_context *, uw_Basis_time); +uw_Basis_time uw_Basis_fromDatetime(struct uw_context *, uw_Basis_int, uw_Basis_int, uw_Basis_int, uw_Basis_int, uw_Basis_int, uw_Basis_int); +uw_Basis_int uw_Basis_datetimeYear(struct uw_context *, uw_Basis_time); +uw_Basis_int uw_Basis_datetimeMonth(struct uw_context *, uw_Basis_time); +uw_Basis_int uw_Basis_datetimeDay(struct uw_context *, uw_Basis_time); +uw_Basis_int uw_Basis_datetimeHour(struct uw_context *, uw_Basis_time); +uw_Basis_int uw_Basis_datetimeMinute(struct uw_context *, uw_Basis_time); +uw_Basis_int uw_Basis_datetimeSecond(struct uw_context *, uw_Basis_time); extern const uw_Basis_time uw_Basis_minTime; void uw_register_transactional(struct uw_context *, void *data, uw_callback commit, uw_callback rollback, uw_callback_with_retry free); diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index 4931c97a..804f15b9 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -167,6 +167,15 @@ val diffInMilliseconds : time -> time -> int val timef : string -> time -> string (* Uses strftime() format string *) val readUtc : string -> option time +(* Takes a year, month, day, hour, minute, second. *) +val fromDatetime : int -> int -> int -> int -> int -> int -> time +val datetimeYear : time -> int +val datetimeMonth : time -> int +val datetimeDay : time -> int +val datetimeHour : time -> int +val datetimeMinute: time -> int +val datetimeSecond : time -> int + (** * Encryption *) diff --git a/src/c/urweb.c b/src/c/urweb.c index 8bd5ada9..cb71aa15 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -3851,6 +3851,51 @@ uw_Basis_int uw_Basis_toSeconds(uw_context ctx, uw_Basis_time tm) { return tm.seconds; } +uw_Basis_time uw_Basis_fromDatetime(uw_context ctx, uw_Basis_int year, uw_Basis_int month, uw_Basis_int day, uw_Basis_int hour, uw_Basis_int minute, uw_Basis_int second) { + struct tm tm = { .tm_year = year - 1900, .tm_mon = month, .tm_mday = day, + .tm_hour = hour, .tm_min = minute, .tm_sec = second }; + uw_Basis_time r = { timegm(&tm) }; + return r; +} + +uw_Basis_int uw_Basis_datetimeYear(uw_context ctx, uw_Basis_time time) { + struct tm tm; + gmtime_r(&time.seconds, &tm); + return tm.tm_year + 1900; +} + +uw_Basis_int uw_Basis_datetimeMonth(uw_context ctx, uw_Basis_time time) { + struct tm tm; + gmtime_r(&time.seconds, &tm); + return tm.tm_mon; +} + +uw_Basis_int uw_Basis_datetimeDay(uw_context ctx, uw_Basis_time time) { + struct tm tm; + gmtime_r(&time.seconds, &tm); + return tm.tm_mday; +} + +uw_Basis_int uw_Basis_datetimeHour(uw_context ctx, uw_Basis_time time) { + struct tm tm; + gmtime_r(&time.seconds, &tm); + return tm.tm_hour; +} + +uw_Basis_int uw_Basis_datetimeMinute(uw_context ctx, uw_Basis_time time) { + struct tm tm; + gmtime_r(&time.seconds, &tm); + return tm.tm_min; +} + +uw_Basis_int uw_Basis_datetimeSecond(uw_context ctx, uw_Basis_time time) { + struct tm tm; + gmtime_r(&time.seconds, &tm); + return tm.tm_sec; +} + + + void *uw_get_global(uw_context ctx, char *name) { int i; -- cgit v1.2.3 From 1ce3acd70b3527add32015267cc916e920661dbb Mon Sep 17 00:00:00 2001 From: Patrick Hurst Date: Mon, 9 Dec 2013 20:41:24 -0500 Subject: Declare datetimeDayOfWeek in urweb_cpp.h. --- include/urweb/urweb_cpp.h | 1 + 1 file changed, 1 insertion(+) (limited to 'include/urweb/urweb_cpp.h') diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h index be9f9d16..9105a86a 100644 --- a/include/urweb/urweb_cpp.h +++ b/include/urweb/urweb_cpp.h @@ -269,6 +269,7 @@ uw_Basis_int uw_Basis_datetimeDay(struct uw_context *, uw_Basis_time); uw_Basis_int uw_Basis_datetimeHour(struct uw_context *, uw_Basis_time); uw_Basis_int uw_Basis_datetimeMinute(struct uw_context *, uw_Basis_time); uw_Basis_int uw_Basis_datetimeSecond(struct uw_context *, uw_Basis_time); +uw_Basis_int uw_Basis_datetimeDayOfWeek(struct uw_context *, uw_Basis_time); extern const uw_Basis_time uw_Basis_minTime; void uw_register_transactional(struct uw_context *, void *data, uw_callback commit, uw_callback rollback, uw_callback_with_retry free); -- cgit v1.2.3 From a8459c0104ca36fd058ea527890116c7a1bca8fd Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Wed, 11 Dec 2013 14:57:54 -0500 Subject: Fix regression in http.c for long-polling connections; add lazy initialization of database connections, to avoid the overhead in handlers that don't use SQL --- include/urweb/urweb_cpp.h | 1 + src/c/http.c | 4 +++- src/c/urweb.c | 24 +++++++++++++++++------- src/cjr_print.sml | 12 +++++++++++- 4 files changed, 32 insertions(+), 9 deletions(-) (limited to 'include/urweb/urweb_cpp.h') diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h index 4779b95a..fb3c83a2 100644 --- a/include/urweb/urweb_cpp.h +++ b/include/urweb/urweb_cpp.h @@ -37,6 +37,7 @@ void uw_set_on_success(char *); void uw_set_headers(struct uw_context *, char *(*get_header)(void *, const char *), void *get_header_data); void uw_set_env(struct uw_context *, char *(*get_env)(void *, const char *), void *get_env_data); failure_kind uw_begin(struct uw_context *, char *path); +void uw_ensure_transaction(struct uw_context *); failure_kind uw_begin_onError(struct uw_context *, char *msg); void uw_login(struct uw_context *); void uw_commit(struct uw_context *); diff --git a/src/c/http.c b/src/c/http.c index 5ceca059..d19ce350 100644 --- a/src/c/http.c +++ b/src/c/http.c @@ -260,7 +260,9 @@ static void *worker(void *data) { close(sock); sock = 0; } - } else if (rr != KEEP_OPEN) + } else if (rr == KEEP_OPEN) + sock = 0; + else fprintf(stderr, "Illegal uw_request return code: %d\n", rr); break; diff --git a/src/c/urweb.c b/src/c/urweb.c index 8bd5ada9..cd724cbf 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -431,6 +431,7 @@ struct uw_context { unsigned long long source_count; void *db; + int transaction_started; jmp_buf jmp_buf; @@ -507,6 +508,7 @@ uw_context uw_init(int id, void *logger_data, uw_logger log_debug) { ctx->sz_inputs = ctx->n_subinputs = ctx->used_subinputs = 0; ctx->db = NULL; + ctx->transaction_started = 0; ctx->regions = NULL; @@ -631,6 +633,7 @@ void uw_reset_keep_error_message(uw_context ctx) { ctx->amInitializing = 0; ctx->usedSig = 0; ctx->needsResig = 0; + ctx->transaction_started = 0; } void uw_reset_keep_request(uw_context ctx) { @@ -766,16 +769,20 @@ void uw_login(uw_context ctx) { failure_kind uw_begin(uw_context ctx, char *path) { int r = setjmp(ctx->jmp_buf); - if (r == 0) { - if (ctx->app->db_begin(ctx)) - uw_error(ctx, BOUNDED_RETRY, "Error running SQL BEGIN"); - + if (r == 0) ctx->app->handle(ctx, path); - } return r; } +void uw_ensure_transaction(uw_context ctx) { + if (!ctx->transaction_started) { + if (ctx->app->db_begin(ctx)) + uw_error(ctx, BOUNDED_RETRY, "Error running SQL BEGIN"); + ctx->transaction_started = 1; + } +} + uw_Basis_client uw_Basis_self(uw_context ctx) { if (ctx->client == NULL) uw_error(ctx, FATAL, "Call to Basis.self() from page that has only server-side code"); @@ -3205,7 +3212,7 @@ int uw_rollback(uw_context ctx, int will_retry) { if (ctx->transactionals[i].free) ctx->transactionals[i].free(ctx->transactionals[i].data, will_retry); - return ctx->app ? ctx->app->db_rollback(ctx) : 0; + return (ctx->app && ctx->transaction_started) ? ctx->app->db_rollback(ctx) : 0; } static const char begin_xhtml[] = "\n\n"; @@ -3262,7 +3269,7 @@ void uw_commit(uw_context ctx) { } } - if (ctx->app->db_commit(ctx)) { + if (ctx->transaction_started && ctx->app->db_commit(ctx)) { uw_set_error_message(ctx, "Error running SQL COMMIT"); return; } @@ -3453,6 +3460,7 @@ failure_kind uw_initialize(uw_context ctx) { if (r == 0) { if (ctx->app->db_begin(ctx)) uw_error(ctx, FATAL, "Error running SQL BEGIN"); + ctx->transaction_started = 1; ctx->app->initializer(ctx); if (ctx->app->db_commit(ctx)) uw_error(ctx, FATAL, "Error running SQL COMMIT"); @@ -4037,6 +4045,7 @@ failure_kind uw_runCallback(uw_context ctx, void (*callback)(uw_context)) { if (r == 0) { if (ctx->app->db_begin(ctx)) uw_error(ctx, BOUNDED_RETRY, "Error running SQL BEGIN"); + ctx->transaction_started = 1; callback(ctx); } @@ -4085,6 +4094,7 @@ failure_kind uw_begin_onError(uw_context ctx, char *msg) { if (r == 0) { if (ctx->app->db_begin(ctx)) uw_error(ctx, BOUNDED_RETRY, "Error running SQL BEGIN"); + ctx->transaction_started = 1; uw_buffer_reset(&ctx->outHeaders); if (on_success[0]) diff --git a/src/cjr_print.sml b/src/cjr_print.sml index bc8f1be6..e98918e6 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -2079,6 +2079,8 @@ and p_exp' par tail env (e, loc) = newline, string "int dummy = (uw_begin_region(ctx), 0);", newline, + string "uw_ensure_transaction(ctx);", + newline, case prepared of NONE => @@ -2140,6 +2142,8 @@ and p_exp' par tail env (e, loc) = p_exp' false false env dml, string ";", newline, + string "uw_ensure_transaction(ctx);", + newline, newline, #dml (Settings.currentDbms ()) (loc, mode)] | SOME {id, dml = dml'} => @@ -2159,8 +2163,10 @@ and p_exp' par tail env (e, loc) = string ";"]) inputs, newline, + string "uw_ensure_transaction(ctx);", newline, - + newline, + #dmlPrepared (Settings.currentDbms ()) {loc = loc, id = id, dml = dml', @@ -2184,6 +2190,8 @@ and p_exp' par tail env (e, loc) = newline, string "uw_Basis_int n;", newline, + string "uw_ensure_transaction(ctx);", + newline, case prepared of NONE => #nextval (Settings.currentDbms ()) {loc = loc, @@ -2204,6 +2212,8 @@ and p_exp' par tail env (e, loc) = | ESetval {seq, count} => box [string "({", newline, + string "uw_ensure_transaction(ctx);", + newline, #setval (Settings.currentDbms ()) {loc = loc, seqE = p_exp' false false env seq, -- cgit v1.2.3 From d7c4817af0c7f4ea2ed30b4a34408f2f92e9e979 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Wed, 11 Dec 2013 18:22:10 -0500 Subject: Change handling of returned text blobs, to activate the normal EWrite optimizations --- include/urweb/urweb_cpp.h | 2 ++ src/c/urweb.c | 34 ++++++++++++++++++++++++++++++++++ src/checknest.sml | 6 ++++-- src/cjr.sml | 2 +- src/cjr_print.sml | 26 ++++++++++++++++++++++++-- src/cjrize.sml | 11 +++++++++-- src/iflow.sml | 9 ++++++--- src/jscomp.sml | 10 ++++++++-- src/mono.sml | 2 +- src/mono_print.sml | 36 ++++++++++++++++++++++++------------ src/mono_reduce.sml | 6 ++++-- src/mono_util.sml | 13 ++++++++++--- src/monoize.sml | 20 +++++++++++++++++++- src/prepare.sml | 9 ++++++++- 14 files changed, 154 insertions(+), 32 deletions(-) (limited to 'include/urweb/urweb_cpp.h') diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h index fb3c83a2..d1fb4d37 100644 --- a/include/urweb/urweb_cpp.h +++ b/include/urweb/urweb_cpp.h @@ -209,6 +209,7 @@ uw_Basis_string uw_Basis_requestHeader(struct uw_context *, uw_Basis_string); void uw_write_header(struct uw_context *, uw_Basis_string); void uw_clear_headers(struct uw_context *); +void uw_Basis_clear_page(struct uw_context *); uw_Basis_string uw_Basis_get_cookie(struct uw_context *, uw_Basis_string c); uw_unit uw_Basis_set_cookie(struct uw_context *, uw_Basis_string prefix, uw_Basis_string c, uw_Basis_string v, uw_Basis_time *expires, uw_Basis_bool secure); @@ -255,6 +256,7 @@ uw_Basis_postBody uw_getPostBody(struct uw_context *); void uw_mayReturnIndirectly(struct uw_context *); __attribute__((noreturn)) void uw_return_blob(struct uw_context *, uw_Basis_blob, uw_Basis_string mimeType); +__attribute__((noreturn)) void uw_return_blob_from_page(struct uw_context *, uw_Basis_string mimeType); __attribute__((noreturn)) void uw_redirect(struct uw_context *, uw_Basis_string url); uw_Basis_time uw_Basis_now(struct uw_context *); diff --git a/src/c/urweb.c b/src/c/urweb.c index cd724cbf..1201b09b 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -1351,6 +1351,10 @@ void uw_clear_headers(uw_context ctx) { uw_buffer_reset(&ctx->outHeaders); } +void uw_Basis_clear_page(uw_context ctx) { + uw_buffer_reset(&ctx->page); +} + static void uw_check_script(uw_context ctx, size_t extra) { ctx_uw_buffer_check(ctx, "script", &ctx->script, extra); } @@ -3736,6 +3740,36 @@ __attribute__((noreturn)) void uw_return_blob(uw_context ctx, uw_Basis_blob b, u longjmp(ctx->jmp_buf, RETURN_INDIRECTLY); } +__attribute__((noreturn)) void uw_return_blob_from_page(uw_context ctx, uw_Basis_string mimeType) { + cleanup *cl; + int len; + char *oldh; + + if (!ctx->allowed_to_return_indirectly) + uw_error(ctx, FATAL, "Tried to return a blob from an RPC"); + + ctx->returning_indirectly = 1; + oldh = old_headers(ctx); + uw_buffer_reset(&ctx->outHeaders); + + uw_write_header(ctx, on_success); + uw_write_header(ctx, "Content-Type: "); + uw_write_header(ctx, mimeType); + uw_write_header(ctx, "\r\nContent-Length: "); + ctx_uw_buffer_check(ctx, "headers", &ctx->outHeaders, INTS_MAX); + sprintf(ctx->outHeaders.front, "%lu%n", (unsigned long)uw_buffer_used(&ctx->page), &len); + ctx->outHeaders.front += len; + uw_write_header(ctx, "\r\n"); + if (oldh) uw_write_header(ctx, oldh); + + for (cl = ctx->cleanup; cl < ctx->cleanup_front; ++cl) + cl->func(cl->arg); + + ctx->cleanup_front = ctx->cleanup; + + longjmp(ctx->jmp_buf, RETURN_INDIRECTLY); +} + __attribute__((noreturn)) void uw_redirect(uw_context ctx, uw_Basis_string url) { cleanup *cl; char *s; diff --git a/src/checknest.sml b/src/checknest.sml index 05ad8e9a..fa418d89 100644 --- a/src/checknest.sml +++ b/src/checknest.sml @@ -56,7 +56,8 @@ fun expUses globals = | ECase (e, pes, _) => foldl (fn ((_, e), s) => IS.union (eu e, s)) (eu e) pes | EError (e, _) => eu e - | EReturnBlob {blob, mimeType, ...} => IS.union (eu blob, eu mimeType) + | EReturnBlob {blob = NONE, mimeType, ...} => eu mimeType + | EReturnBlob {blob = SOME blob, mimeType, ...} => IS.union (eu blob, eu mimeType) | ERedirect (e, _) => eu e | EWrite e => eu e @@ -118,7 +119,8 @@ fun annotateExp globals = | ECase (e, pes, ts) => (ECase (ae e, map (fn (p, e) => (p, ae e)) pes, ts), loc) | EError (e, t) => (EError (ae e, t), loc) - | EReturnBlob {blob, mimeType, t} => (EReturnBlob {blob = ae blob, mimeType = ae mimeType, t = t}, loc) + | EReturnBlob {blob = NONE, mimeType, t} => (EReturnBlob {blob = NONE, mimeType = ae mimeType, t = t}, loc) + | EReturnBlob {blob = SOME blob, mimeType, t} => (EReturnBlob {blob = SOME (ae blob), mimeType = ae mimeType, t = t}, loc) | ERedirect (e, t) => (ERedirect (ae e, t), loc) | EWrite e => (EWrite (ae e), loc) diff --git a/src/cjr.sml b/src/cjr.sml index 3a37b26f..8cbabdcc 100644 --- a/src/cjr.sml +++ b/src/cjr.sml @@ -78,7 +78,7 @@ datatype exp' = | ECase of exp * (pat * exp) list * { disc : typ, result : typ } | EError of exp * typ - | EReturnBlob of {blob : exp, mimeType : exp, t : typ} + | EReturnBlob of {blob : exp option, mimeType : exp, t : typ} | ERedirect of exp * typ | EWrite of exp diff --git a/src/cjr_print.sml b/src/cjr_print.sml index e98918e6..dec21eb3 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -1628,7 +1628,7 @@ and p_exp' par tail env (e, loc) = string "tmp;", newline, string "})"] - | EReturnBlob {blob, mimeType, t} => + | EReturnBlob {blob = SOME blob, mimeType, t} => box [string "({", newline, string "uw_Basis_blob", @@ -1658,6 +1658,27 @@ and p_exp' par tail env (e, loc) = string "tmp;", newline, string "})"] + | EReturnBlob {blob = NONE, mimeType, t} => + box [string "({", + newline, + string "uw_Basis_string", + space, + string "mimeType", + space, + string "=", + space, + p_exp' false false env mimeType, + string ";", + newline, + p_typ env t, + space, + string "tmp;", + newline, + string "uw_return_blob_from_page(ctx, mimeType);", + newline, + string "tmp;", + newline, + string "})"] | ERedirect (e, t) => box [string "({", newline, @@ -3180,7 +3201,8 @@ fun p_file env (ds, ps) = | EField (e, _) => expDb e | ECase (e, pes, _) => expDb e orelse List.exists (expDb o #2) pes | EError (e, _) => expDb e - | EReturnBlob {blob = e1, mimeType = e2, ...} => expDb e1 orelse expDb e2 + | EReturnBlob {blob = NONE, mimeType = e2, ...} => expDb e2 + | EReturnBlob {blob = SOME e1, mimeType = e2, ...} => expDb e1 orelse expDb e2 | ERedirect (e, _) => expDb e | EWrite e => expDb e | ESeq (e1, e2) => expDb e1 orelse expDb e2 diff --git a/src/cjrize.sml b/src/cjrize.sml index 0f4bdb42..d153feff 100644 --- a/src/cjrize.sml +++ b/src/cjrize.sml @@ -372,13 +372,20 @@ fun cifyExp (eAll as (e, loc), sm) = in ((L'.EError (e, t), loc), sm) end - | L.EReturnBlob {blob, mimeType, t} => + | L.EReturnBlob {blob = NONE, mimeType, t} => + let + val (mimeType, sm) = cifyExp (mimeType, sm) + val (t, sm) = cifyTyp (t, sm) + in + ((L'.EReturnBlob {blob = NONE, mimeType = mimeType, t = t}, loc), sm) + end + | L.EReturnBlob {blob = SOME blob, mimeType, t} => let val (blob, sm) = cifyExp (blob, sm) val (mimeType, sm) = cifyExp (mimeType, sm) val (t, sm) = cifyTyp (t, sm) in - ((L'.EReturnBlob {blob = blob, mimeType = mimeType, t = t}, loc), sm) + ((L'.EReturnBlob {blob = SOME blob, mimeType = mimeType, t = t}, loc), sm) end | L.ERedirect (e, t) => let diff --git a/src/iflow.sml b/src/iflow.sml index 0c94cd47..461dc956 100644 --- a/src/iflow.sml +++ b/src/iflow.sml @@ -1587,7 +1587,8 @@ fun evalExp env (e as (_, loc)) k = evalExp env e2 (fn e2 => k (Func (Other "cat", [e1, e2])))) | EError (e, _) => evalExp env e (fn e => St.send (e, loc)) - | EReturnBlob {blob = b, mimeType = m, ...} => + | EReturnBlob {blob = NONE, ...} => raise Fail "Iflow doesn't support blob optimization" + | EReturnBlob {blob = SOME b, mimeType = m, ...} => evalExp env b (fn b => (St.send (b, loc); evalExp env m @@ -2060,8 +2061,10 @@ fun check (file : file) = end | EStrcat (e1, e2) => (EStrcat (doExp env e1, doExp env e2), loc) | EError (e1, t) => (EError (doExp env e1, t), loc) - | EReturnBlob {blob = b, mimeType = m, t} => - (EReturnBlob {blob = doExp env b, mimeType = doExp env m, t = t}, loc) + | EReturnBlob {blob = NONE, mimeType = m, t} => + (EReturnBlob {blob = NONE, mimeType = doExp env m, t = t}, loc) + | EReturnBlob {blob = SOME b, mimeType = m, t} => + (EReturnBlob {blob = SOME (doExp env b), mimeType = doExp env m, t = t}, loc) | ERedirect (e1, t) => (ERedirect (doExp env e1, t), loc) | EWrite e1 => (EWrite (doExp env e1), loc) | ESeq (e1, e2) => (ESeq (doExp env e1, doExp env e2), loc) diff --git a/src/jscomp.sml b/src/jscomp.sml index e0d87a8e..4a2c0365 100644 --- a/src/jscomp.sml +++ b/src/jscomp.sml @@ -1118,12 +1118,18 @@ fun process (file : file) = in ((EError (e, t), loc), st) end - | EReturnBlob {blob, mimeType, t} => + | EReturnBlob {blob = NONE, mimeType, t} => + let + val (mimeType, st) = exp outer (mimeType, st) + in + ((EReturnBlob {blob = NONE, mimeType = mimeType, t = t}, loc), st) + end + | EReturnBlob {blob = SOME blob, mimeType, t} => let val (blob, st) = exp outer (blob, st) val (mimeType, st) = exp outer (mimeType, st) in - ((EReturnBlob {blob = blob, mimeType = mimeType, t = t}, loc), st) + ((EReturnBlob {blob = SOME blob, mimeType = mimeType, t = t}, loc), st) end | ERedirect (e, t) => let diff --git a/src/mono.sml b/src/mono.sml index f5260419..78740d70 100644 --- a/src/mono.sml +++ b/src/mono.sml @@ -93,7 +93,7 @@ datatype exp' = | EStrcat of exp * exp | EError of exp * typ - | EReturnBlob of {blob : exp, mimeType : exp, t : typ} + | EReturnBlob of {blob : exp option, mimeType : exp, t : typ} | ERedirect of exp * typ | EWrite of exp diff --git a/src/mono_print.sml b/src/mono_print.sml index a5156aca..c81b362a 100644 --- a/src/mono_print.sml +++ b/src/mono_print.sml @@ -235,18 +235,30 @@ fun p_exp' par env (e, _) = space, p_typ env t, string ")"] - | EReturnBlob {blob, mimeType, t} => box [string "(blob", - space, - p_exp env blob, - space, - string "in", - space, - p_exp env mimeType, - space, - string ":", - space, - p_typ env t, - string ")"] + | EReturnBlob {blob = SOME blob, mimeType, t} => box [string "(blob", + space, + p_exp env blob, + space, + string "in", + space, + p_exp env mimeType, + space, + string ":", + space, + p_typ env t, + string ")"] + | EReturnBlob {blob = NONE, mimeType, t} => box [string "(blob", + space, + string "", + space, + string "in", + space, + p_exp env mimeType, + space, + string ":", + space, + p_typ env t, + string ")"] | ERedirect (e, t) => box [string "(redirect", space, p_exp env e, diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml index 0dfb7558..e96a0e8f 100644 --- a/src/mono_reduce.sml +++ b/src/mono_reduce.sml @@ -101,7 +101,8 @@ fun impure (e, _) = | ECase (e, pes, _) => impure e orelse List.exists (fn (_, e) => impure e) pes | EError _ => true - | EReturnBlob {blob = e1, mimeType = e2, ...} => impure e1 orelse impure e2 + | EReturnBlob {blob = NONE, mimeType = e2, ...} => impure e2 + | EReturnBlob {blob = SOME e1, mimeType = e2, ...} => impure e1 orelse impure e2 | ERedirect (e, _) => impure e | EStrcat (e1, e2) => impure e1 orelse impure e2 @@ -492,7 +493,8 @@ fun reduce (file : file) = | EStrcat (e1, e2) => summarize d e1 @ summarize d e2 | EError (e, _) => summarize d e @ [Abort] - | EReturnBlob {blob = e1, mimeType = e2, ...} => summarize d e1 @ summarize d e2 @ [Abort] + | EReturnBlob {blob = NONE, mimeType = e2, ...} => summarize d e2 @ [Abort] + | EReturnBlob {blob = SOME e1, mimeType = e2, ...} => summarize d e1 @ summarize d e2 @ [Abort] | ERedirect (e, _) => summarize d e @ [Abort] | EWrite e => summarize d e @ [WritePage] diff --git a/src/mono_util.sml b/src/mono_util.sml index cb871891..cc531625 100644 --- a/src/mono_util.sml +++ b/src/mono_util.sml @@ -261,14 +261,20 @@ fun mapfoldB {typ = fc, exp = fe, bind} = S.map2 (mft t, fn t' => (EError (e', t'), loc))) - | EReturnBlob {blob, mimeType, t} => + | EReturnBlob {blob = NONE, mimeType, t} => + S.bind2 (mfe ctx mimeType, + fn mimeType' => + S.map2 (mft t, + fn t' => + (EReturnBlob {blob = NONE, mimeType = mimeType', t = t'}, loc))) + | EReturnBlob {blob = SOME blob, mimeType, t} => S.bind2 (mfe ctx blob, fn blob' => S.bind2 (mfe ctx mimeType, fn mimeType' => S.map2 (mft t, fn t' => - (EReturnBlob {blob = blob', mimeType = mimeType', t = t'}, loc)))) + (EReturnBlob {blob = SOME blob', mimeType = mimeType', t = t'}, loc)))) | ERedirect (e, t) => S.bind2 (mfe ctx e, fn e' => @@ -495,7 +501,8 @@ fun appLoc f = | ECase (e1, pes, _) => (appl e1; app (appl o #2) pes) | EStrcat (e1, e2) => (appl e1; appl e2) | EError (e1, _) => appl e1 - | EReturnBlob {blob = e1, mimeType = e2, ...} => (appl e1; appl e2) + | EReturnBlob {blob = NONE, mimeType = e2, ...} => appl e2 + | EReturnBlob {blob = SOME e1, mimeType = e2, ...} => (appl e1; appl e2) | ERedirect (e1, _) => appl e1 | EWrite e1 => appl e1 | ESeq (e1, e2) => (appl e1; appl e2) diff --git a/src/monoize.sml b/src/monoize.sml index 2b604325..b1166734 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -4053,6 +4053,24 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (L'.EError ((L'.ERel 0, loc), t), loc)), loc), fm) end + | L.EApp ( + (L.ECApp ((L.EFfi ("Basis", "returnBlob"), _), t), _), + (L.EFfiApp ("Basis", "textBlob", [(e, _)]), _)) => + let + val t = monoType env t + val un = (L'.TRecord [], loc) + val (e, fm) = monoExp (env, st, fm) e + in + ((L'.EAbs ("mt", (L'.TFfi ("Basis", "string"), loc), (L'.TFun (un, t), loc), + (L'.EAbs ("_", un, t, + (L'.ESeq ((L'.EFfiApp ("Basis", "clear_page", []), loc), + (L'.ESeq ((L'.EWrite (liftExpInExp 0 (liftExpInExp 0 e)), loc), + (L'.EReturnBlob {blob = NONE, + mimeType = (L'.ERel 1, loc), + t = t}, loc)), loc)), loc)), loc)), + loc), + fm) + end | L.ECApp ((L.EFfi ("Basis", "returnBlob"), _), t) => let val t = monoType env t @@ -4062,7 +4080,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (L'.TFun ((L'.TFfi ("Basis", "string"), loc), (L'.TFun (un, t), loc)), loc), (L'.EAbs ("mt", (L'.TFfi ("Basis", "string"), loc), (L'.TFun (un, t), loc), (L'.EAbs ("_", un, t, - (L'.EReturnBlob {blob = (L'.ERel 2, loc), + (L'.EReturnBlob {blob = SOME (L'.ERel 2, loc), mimeType = (L'.ERel 1, loc), t = t}, loc)), loc)), loc)), loc), fm) diff --git a/src/prepare.sml b/src/prepare.sml index 7f55959c..89cd1b43 100644 --- a/src/prepare.sml +++ b/src/prepare.sml @@ -201,7 +201,14 @@ fun prepExp (e as (_, loc), st) = | EReturnBlob {blob, mimeType, t} => let - val (blob, st) = prepExp (blob, st) + val (blob, st) = case blob of + NONE => (blob, st) + | SOME blob => + let + val (b, st) = prepExp (blob, st) + in + (SOME b, st) + end val (mimeType, st) = prepExp (mimeType, st) in ((EReturnBlob {blob = blob, mimeType = mimeType, t = t}, loc), st) -- cgit v1.2.3 From fdeb6edadce0a9da274449ac1450e871e183734b Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Thu, 12 Dec 2013 10:24:38 -0500 Subject: HTTP: avoid duplicate Content-length --- include/urweb/urweb_cpp.h | 1 + src/c/http.c | 11 +++++++---- src/c/urweb.c | 8 ++++++-- 3 files changed, 14 insertions(+), 6 deletions(-) (limited to 'include/urweb/urweb_cpp.h') diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h index d1fb4d37..cf046e83 100644 --- a/include/urweb/urweb_cpp.h +++ b/include/urweb/urweb_cpp.h @@ -209,6 +209,7 @@ uw_Basis_string uw_Basis_requestHeader(struct uw_context *, uw_Basis_string); void uw_write_header(struct uw_context *, uw_Basis_string); void uw_clear_headers(struct uw_context *); +int uw_has_contentLength(struct uw_context *); void uw_Basis_clear_page(struct uw_context *); uw_Basis_string uw_Basis_get_cookie(struct uw_context *, uw_Basis_string c); diff --git a/src/c/http.c b/src/c/http.c index d19ce350..ebe50bea 100644 --- a/src/c/http.c +++ b/src/c/http.c @@ -233,8 +233,6 @@ static void *worker(void *data) { sock, uw_really_send, close); if (rr != KEEP_OPEN) { - char clen[100]; - if (keepalive) { char *connection = uw_Basis_requestHeader(ctx, "Connection"); @@ -244,8 +242,13 @@ static void *worker(void *data) { if (!should_keepalive) uw_write_header(ctx, "Connection: close\r\n"); - sprintf(clen, "Content-length: %d\r\n", uw_pagelen(ctx)); - uw_write_header(ctx, clen); + if (!uw_has_contentLength(ctx)) { + char clen[100]; + + sprintf(clen, "Content-length: %d\r\n", uw_pagelen(ctx)); + uw_write_header(ctx, clen); + } + uw_send(ctx, sock); } diff --git a/src/c/urweb.c b/src/c/urweb.c index 1c66e9e8..9641333c 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -1347,6 +1347,10 @@ void uw_write_header(uw_context ctx, uw_Basis_string s) { ctx->outHeaders.front += len; } +int uw_has_contentLength(uw_context ctx) { + return strstr(ctx->outHeaders.start, "Content-length: ") != NULL; +} + void uw_clear_headers(uw_context ctx) { uw_buffer_reset(&ctx->outHeaders); } @@ -3723,7 +3727,7 @@ __attribute__((noreturn)) void uw_return_blob(uw_context ctx, uw_Basis_blob b, u uw_write_header(ctx, on_success); uw_write_header(ctx, "Content-Type: "); uw_write_header(ctx, mimeType); - uw_write_header(ctx, "\r\nContent-Length: "); + uw_write_header(ctx, "\r\nContent-length: "); ctx_uw_buffer_check(ctx, "headers", &ctx->outHeaders, INTS_MAX); sprintf(ctx->outHeaders.front, "%lu%n", (unsigned long)b.size, &len); ctx->outHeaders.front += len; @@ -3755,7 +3759,7 @@ __attribute__((noreturn)) void uw_return_blob_from_page(uw_context ctx, uw_Basis uw_write_header(ctx, on_success); uw_write_header(ctx, "Content-Type: "); uw_write_header(ctx, mimeType); - uw_write_header(ctx, "\r\nContent-Length: "); + uw_write_header(ctx, "\r\nContent-length: "); ctx_uw_buffer_check(ctx, "headers", &ctx->outHeaders, INTS_MAX); sprintf(ctx->outHeaders.front, "%lu%n", (unsigned long)uw_buffer_used(&ctx->page), &len); ctx->outHeaders.front += len; -- cgit v1.2.3 From a24c2bdaf85c3d4eef19783e95b11d1cf15add09 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Thu, 12 Dec 2013 17:42:48 -0500 Subject: Start SQL transactions as read-only when possible, based on conservative program analysis --- include/urweb/types_cpp.h | 2 +- include/urweb/urweb_cpp.h | 1 + src/c/cgi.c | 3 +-- src/c/fastcgi.c | 3 +-- src/c/http.c | 3 +-- src/c/urweb.c | 21 ++++++++++----------- src/cjr_print.sml | 13 ++++++++++++- src/corify.sml | 2 +- src/effectize.sml | 10 ++++++++-- src/export.sig | 2 +- src/export.sml | 4 ++-- src/mysql.sml | 2 +- src/postgres.sml | 4 ++-- src/sqlite.sml | 2 +- src/tag.sml | 6 +++--- 15 files changed, 46 insertions(+), 32 deletions(-) (limited to 'include/urweb/urweb_cpp.h') diff --git a/include/urweb/types_cpp.h b/include/urweb/types_cpp.h index 330f7755..789aecb1 100644 --- a/include/urweb/types_cpp.h +++ b/include/urweb/types_cpp.h @@ -82,7 +82,7 @@ typedef struct { void (*expunger)(struct uw_context *, uw_Basis_client); void (*db_init)(struct uw_context *); - int (*db_begin)(struct uw_context *); + int (*db_begin)(struct uw_context *, int could_write); int (*db_commit)(struct uw_context *); int (*db_rollback)(struct uw_context *); void (*db_close)(struct uw_context *); diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h index cf046e83..8dfffdf9 100644 --- a/include/urweb/urweb_cpp.h +++ b/include/urweb/urweb_cpp.h @@ -86,6 +86,7 @@ uw_Basis_string uw_Basis_maybe_onunload(struct uw_context *, uw_Basis_string); void uw_set_needs_push(struct uw_context *, int); void uw_set_needs_sig(struct uw_context *, int); +void uw_set_could_write_db(struct uw_context *, int); char *uw_Basis_htmlifyInt(struct uw_context *, uw_Basis_int); char *uw_Basis_htmlifyFloat(struct uw_context *, uw_Basis_float); diff --git a/src/c/cgi.c b/src/c/cgi.c index 52c0ca2e..c9ec744a 100644 --- a/src/c/cgi.c +++ b/src/c/cgi.c @@ -134,8 +134,7 @@ void uw_copy_client_data(void *dst, void *src) { } void uw_do_expunge(uw_context ctx, uw_Basis_client cli, void *data) { - if (uw_get_app(ctx)->db_begin(ctx)) - uw_error(ctx, FATAL, "Error running SQL BEGIN"); + uw_ensure_transaction(ctx); uw_get_app(ctx)->expunger(ctx, cli); uw_commit(ctx); } diff --git a/src/c/fastcgi.c b/src/c/fastcgi.c index 9e3c8d7e..d6d2391d 100644 --- a/src/c/fastcgi.c +++ b/src/c/fastcgi.c @@ -632,8 +632,7 @@ void uw_copy_client_data(void *dst, void *src) { } void uw_do_expunge(uw_context ctx, uw_Basis_client cli, void *data) { - if (uw_get_app(ctx)->db_begin(ctx)) - uw_error(ctx, FATAL, "Error running SQL BEGIN"); + uw_ensure_transaction(ctx); uw_get_app(ctx)->expunger(ctx, cli); uw_commit(ctx); } diff --git a/src/c/http.c b/src/c/http.c index ebe50bea..230d07f0 100644 --- a/src/c/http.c +++ b/src/c/http.c @@ -438,8 +438,7 @@ void uw_copy_client_data(void *dst, void *src) { } void uw_do_expunge(uw_context ctx, uw_Basis_client cli, void *data) { - if (uw_get_app(ctx)->db_begin(ctx)) - uw_error(ctx, FATAL, "Error running SQL BEGIN"); + uw_ensure_transaction(ctx); uw_get_app(ctx)->expunger(ctx, cli); uw_commit(ctx); } diff --git a/src/c/urweb.c b/src/c/urweb.c index 9641333c..3082f110 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -441,7 +441,7 @@ struct uw_context { const char *script_header; - int needs_push, needs_sig; + int needs_push, needs_sig, could_write_db; size_t n_deltas, used_deltas; delta *deltas; @@ -517,6 +517,7 @@ uw_context uw_init(int id, void *logger_data, uw_logger log_debug) { ctx->script_header = ""; ctx->needs_push = 0; ctx->needs_sig = 0; + ctx->could_write_db = 1; ctx->source_count = 0; @@ -777,7 +778,7 @@ failure_kind uw_begin(uw_context ctx, char *path) { void uw_ensure_transaction(uw_context ctx) { if (!ctx->transaction_started) { - if (ctx->app->db_begin(ctx)) + if (ctx->app->db_begin(ctx, ctx->could_write_db)) uw_error(ctx, BOUNDED_RETRY, "Error running SQL BEGIN"); ctx->transaction_started = 1; } @@ -1191,6 +1192,10 @@ void uw_set_needs_sig(uw_context ctx, int n) { ctx->needs_sig = n; } +void uw_set_could_write_db(uw_context ctx, int n) { + ctx->could_write_db = n; +} + static void uw_buffer_check_ctx(uw_context ctx, const char *kind, uw_buffer *b, size_t extra, const char *desc) { if (b->back - b->front < extra) { @@ -3466,9 +3471,7 @@ failure_kind uw_initialize(uw_context ctx) { int r = setjmp(ctx->jmp_buf); if (r == 0) { - if (ctx->app->db_begin(ctx)) - uw_error(ctx, FATAL, "Error running SQL BEGIN"); - ctx->transaction_started = 1; + uw_ensure_transaction(ctx); ctx->app->initializer(ctx); if (ctx->app->db_commit(ctx)) uw_error(ctx, FATAL, "Error running SQL COMMIT"); @@ -4085,9 +4088,7 @@ failure_kind uw_runCallback(uw_context ctx, void (*callback)(uw_context)) { int r = setjmp(ctx->jmp_buf); if (r == 0) { - if (ctx->app->db_begin(ctx)) - uw_error(ctx, BOUNDED_RETRY, "Error running SQL BEGIN"); - ctx->transaction_started = 1; + uw_ensure_transaction(ctx); callback(ctx); } @@ -4134,9 +4135,7 @@ failure_kind uw_begin_onError(uw_context ctx, char *msg) { if (ctx->app->on_error) { if (r == 0) { - if (ctx->app->db_begin(ctx)) - uw_error(ctx, BOUNDED_RETRY, "Error running SQL BEGIN"); - ctx->transaction_started = 1; + uw_ensure_transaction(ctx); uw_buffer_reset(&ctx->outHeaders); if (on_success[0]) diff --git a/src/cjr_print.sml b/src/cjr_print.sml index 798492d6..5d697eac 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -3001,11 +3001,18 @@ fun p_file env (ds, ps) = fun couldWrite ek = case ek of - Link => false + Link _ => false | Action ef => ef = ReadCookieWrite | Rpc ef => ef = ReadCookieWrite | Extern _ => false + fun couldWriteDb ek = + case ek of + Link ef => ef <> ReadOnly + | Action ef => ef <> ReadOnly + | Rpc ef => ef <> ReadOnly + | Extern ef => ef <> ReadOnly + val s = case Settings.getUrlPrefix () of "" => s @@ -3091,6 +3098,10 @@ fun p_file env (ds, ps) = end, string "\");", newline]), + string "uw_set_could_write_db(ctx, ", + string (if couldWriteDb ek then "1" else "0"), + string ");", + newline, string "uw_set_needs_push(ctx, ", string (case side of ServerAndPullAndPush => "1" diff --git a/src/corify.sml b/src/corify.sml index c06d62ca..c1c60045 100644 --- a/src/corify.sml +++ b/src/corify.sml @@ -1046,7 +1046,7 @@ fun corifyDecl mods (all as (d, loc : EM.span), st) = | _ => false) args then L'.Extern L'.ReadCookieWrite else - L'.Link + L'.Link L'.ReadCookieWrite in ((L.DVal ("wrap_" ^ s, 0, tf, e), loc) :: wds, (fn st => diff --git a/src/effectize.sml b/src/effectize.sml index 6ced952b..d711e620 100644 --- a/src/effectize.sml +++ b/src/effectize.sml @@ -153,7 +153,7 @@ fun effectize file = in (d, loop (writers, readers, pushers)) end - | DExport (Link, n, t) => + | DExport (Link _, n, t) => (case IM.find (writers, n) of NONE => () | SOME (loc, s) => @@ -162,7 +162,13 @@ fun effectize file = else ErrorMsg.errorAt loc ("A handler (URI prefix \"" ^ s ^ "\") accessible via GET could cause side effects; try accessing it only via forms, removing it from the signature of the main program module, or whitelisting it with the 'safeGet' .urp directive"); - ((DExport (Link, n, IM.inDomain (pushers, n)), #2 d), evs)) + ((DExport (Link (if IM.inDomain (writers, n) then + if IM.inDomain (readers, n) then + ReadCookieWrite + else + ReadWrite + else + ReadOnly), n, IM.inDomain (pushers, n)), #2 d), evs)) | DExport (Action _, n, _) => ((DExport (Action (if IM.inDomain (writers, n) then if IM.inDomain (readers, n) then diff --git a/src/export.sig b/src/export.sig index 9bcfa0d4..881459c5 100644 --- a/src/export.sig +++ b/src/export.sig @@ -33,7 +33,7 @@ datatype effect = | ReadWrite datatype export_kind = - Link + Link of effect | Action of effect | Rpc of effect | Extern of effect diff --git a/src/export.sml b/src/export.sml index 5d200894..a99d0b70 100644 --- a/src/export.sml +++ b/src/export.sml @@ -36,7 +36,7 @@ datatype effect = | ReadWrite datatype export_kind = - Link + Link of effect | Action of effect | Rpc of effect | Extern of effect @@ -49,7 +49,7 @@ fun p_effect ef = fun p_export_kind ck = case ck of - Link => string "link" + Link ef => box [string "link(", p_effect ef, string ")"] | Action ef => box [string "action(", p_effect ef, string ")"] | Rpc ef => box [string "rpc(", p_effect ef, string ")"] | Extern ef => box [string "extern(", p_effect ef, string ")"] diff --git a/src/mysql.sml b/src/mysql.sml index c70a1cdd..884cde36 100644 --- a/src/mysql.sml +++ b/src/mysql.sml @@ -577,7 +577,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} = newline, newline, - string "static int uw_db_begin(uw_context ctx) {", + string "static int uw_db_begin(uw_context ctx, int could_write) {", newline, string "uw_conn *conn = uw_get_db(ctx);", newline, diff --git a/src/postgres.sml b/src/postgres.sml index 41529173..272097e7 100644 --- a/src/postgres.sml +++ b/src/postgres.sml @@ -402,11 +402,11 @@ fun init {dbstring, prepared = ss, tables, views, sequences} = newline, newline, - string "static int uw_db_begin(uw_context ctx) {", + string "static int uw_db_begin(uw_context ctx, int could_write) {", newline, string "PGconn *conn = uw_get_db(ctx);", newline, - string "PGresult *res = PQexec(conn, \"BEGIN ISOLATION LEVEL SERIALIZABLE\");", + string "PGresult *res = PQexec(conn, could_write ? \"BEGIN ISOLATION LEVEL SERIALIZABLE\" : \"BEGIN ISOLATION LEVEL SERIALIZABLE, READ ONLY\");", newline, newline, string "if (res == NULL) return 1;", diff --git a/src/sqlite.sml b/src/sqlite.sml index 09c4c683..c138415b 100644 --- a/src/sqlite.sml +++ b/src/sqlite.sml @@ -344,7 +344,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} = newline, newline, - string "static int uw_db_begin(uw_context ctx) {", + string "static int uw_db_begin(uw_context ctx, int could_write) {", newline, string "uw_conn *conn = uw_get_db(ctx);", newline, diff --git a/src/tag.sml b/src/tag.sml index 9c4807c6..865e7f53 100644 --- a/src/tag.sml +++ b/src/tag.sml @@ -145,7 +145,7 @@ fun exp env (e, s) = end in case x of - (CName "Link", _) => tagIt' (Link, "Link") + (CName "Link", _) => tagIt' (Link ReadWrite, "Link") | (CName "Action", _) => tagIt' (Action ReadWrite, "Action") | _ => ((x, e, t), s) end) @@ -180,7 +180,7 @@ fun exp env (e, s) = | EFfiApp ("Basis", "url", [(e, t)]) => let - val (e, s) = tagIt (e, Link, "Url", s) + val (e, s) = tagIt (e, Link ReadWrite, "Url", s) in (EFfiApp ("Basis", "url", [(e, t)]), s) end @@ -201,7 +201,7 @@ fun exp env (e, s) = case eo of SOME (EAbs (_, _, _, (EFfiApp ("Basis", "url", [((ERel 0, _), t)]), _)), _) => let - val (e, s) = tagIt (e', Link, "Url", s) + val (e, s) = tagIt (e', Link ReadWrite, "Url", s) in (EFfiApp ("Basis", "url", [(e, t)]), s) end -- cgit v1.2.3 From fac05ae0a6d7d080436c953d2085e137d75c5796 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Mon, 23 Dec 2013 15:59:17 +0000 Subject: Proper handling of serialization failures during SQL COMMIT --- include/urweb/urweb_cpp.h | 3 ++- src/c/cgi.c | 7 ++++--- src/c/fastcgi.c | 7 ++++--- src/c/http.c | 7 ++++--- src/c/request.c | 6 ++++-- src/c/urweb.c | 29 ++++++++++++++++++++++------- src/postgres.sml | 18 +++++++++++++++++- 7 files changed, 57 insertions(+), 20 deletions(-) (limited to 'include/urweb/urweb_cpp.h') diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h index 8dfffdf9..248e54e4 100644 --- a/include/urweb/urweb_cpp.h +++ b/include/urweb/urweb_cpp.h @@ -40,7 +40,8 @@ failure_kind uw_begin(struct uw_context *, char *path); void uw_ensure_transaction(struct uw_context *); failure_kind uw_begin_onError(struct uw_context *, char *msg); void uw_login(struct uw_context *); -void uw_commit(struct uw_context *); +int uw_commit(struct uw_context *); +// ^-- returns nonzero if the transaction should be restarted int uw_rollback(struct uw_context *, int will_retry); __attribute__((noreturn)) void uw_error(struct uw_context *, failure_kind, const char *fmt, ...); diff --git a/src/c/cgi.c b/src/c/cgi.c index c9ec744a..f1482589 100644 --- a/src/c/cgi.c +++ b/src/c/cgi.c @@ -134,9 +134,10 @@ void uw_copy_client_data(void *dst, void *src) { } void uw_do_expunge(uw_context ctx, uw_Basis_client cli, void *data) { - uw_ensure_transaction(ctx); - uw_get_app(ctx)->expunger(ctx, cli); - uw_commit(ctx); + do { + uw_ensure_transaction(ctx); + uw_get_app(ctx)->expunger(ctx, cli); + } while (uw_commit(ctx) && (uw_rollback(ctx, 1), 1)); } void uw_post_expunge(uw_context ctx, void *data) { diff --git a/src/c/fastcgi.c b/src/c/fastcgi.c index d6d2391d..bbda0f57 100644 --- a/src/c/fastcgi.c +++ b/src/c/fastcgi.c @@ -632,9 +632,10 @@ void uw_copy_client_data(void *dst, void *src) { } void uw_do_expunge(uw_context ctx, uw_Basis_client cli, void *data) { - uw_ensure_transaction(ctx); - uw_get_app(ctx)->expunger(ctx, cli); - uw_commit(ctx); + do { + uw_ensure_transaction(ctx); + uw_get_app(ctx)->expunger(ctx, cli); + } while (uw_commit(ctx) && (uw_rollback(ctx, 1), 1)); } void uw_post_expunge(uw_context ctx, void *data) { diff --git a/src/c/http.c b/src/c/http.c index c57740e9..9050aaf4 100644 --- a/src/c/http.c +++ b/src/c/http.c @@ -447,9 +447,10 @@ void uw_copy_client_data(void *dst, void *src) { } void uw_do_expunge(uw_context ctx, uw_Basis_client cli, void *data) { - uw_ensure_transaction(ctx); - uw_get_app(ctx)->expunger(ctx, cli); - uw_commit(ctx); + do { + uw_ensure_transaction(ctx); + uw_get_app(ctx)->expunger(ctx, cli); + } while (uw_commit(ctx) && (uw_rollback(ctx, 1), 1)); } void uw_post_expunge(uw_context ctx, void *data) { diff --git a/src/c/request.c b/src/c/request.c index 5973d979..b925cc3c 100644 --- a/src/c/request.c +++ b/src/c/request.c @@ -116,8 +116,10 @@ static void *periodic_loop(void *data) { return NULL; } while (r == UNLIMITED_RETRY || (r == BOUNDED_RETRY && retries_left > 0)); - if (r != FATAL && r != BOUNDED_RETRY) - uw_commit(ctx); + if (r != FATAL && r != BOUNDED_RETRY) { + if (uw_commit(ctx)) + r = UNLIMITED_RETRY; + } sleep(p->pdic.period); }; diff --git a/src/c/urweb.c b/src/c/urweb.c index 3082f110..57f57694 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -3253,13 +3253,13 @@ static char *find_sig(char *haystack) { return s; } -void uw_commit(uw_context ctx) { +int uw_commit(uw_context ctx) { int i; char *sig; if (uw_has_error(ctx)) { uw_rollback(ctx, 0); - return; + return 0; } for (i = ctx->used_transactionals-1; i >= 0; --i) @@ -3268,7 +3268,7 @@ void uw_commit(uw_context ctx) { ctx->transactionals[i].commit(ctx->transactionals[i].data); if (uw_has_error(ctx)) { uw_rollback(ctx, 0); - return; + return 0; } } @@ -3278,13 +3278,26 @@ void uw_commit(uw_context ctx) { ctx->transactionals[i].commit(ctx->transactionals[i].data); if (uw_has_error(ctx)) { uw_rollback(ctx, 0); - return; + return 0; } } - if (ctx->transaction_started && ctx->app->db_commit(ctx)) { - uw_set_error_message(ctx, "Error running SQL COMMIT"); - return; + if (ctx->transaction_started) { + int code =ctx->app->db_commit(ctx); + + if (code) { + if (code == -1) { + uw_rollback(ctx, 1); + return 1; + } + + for (i = ctx->used_transactionals-1; i >= 0; --i) + if (ctx->transactionals[i].free) + ctx->transactionals[i].free(ctx->transactionals[i].data, 0); + + uw_set_error_message(ctx, "Error running SQL COMMIT"); + return 0; + } } for (i = 0; i < ctx->used_deltas; ++i) { @@ -3390,6 +3403,8 @@ void uw_commit(uw_context ctx) { } while (sig); } } + + return 0; } diff --git a/src/postgres.sml b/src/postgres.sml index 272097e7..8cfa5f48 100644 --- a/src/postgres.sml +++ b/src/postgres.sml @@ -438,7 +438,23 @@ fun init {dbstring, prepared = ss, tables, views, sequences} = newline, newline, string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {", - box [string "PQclear(res);", + box [string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40001\")) {", + box [newline, + string "PQclear(res);", + newline, + string "return -1;", + newline], + string "}", + newline, + string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40P01\")) {", + box [newline, + string "PQclear(res);", + newline, + string "return -1;", + newline], + string "}", + newline, + string "PQclear(res);", newline, string "return 1;", newline], -- cgit v1.2.3 From 55d485365f4d52a84d06bc38d6d34b6a47890b57 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Thu, 9 Jan 2014 17:27:24 -0500 Subject: Add 'html5' .urp directive --- doc/manual.tex | 1 + include/urweb/types_cpp.h | 2 ++ include/urweb/urweb_cpp.h | 2 ++ src/c/urweb.c | 12 ++++++++---- src/cjr_print.sml | 12 +++++++----- src/compiler.sml | 1 + src/settings.sig | 3 +++ src/settings.sml | 4 ++++ 8 files changed, 28 insertions(+), 9 deletions(-) (limited to 'include/urweb/urweb_cpp.h') diff --git a/doc/manual.tex b/doc/manual.tex index 6fe1a92c..ea053a81 100644 --- a/doc/manual.tex +++ b/doc/manual.tex @@ -146,6 +146,7 @@ Here is the complete list of directive forms. ``FFI'' stands for ``foreign func \item \texttt{effectful Module.ident} registers an FFI function or transaction as having side effects. The optimizer avoids removing, moving, or duplicating calls to such functions. This is the default behavior for \texttt{transaction}-based types. \item \texttt{exe FILENAME} sets the filename to which to write the output executable. The default for file \texttt{P.urp} is \texttt{P.exe}. \item \texttt{ffi FILENAME} reads the file \texttt{FILENAME.urs} to determine the interface to a new FFI module. The name of the module is calculated from \texttt{FILENAME} in the same way as for normal source files. See the files \texttt{include/urweb/urweb\_cpp.h} and \texttt{src/c/urweb.c} for examples of C headers and implementations for FFI modules. In general, every type or value \texttt{Module.ident} becomes \texttt{uw\_Module\_ident} in C. +\item \texttt{html5} activates work-in-progress support for generating HTML5 instead of XHTML. For now, this option only affects the first few tokens on any page, which are always the same. \item \texttt{include FILENAME} adds \texttt{FILENAME} to the list of files to be \texttt{\#include}d in C sources. This is most useful for interfacing with new FFI modules. \item \texttt{jsFunc Module.ident=name} gives the JavaScript name of an FFI value. \item \texttt{library FILENAME} parses \texttt{FILENAME.urp} and merges its contents with the rest of the current file's contents. If \texttt{FILENAME.urp} doesn't exist, the compiler also tries \texttt{FILENAME/lib.urp}. diff --git a/include/urweb/types_cpp.h b/include/urweb/types_cpp.h index 789aecb1..cd80b0e7 100644 --- a/include/urweb/types_cpp.h +++ b/include/urweb/types_cpp.h @@ -102,6 +102,8 @@ typedef struct { uw_periodic *periodics; // 0-terminated array uw_Basis_string time_format; + + int is_html5; } uw_app; #define ERROR_BUF_LEN 1024 diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h index 248e54e4..1943a9f9 100644 --- a/include/urweb/urweb_cpp.h +++ b/include/urweb/urweb_cpp.h @@ -377,4 +377,6 @@ uw_Basis_string uw_Basis_fieldValue(struct uw_context *, uw_Basis_postField); uw_Basis_string uw_Basis_remainingFields(struct uw_context *, uw_Basis_postField); uw_Basis_postField *uw_Basis_firstFormField(struct uw_context *, uw_Basis_string); +extern const char uw_begin_xhtml[], uw_begin_html5[]; + #endif diff --git a/src/c/urweb.c b/src/c/urweb.c index 3a5933c5..c0c339c1 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -3241,7 +3241,8 @@ int uw_rollback(uw_context ctx, int will_retry) { return 0; } -static const char begin_xhtml[] = "\n\n"; +const char uw_begin_xhtml[] = "\n\n"; +const char uw_begin_html5[] = ""; extern int uw_hash_blocksize; @@ -3331,11 +3332,14 @@ int uw_commit(uw_context ctx) { uw_check(ctx, 1); *ctx->page.front = 0; - if (!ctx->returning_indirectly && !strncmp(ctx->page.start, begin_xhtml, sizeof begin_xhtml - 1)) { + if (!ctx->returning_indirectly + && (ctx->app->is_html5 + ? !strncmp(ctx->page.start, uw_begin_html5, sizeof uw_begin_html5 - 1) + : !strncmp(ctx->page.start, uw_begin_xhtml, sizeof uw_begin_xhtml - 1))) { char *s; // Splice script data into appropriate part of page, also adding if needed. - s = ctx->page.start + sizeof begin_xhtml - 1; + s = ctx->page.start + (ctx->app->is_html5 ? sizeof uw_begin_html5 - 1 : sizeof uw_begin_xhtml - 1); s = strchr(s, '<'); if (s == NULL) { // Weird. Document has no tags! @@ -4170,7 +4174,7 @@ failure_kind uw_begin_onError(uw_context ctx, char *msg) { uw_write_header(ctx, "Status: "); uw_write_header(ctx, "500 Internal Server Error\r\n"); uw_write_header(ctx, "Content-type: text/html\r\n"); - uw_write(ctx, begin_xhtml); + uw_write(ctx, ctx->app->is_html5 ? uw_begin_html5 : uw_begin_xhtml); ctx->app->on_error(ctx, msg); uw_write(ctx, ""); } diff --git a/src/cjr_print.sml b/src/cjr_print.sml index 1fc0b40f..05dce35e 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -3083,7 +3083,11 @@ fun p_file env (ds, ps) = ServerOnly => box [] | _ => box [string "uw_write_header(ctx, \"Content-script-type: text/javascript\\r\\n\");", newline], - string "uw_write(ctx, begin_xhtml);", + string ("uw_write(ctx, uw_begin_" ^ + (if Settings.getIsHtml5 () then + "html5" + else + "xhtml") ^ ");"), newline, string "uw_mayReturnIndirectly(ctx);", newline, @@ -3374,9 +3378,6 @@ fun p_file env (ds, ps) = newline, newline, - string "static const char begin_xhtml[] = \"\\n\\n\";", - newline, - newline, p_list_sep newline (fn x => x) pds, newline, @@ -3588,7 +3589,8 @@ fun p_file env (ds, ps) = "uw_handle", "uw_input_num", "uw_cookie_sig", "uw_check_url", "uw_check_mime", "uw_check_requestHeader", "uw_check_responseHeader", "uw_check_envVar", case onError of NONE => "NULL" | SOME _ => "uw_onError", "my_periodics", - "\"" ^ Prim.toCString (Settings.getTimeFormat ()) ^ "\""], + "\"" ^ Prim.toCString (Settings.getTimeFormat ()) ^ "\"", + if Settings.getIsHtml5 () then "1" else "0"], string "};", newline] end diff --git a/src/compiler.sml b/src/compiler.sml index 5e60288b..0ffab01c 100644 --- a/src/compiler.sml +++ b/src/compiler.sml @@ -865,6 +865,7 @@ fun parseUrp' accLibs fname = | "noXsrfProtection" => Settings.addNoXsrfProtection arg | "timeFormat" => Settings.setTimeFormat arg | "noMangleSql" => Settings.setMangleSql false + | "html5" => Settings.setIsHtml5 true | _ => ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'"); read () diff --git a/src/settings.sig b/src/settings.sig index 847cb5f6..a7a41447 100644 --- a/src/settings.sig +++ b/src/settings.sig @@ -265,4 +265,7 @@ signature SETTINGS = sig val mangleSql : string -> string val mangleSqlCatalog : string -> string val mangleSqlTable : string -> string + + val setIsHtml5 : bool -> unit + val getIsHtml5 : unit -> bool end diff --git a/src/settings.sml b/src/settings.sml index ebe38b17..be998ec2 100644 --- a/src/settings.sml +++ b/src/settings.sml @@ -716,4 +716,8 @@ fun mangleSql s = if !mangle then "uw_" ^ s else "\"" ^ lowercase s ^ "\"" fun mangleSqlCatalog s = if !mangle then "uw_" ^ s else lowercase s +val html5 = ref false +fun setIsHtml5 b = html5 := b +fun getIsHtml5 () = !html5 + end -- cgit v1.2.3 From 640c7fe665f5f37fed005b2c9fe96c4818cc7043 Mon Sep 17 00:00:00 2001 From: Sergey Mironov Date: Wed, 26 Feb 2014 08:21:52 +0000 Subject: Define uw_loggers structure, allow FFI code to access it --- include/urweb/request.h | 11 +++++------ include/urweb/types_cpp.h | 6 ++++++ include/urweb/urweb_cpp.h | 6 ++++-- src/c/cgi.c | 6 ++++-- src/c/fastcgi.c | 13 +++++++++---- src/c/http.c | 14 +++++++++----- src/c/request.c | 40 +++++++++++++++++++--------------------- src/c/static.c | 6 ++++-- src/c/urweb.c | 17 ++++++++++------- 9 files changed, 70 insertions(+), 49 deletions(-) (limited to 'include/urweb/urweb_cpp.h') diff --git a/include/urweb/request.h b/include/urweb/request.h index a1a7d78d..0b19e7f4 100644 --- a/include/urweb/request.h +++ b/include/urweb/request.h @@ -7,13 +7,13 @@ typedef struct uw_rc *uw_request_context; -void uw_request_init(uw_app *app, void *logger_data, uw_logger log_error, uw_logger log_debug); +void uw_request_init(uw_app *app, uw_loggers* ls); void uw_sign(const char *in, char *out); uw_request_context uw_new_request_context(void); void uw_free_request_context(uw_request_context); -request_result uw_request(uw_request_context, uw_context, +request_result uw_request(uw_request_context rc, uw_context ctx, char *method, char *path, char *query_string, char *body, size_t body_len, void (*on_success)(uw_context), void (*on_failure)(uw_context), @@ -22,13 +22,12 @@ request_result uw_request(uw_request_context, uw_context, int (*send)(int sockfd, const void *buf, ssize_t len), int (*close)(int fd)); -uw_context uw_request_new_context(int id, uw_app*, void *logger_data, uw_logger log_error, uw_logger log_debug); +uw_context uw_request_new_context(int id, uw_app *app, uw_loggers *ls); typedef struct { uw_app *app; - void *logger_data; - uw_logger log_error, log_debug; -} loggers; + uw_loggers *loggers; +} pruner_data; void *client_pruner(void *data); diff --git a/include/urweb/types_cpp.h b/include/urweb/types_cpp.h index cd80b0e7..0c431ff8 100644 --- a/include/urweb/types_cpp.h +++ b/include/urweb/types_cpp.h @@ -106,6 +106,12 @@ typedef struct { int is_html5; } uw_app; +typedef struct { + /* uw_app *app; */ + void *logger_data; + uw_logger log_error, log_debug; +} uw_loggers; + #define ERROR_BUF_LEN 1024 typedef struct { diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h index 1bb6b2f2..b016f038 100644 --- a/include/urweb/urweb_cpp.h +++ b/include/urweb/urweb_cpp.h @@ -14,13 +14,13 @@ void uw_global_init(void); void uw_app_init(uw_app*); void uw_client_connect(unsigned id, int pass, int sock, - int (*send)(int sockfd, const void *buf, size_t len), + int (*send)(int sockfd, const void *buf, ssize_t len), int (*close)(int fd), void *logger_data, uw_logger log_error); void uw_prune_clients(struct uw_context *); failure_kind uw_initialize(struct uw_context *); -struct uw_context * uw_init(int id, void *logger_data, uw_logger log_debug); +struct uw_context * uw_init(int id, uw_loggers *lg); void uw_close(struct uw_context *); int uw_set_app(struct uw_context *, uw_app*); uw_app *uw_get_app(struct uw_context *); @@ -36,6 +36,8 @@ failure_kind uw_begin_init(struct uw_context *); void uw_set_on_success(char *); void uw_set_headers(struct uw_context *, char *(*get_header)(void *, const char *), void *get_header_data); void uw_set_env(struct uw_context *, char *(*get_env)(void *, const char *), void *get_env_data); +uw_loggers* uw_get_loggers(struct uw_context *ctx); +uw_loggers* uw_get_loggers(struct uw_context *ctx); failure_kind uw_begin(struct uw_context *, char *path); void uw_ensure_transaction(struct uw_context *); failure_kind uw_begin_onError(struct uw_context *, char *msg); diff --git a/src/c/cgi.c b/src/c/cgi.c index 539b83c2..d060532c 100644 --- a/src/c/cgi.c +++ b/src/c/cgi.c @@ -60,8 +60,10 @@ static void log_error(void *data, const char *fmt, ...) { static void log_debug(void *data, const char *fmt, ...) { } +static uw_loggers ls = {NULL, log_error, log_debug}; + int main(int argc, char *argv[]) { - uw_context ctx = uw_request_new_context(0, &uw_application, NULL, log_error, log_debug); + uw_context ctx = uw_request_new_context(0, &uw_application, &ls); uw_request_context rc = uw_new_request_context(); request_result rr; char *method = getenv("REQUEST_METHOD"), @@ -108,7 +110,7 @@ int main(int argc, char *argv[]) { uw_set_on_success(""); uw_set_headers(ctx, get_header, NULL); uw_set_env(ctx, get_env, NULL); - uw_request_init(&uw_application, NULL, log_error, log_debug); + uw_request_init(&uw_application, &ls); body[body_pos] = 0; rr = uw_request(rc, ctx, method, path, query_string, body, body_pos, diff --git a/src/c/fastcgi.c b/src/c/fastcgi.c index 5c80d3ae..f3e66e3a 100644 --- a/src/c/fastcgi.c +++ b/src/c/fastcgi.c @@ -324,7 +324,8 @@ int fastcgi_send_normal(int sock, const void *buf, ssize_t len) { static void *worker(void *data) { FCGI_Input *in = fastcgi_input(); FCGI_Output *out = fastcgi_output(); - uw_context ctx = uw_request_new_context(*(int *)data, &uw_application, out, log_error, log_debug); + uw_loggers ls = {out, log_error, log_debug}; + uw_context ctx = uw_request_new_context(*(int *)data, &uw_application, &ls); uw_request_context rc = uw_new_request_context(); headers hs; size_t body_size = 0; @@ -514,7 +515,7 @@ static void sigint(int signum) { exit(0); } -static loggers ls = {&uw_application, NULL, log_error, log_debug}; +static uw_loggers ls = {NULL, log_error, log_debug}; int main(int argc, char *argv[]) { // The skeleton for this function comes from Beej's sockets tutorial. @@ -563,7 +564,7 @@ int main(int argc, char *argv[]) { } uw_set_on_success(""); - uw_request_init(&uw_application, NULL, log_error, log_debug); + uw_request_init(&uw_application, &ls); names = calloc(nthreads, sizeof(int)); @@ -572,7 +573,11 @@ int main(int argc, char *argv[]) { { pthread_t thread; - if (pthread_create_big(&thread, NULL, client_pruner, &ls)) { + pruner_data *pd = (pruner_data *)malloc(sizeof(pruner_data)); + pd->app = &uw_application; + pd->loggers = &ls; + + if (pthread_create_big(&thread, NULL, client_pruner, pd)) { fprintf(stderr, "Error creating pruner thread\n"); return 1; } diff --git a/src/c/http.c b/src/c/http.c index 25d2a320..32dd1dd1 100644 --- a/src/c/http.c +++ b/src/c/http.c @@ -70,9 +70,11 @@ static void log_debug(void *data, const char *fmt, ...) { } } +static uw_loggers ls = {NULL, log_error, log_debug}; + static void *worker(void *data) { int me = *(int *)data; - uw_context ctx = uw_request_new_context(me, &uw_application, NULL, log_error, log_debug); + uw_context ctx = uw_request_new_context(me, &uw_application, &ls); size_t buf_size = 1024; char *buf = malloc(buf_size), *back = buf; uw_request_context rc = uw_new_request_context(); @@ -307,8 +309,6 @@ static void sigint(int signum) { exit(0); } -static loggers ls = {&uw_application, NULL, log_error, log_debug}; - int main(int argc, char *argv[]) { // The skeleton for this function comes from Beej's sockets tutorial. int sockfd; // listen on sock_fd @@ -374,7 +374,7 @@ int main(int argc, char *argv[]) { } } - uw_request_init(&uw_application, NULL, log_error, log_debug); + uw_request_init(&uw_application, &ls); names = calloc(nthreads, sizeof(int)); @@ -411,7 +411,11 @@ int main(int argc, char *argv[]) { { pthread_t thread; - if (pthread_create_big(&thread, NULL, client_pruner, &ls)) { + pruner_data *pd = (pruner_data *)malloc(sizeof(pruner_data)); + pd->app = &uw_application; + pd->loggers = &ls; + + if (pthread_create_big(&thread, NULL, client_pruner, pd)) { fprintf(stderr, "Error creating pruner thread\n"); return 1; } diff --git a/src/c/request.c b/src/c/request.c index b925cc3c..813d967c 100644 --- a/src/c/request.c +++ b/src/c/request.c @@ -12,6 +12,7 @@ #include #include "urweb.h" +#include "request.h" #define MAX_RETRIES 5 @@ -32,8 +33,11 @@ static int try_rollback(uw_context ctx, int will_retry, void *logger_data, uw_lo return r; } -uw_context uw_request_new_context(int id, uw_app *app, void *logger_data, uw_logger log_error, uw_logger log_debug) { - uw_context ctx = uw_init(id, logger_data, log_debug); +uw_context uw_request_new_context(int id, uw_app *app, uw_loggers *ls) { + void *logger_data = ls->logger_data; + uw_logger log_debug = ls->log_debug; + uw_logger log_error = ls->log_error; + uw_context ctx = uw_init(id, ls); int retries_left = MAX_RETRIES; uw_set_app(ctx, app); @@ -77,21 +81,16 @@ static void *ticker(void *data) { return NULL; } -typedef struct { - uw_app *app; - void *logger_data; - uw_logger log_error, log_debug; -} loggers; - typedef struct { int id; - loggers *ls; + uw_loggers *ls; uw_periodic pdic; + uw_app *app; } periodic; static void *periodic_loop(void *data) { periodic *p = (periodic *)data; - uw_context ctx = uw_request_new_context(p->id, p->ls->app, p->ls->logger_data, p->ls->log_error, p->ls->log_debug); + uw_context ctx = uw_request_new_context(p->id, p->app, p->ls); if (!ctx) exit(1); @@ -145,14 +144,17 @@ int pthread_create_big(pthread_t *outThread, void *foo, void *threadFunc, void * } } -void uw_request_init(uw_app *app, void *logger_data, uw_logger log_error, uw_logger log_debug) { +void uw_request_init(uw_app *app, uw_loggers* ls) { uw_context ctx; failure_kind fk; uw_periodic *ps; - loggers *ls = malloc(sizeof(loggers)); int id; char *stackSize_s; + uw_logger log_debug = ls->log_debug; + uw_logger log_error = ls->log_error; + void* logger_data = ls->logger_data; + if ((stackSize_s = getenv("URWEB_STACK_SIZE")) != NULL && stackSize_s[0] != 0) { stackSize = atoll(stackSize_s); @@ -162,11 +164,6 @@ void uw_request_init(uw_app *app, void *logger_data, uw_logger log_error, uw_log } } - ls->app = app; - ls->logger_data = logger_data; - ls->log_error = log_error; - ls->log_debug = log_debug; - uw_global_init(); uw_app_init(app); @@ -179,7 +176,7 @@ void uw_request_init(uw_app *app, void *logger_data, uw_logger log_error, uw_log } } - ctx = uw_request_new_context(0, app, logger_data, log_error, log_debug); + ctx = uw_request_new_context(0, app, ls); if (!ctx) exit(1); @@ -205,6 +202,7 @@ void uw_request_init(uw_app *app, void *logger_data, uw_logger log_error, uw_log arg->id = id++; arg->ls = ls; arg->pdic = *ps; + arg->app = app; if (pthread_create_big(&thread, NULL, periodic_loop, arg)) { fprintf(stderr, "Error creating periodic thread\n"); @@ -240,7 +238,7 @@ request_result uw_request(uw_request_context rc, uw_context ctx, void (*on_success)(uw_context), void (*on_failure)(uw_context), void *logger_data, uw_logger log_error, uw_logger log_debug, int sock, - int (*send)(int sockfd, const void *buf, size_t len), + int (*send)(int sockfd, const void *buf, ssize_t len), int (*close)(int fd)) { int retries_left = MAX_RETRIES; failure_kind fk; @@ -588,8 +586,8 @@ request_result uw_request(uw_request_context rc, uw_context ctx, } void *client_pruner(void *data) { - loggers *ls = (loggers *)data; - uw_context ctx = uw_request_new_context(0, ls->app, ls->logger_data, ls->log_error, ls->log_debug); + pruner_data *pd = (pruner_data *)data; + uw_context ctx = uw_request_new_context(0, pd->app, pd->loggers); if (!ctx) exit(1); diff --git a/src/c/static.c b/src/c/static.c index 80ea5387..8f35a2d4 100644 --- a/src/c/static.c +++ b/src/c/static.c @@ -7,13 +7,15 @@ extern uw_app uw_application; -static void log_debug(void *data, const char *fmt, ...) { +static void log_(void *data, const char *fmt, ...) { va_list ap; va_start(ap, fmt); vprintf(fmt, ap); } +static uw_loggers loggers = {NULL, log_, log_}; + int main(int argc, char *argv[]) { uw_context ctx; failure_kind fk; @@ -23,7 +25,7 @@ int main(int argc, char *argv[]) { return 1; } - ctx = uw_init(0, NULL, log_debug); + ctx = uw_init(0, &loggers); uw_set_app(ctx, &uw_application); uw_initialize(ctx); diff --git a/src/c/urweb.c b/src/c/urweb.c index ffcc0146..f2c37885 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -460,8 +460,7 @@ struct uw_context { void *client_data; - void *logger_data; - uw_logger log_debug; + uw_loggers *loggers; int isPost, hasPostBody; uw_Basis_postBody postBody; @@ -484,7 +483,7 @@ size_t uw_page_max = SIZE_MAX; size_t uw_heap_max = SIZE_MAX; size_t uw_script_max = SIZE_MAX; -uw_context uw_init(int id, void *logger_data, uw_logger log_debug) { +uw_context uw_init(int id, uw_loggers *lg) { uw_context ctx = malloc(sizeof(struct uw_context)); ctx->app = NULL; @@ -543,8 +542,7 @@ uw_context uw_init(int id, void *logger_data, uw_logger log_debug) { ctx->client_data = uw_init_client_data(); - ctx->logger_data = logger_data; - ctx->log_debug = log_debug; + ctx->loggers = lg; ctx->isPost = ctx->hasPostBody = 0; @@ -596,6 +594,11 @@ void *uw_get_db(uw_context ctx) { return ctx->db; } + +uw_loggers* uw_get_loggers(struct uw_context *ctx) { + return ctx->loggers; +} + void uw_free(uw_context ctx) { size_t i; @@ -4118,8 +4121,8 @@ uw_Basis_int uw_Basis_naughtyDebug(uw_context ctx, uw_Basis_string s) { } uw_Basis_unit uw_Basis_debug(uw_context ctx, uw_Basis_string s) { - if (ctx->log_debug) - ctx->log_debug(ctx->logger_data, "%s\n", s); + if (ctx->loggers->log_debug) + ctx->loggers->log_debug(ctx->loggers->logger_data, "%s\n", s); else fprintf(stderr, "%s\n", s); return uw_unit_v; -- cgit v1.2.3 From 1e7619137f25ceb0cef59100bc5a41ffc21a1412 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Thu, 17 Apr 2014 17:41:24 -0400 Subject: uw_register_transactional() can return error codes --- doc/manual.tex | 6 +++--- include/urweb/urweb_cpp.h | 2 +- src/c/urweb.c | 7 +++++-- 3 files changed, 9 insertions(+), 6 deletions(-) (limited to 'include/urweb/urweb_cpp.h') diff --git a/doc/manual.tex b/doc/manual.tex index 98ebaac5..ea866309 100644 --- a/doc/manual.tex +++ b/doc/manual.tex @@ -2459,10 +2459,10 @@ void *uw_malloc(uw_context, size_t); \item \begin{verbatim} typedef void (*uw_callback)(void *); typedef void (*uw_callback_with_retry)(void *, int will_retry); -void uw_register_transactional(uw_context, void *data, uw_callback commit, - uw_callback rollback, uw_callback_with_retry free); +int uw_register_transactional(uw_context, void *data, uw_callback commit, + uw_callback rollback, uw_callback_with_retry free); \end{verbatim} - All side effects in Ur/Web programs need to be compatible with transactions, such that any set of actions can be undone at any time. Thus, you should not perform actions with non-local side effects directly; instead, register handlers to be called when the current transaction is committed or rolled back. The arguments here give an arbitary piece of data to be passed to callbacks, a function to call on commit, a function to call on rollback, and a function to call afterward in either case to clean up any allocated resources. A rollback handler may be called after the associated commit handler has already been called, if some later part of the commit process fails. A free handler is told whether the runtime system expects to retry the current page request after rollback finishes. + All side effects in Ur/Web programs need to be compatible with transactions, such that any set of actions can be undone at any time. Thus, you should not perform actions with non-local side effects directly; instead, register handlers to be called when the current transaction is committed or rolled back. The arguments here give an arbitary piece of data to be passed to callbacks, a function to call on commit, a function to call on rollback, and a function to call afterward in either case to clean up any allocated resources. A rollback handler may be called after the associated commit handler has already been called, if some later part of the commit process fails. A free handler is told whether the runtime system expects to retry the current page request after rollback finishes. The return value of \texttt{uw\_register\_transactional()} is 0 on success and nonzero on failure (where failure currently only happens when exceeding configured limits on number of transactionals). Any of the callbacks may be \texttt{NULL}. To accommodate some stubbornly non-transactional real-world actions like sending an e-mail message, Ur/Web treats \texttt{NULL} \texttt{rollback} callbacks specially. When a transaction commits, all \texttt{commit} actions that have non-\texttt{NULL} rollback actions are tried before any \texttt{commit} actions that have \texttt{NULL} rollback actions. Furthermore, an SQL \texttt{COMMIT} is also attempted in between the two phases, so the nicely transactional actions have a chance to influence whether data are committed to the database, while \texttt{NULL}-rollback actions only get run in the first place after committing data. The reason for all this is that it is \emph{expected} that concurrency interactions will cause database commits to fail in benign ways that call for transaction restart. A truly non-undoable action should only be run after we are sure the database transaction will commit. diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h index b016f038..8e65ace3 100644 --- a/include/urweb/urweb_cpp.h +++ b/include/urweb/urweb_cpp.h @@ -280,7 +280,7 @@ uw_Basis_int uw_Basis_datetimeSecond(struct uw_context *, uw_Basis_time); uw_Basis_int uw_Basis_datetimeDayOfWeek(struct uw_context *, uw_Basis_time); extern const uw_Basis_time uw_Basis_minTime; -void uw_register_transactional(struct uw_context *, void *data, uw_callback commit, uw_callback rollback, uw_callback_with_retry free); +int uw_register_transactional(struct uw_context *, void *data, uw_callback commit, uw_callback rollback, uw_callback_with_retry free); void uw_check_heap(struct uw_context *, size_t extra); char *uw_heap_front(struct uw_context *); diff --git a/src/c/urweb.c b/src/c/urweb.c index 7417e4b7..9a1e40a7 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -3469,11 +3469,12 @@ int uw_commit(uw_context ctx) { size_t uw_transactionals_max = SIZE_MAX; -void uw_register_transactional(uw_context ctx, void *data, uw_callback commit, uw_callback rollback, +int uw_register_transactional(uw_context ctx, void *data, uw_callback commit, uw_callback rollback, uw_callback_with_retry free) { if (ctx->used_transactionals >= ctx->n_transactionals) { if (ctx->used_transactionals+1 > uw_transactionals_max) - uw_error(ctx, FATAL, "Exceeded limit on number of transactionals"); + // Exceeded limit on number of transactionals. + return -1; ctx->transactionals = realloc(ctx->transactionals, sizeof(transactional) * (ctx->used_transactionals+1)); ++ctx->n_transactionals; } @@ -3482,6 +3483,8 @@ void uw_register_transactional(uw_context ctx, void *data, uw_callback commit, u ctx->transactionals[ctx->used_transactionals].commit = commit; ctx->transactionals[ctx->used_transactionals].rollback = rollback; ctx->transactionals[ctx->used_transactionals++].free = free; + + return 0; } -- cgit v1.2.3 From 1580340ec252e4e399c2c1d2b403974f49c3a084 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Fri, 2 May 2014 15:32:10 -0400 Subject: HTML5 data-* attributes --- doc/manual.tex | 6 ++-- include/urweb/urweb_cpp.h | 2 ++ lib/js/urweb.js | 13 ++++++++ lib/ur/basis.urs | 33 +++++++++++-------- src/c/urweb.c | 10 ++++++ src/mono_opt.sml | 10 ++++++ src/monoize.sml | 32 ++++++++++++++++++- src/settings.sml | 1 + src/urweb.grm | 81 ++++++++++++++++++++++++++++++++--------------- tests/data_attr.ur | 26 +++++++++++++++ tests/data_attr.urs | 1 + 11 files changed, 173 insertions(+), 42 deletions(-) create mode 100644 tests/data_attr.ur create mode 100644 tests/data_attr.urs (limited to 'include/urweb/urweb_cpp.h') diff --git a/doc/manual.tex b/doc/manual.tex index ea866309..2a65c906 100644 --- a/doc/manual.tex +++ b/doc/manual.tex @@ -2052,7 +2052,9 @@ $$\begin{array}{l} \hspace{.1in} \Rightarrow \mt{xml} \; \mt{ctx} \; \mt{use_1} \; \mt{bind} \to \mt{xml} \; \mt{ctx} \; (\mt{use_1} \rc \mt{use_2}) \; \mt{bind} \end{array}$$ -We will not list here the different HTML tags and related functions from the standard library. They should be easy enough to understand from the code in \texttt{basis.urs}. The set of tags in the library is not yet claimed to be complete for HTML standards. Also note that there is currently no way for the programmer to add his own tags. It \emph{is} possible to add new tags directly to \texttt{basis.urs}, but this should only be done as a prelude to suggesting a patch to the main distribution. +We will not list here the different HTML tags and related functions from the standard library. They should be easy enough to understand from the code in \texttt{basis.urs}. The set of tags in the library is not yet claimed to be complete for HTML standards. Also note that there is currently no way for the programmer to add his own tags, without using the foreign function interface (Section \ref{ffi}). + +Some tags support HTML5 \texttt{data-*} attributes, which in Ur/Web are encoded as a single attribute $\mt{Data}$ with type $\mt{data\_attrs}$ encoding one or more attributes of this kind. See \texttt{basis.urs} for details. The usual HTML5 syntax for these attributes is supported by the Ur/Web parser as syntactic sugar. One last useful function is for aborting any page generation, returning some XML as an error message. This function takes the place of some uses of a general exception mechanism. $$\begin{array}{l} @@ -2396,7 +2398,7 @@ The currently supported task kinds are: \end{itemize} -\section{The Foreign Function Interface} +\section{\label{ffi}The Foreign Function Interface} It is possible to call your own C and JavaScript code from Ur/Web applications, via the foreign function interface (FFI). The starting point for a new binding is a \texttt{.urs} signature file that presents your external library as a single Ur/Web module (with no nested modules). Compilation conventions map the types and values that you use into C and/or JavaScript types and values. diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h index 8e65ace3..5a4411e8 100644 --- a/include/urweb/urweb_cpp.h +++ b/include/urweb/urweb_cpp.h @@ -387,6 +387,8 @@ uw_Basis_string uw_Basis_fieldValue(struct uw_context *, uw_Basis_postField); uw_Basis_string uw_Basis_remainingFields(struct uw_context *, uw_Basis_postField); uw_Basis_postField *uw_Basis_firstFormField(struct uw_context *, uw_Basis_string); +uw_Basis_string uw_Basis_blessData(struct uw_context *, uw_Basis_string); + extern const char uw_begin_xhtml[], uw_begin_html5[]; #endif diff --git a/lib/js/urweb.js b/lib/js/urweb.js index fe628130..ac9e9771 100644 --- a/lib/js/urweb.js +++ b/lib/js/urweb.js @@ -1942,6 +1942,19 @@ function bless(s) { } +// Attribute name blessing + +function blessData(s) { + for (var i = 0; i < s.length; ++i) { + var c = s[i]; + if (!isAlnum(c) && c != '-' && c != '_') + er("Disallowed character in data-* attribute name"); + } + + return s; +} + + // CSS validation function atom(s) { diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index 2525d676..4922e0ca 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -796,11 +796,17 @@ val active : unit val script : unit -> tag [Code = transaction unit] head [] [] [] -val head : unit -> tag [] html head [] [] -val title : unit -> tag [] head [] [] [] -val link : unit -> tag [Id = id, Rel = string, Typ = string, Href = url, Media = string] head [] [] [] +(* Type for HTML5 "data-*" attributes. *) +type data_attr +val data_attr : string (* Key *) -> string (* Value *) -> data_attr +(* This function will fail if the key doesn't meet HTML's lexical rules! *) +val data_attrs : data_attr -> data_attr -> data_attr -val body : unit -> tag [Onload = transaction unit, Onresize = transaction unit, Onunload = transaction unit, Onhashchange = transaction unit] +val head : unit -> tag [Data = data_attr] html head [] [] +val title : unit -> tag [Data = data_attr] head [] [] [] +val link : unit -> tag [Data = data_attr, Id = id, Rel = string, Typ = string, Href = url, Media = string] head [] [] [] + +val body : unit -> tag [Data = data_attr, Onload = transaction unit, Onresize = transaction unit, Onunload = transaction unit, Onhashchange = transaction unit] html body [] [] con bodyTag = fn (attrs :: {Type}) => ctx ::: {Unit} -> @@ -811,7 +817,7 @@ con bodyTagStandalone = fn (attrs :: {Type}) => -> [[Body] ~ ctx] => unit -> tag attrs ([Body] ++ ctx) [] [] [] -val br : bodyTagStandalone [Id = id] +val br : bodyTagStandalone [Data = data_attr, Id = id] con focusEvents = [Onblur = transaction unit, Onfocus = transaction unit] @@ -837,8 +843,8 @@ con scrollEvents = [Onscroll = transaction unit] con boxEvents = focusEvents ++ mouseEvents ++ keyEvents ++ resizeEvents ++ scrollEvents con tableEvents = focusEvents ++ mouseEvents ++ keyEvents -con boxAttrs = [Id = id, Title = string] ++ boxEvents -con tableAttrs = [Id = id, Title = string] ++ tableEvents +con boxAttrs = [Data = data_attr, Id = id, Title = string] ++ boxEvents +con tableAttrs = [Data = data_attr, Id = id, Title = string] ++ tableEvents val span : bodyTag boxAttrs val div : bodyTag boxAttrs @@ -901,7 +907,7 @@ con formTag = fn (ty :: Type) (inner :: {Unit}) (attrs :: {Type}) => -> [[Form] ~ ctx] => nm :: Name -> unit -> tag attrs ([Form] ++ ctx) inner [] [nm = ty] -val hidden : formTag string [] [Id = string, Value = string] +val hidden : formTag string [] [Data = data_attr, Id = string, Value = string] val textbox : formTag string [] ([Value = string, Size = int, Placeholder = string, Source = source string, Onchange = transaction unit, Ontext = transaction unit] ++ boxAttrs) val password : formTag string [] ([Value = string, Size = int, Placeholder = string] ++ boxAttrs) @@ -935,12 +941,12 @@ val fieldValue : postField -> string val remainingFields : postField -> string con radio = [Body, Radio] -val radio : formTag (option string) radio [Id = id] +val radio : formTag (option string) radio [Data = data_attr, Id = id] val radioOption : unit -> tag ([Value = string, Checked = bool] ++ boxAttrs) radio [] [] [] con select = [Select] val select : formTag string select ([Onchange = transaction unit] ++ boxAttrs) -val option : unit -> tag [Value = string, Selected = bool] select [] [] [] +val option : unit -> tag [Data = data_attr, Value = string, Selected = bool] select [] [] [] val submit : ctx ::: {Unit} -> use ::: {Type} -> [[Form] ~ ctx] => @@ -1006,15 +1012,16 @@ val tfoot : other ::: {Unit} -> [other ~ [Table]] => unit val dl : other ::: {Unit} -> [other ~ [Body,Dl]] => unit - -> tag [] ([Body] ++ other) ([Dl] ++ other) [] [] + -> tag [Data = data_attr] ([Body] ++ other) ([Dl] ++ other) [] [] val dt : other ::: {Unit} -> [other ~ [Body,Dl]] => unit - -> tag [] ([Dl] ++ other) ([Body] ++ other) [] [] + -> tag [Data = data_attr] ([Dl] ++ other) ([Body] ++ other) [] [] val dd : other ::: {Unit} -> [other ~ [Body,Dl]] => unit - -> tag [] ([Dl] ++ other) ([Body] ++ other) [] [] + -> tag [Data = data_attr] ([Dl] ++ other) ([Body] ++ other) [] [] + (** Aborting *) diff --git a/src/c/urweb.c b/src/c/urweb.c index 9a1e40a7..26046461 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -4396,3 +4396,13 @@ uw_Basis_postField *uw_Basis_firstFormField(uw_context ctx, uw_Basis_string s) { return f; } + +uw_Basis_string uw_Basis_blessData(uw_context ctx, uw_Basis_string s) { + char *p = s; + + for (; *p; ++p) + if (!isalnum(*p) && *p != '-' && *p != '_') + uw_error(ctx, FATAL, "Illegal HTML5 data-* attribute: %s", s); + + return s; +} diff --git a/src/mono_opt.sml b/src/mono_opt.sml index 228c53e6..ae306e68 100644 --- a/src/mono_opt.sml +++ b/src/mono_opt.sml @@ -118,6 +118,9 @@ fun unAs s = end fun checkUrl s = CharVector.all Char.isGraph s andalso Settings.checkUrl s +val checkData = CharVector.all (fn ch => Char.isAlphaNum ch + orelse ch = #"_" + orelse ch = #"-") val checkAtom = CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"+" orelse ch = #"-" @@ -442,6 +445,13 @@ fun exp e = | ESignalBind ((ESignalReturn e1, loc), e2) => optExp (EApp (e2, e1), loc) + | EFfiApp ("Basis", "blessData", [((se as EPrim (Prim.String s), loc), _)]) => + (if checkData s then + () + else + ErrorMsg.errorAt loc ("Invalid HTML5 data-* attribute " ^ s); + se) + | EFfiApp ("Basis", "bless", [((se as EPrim (Prim.String s), loc), _)]) => (if checkUrl s then () diff --git a/src/monoize.sml b/src/monoize.sml index 769a1e32..cdcd2bec 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -1,4 +1,4 @@ -(* Copyright (c) 2008-2013, Adam Chlipala +(* Copyright (c) 2008-2014, Adam Chlipala * All rights reserved. * * Redistribution and use in source and binary forms, with or without @@ -235,6 +235,7 @@ fun monoType env = | L.CFfi ("Basis", "requestHeader") => (L'.TFfi ("Basis", "string"), loc) | L.CFfi ("Basis", "responseHeader") => (L'.TFfi ("Basis", "string"), loc) | L.CFfi ("Basis", "envVar") => (L'.TFfi ("Basis", "string"), loc) + | L.CFfi ("Basis", "data_attr") => (L'.TFfi ("Basis", "string"), loc) | L.CApp ((L.CFfi ("Basis", "serialized"), _), _) => (L'.TFfi ("Basis", "string"), loc) @@ -3117,6 +3118,29 @@ fun monoExp (env, st, fm) (all as (e, loc)) = fm) end + | L.EFfiApp ("Basis", "data_attr", [(s1, _), (s2, _)]) => + let + val (s1, fm) = monoExp (env, st, fm) s1 + val (s2, fm) = monoExp (env, st, fm) s2 + in + ((L'.EStrcat ((L'.EPrim (Prim.String "data-"), loc), + (L'.EStrcat ((L'.EFfiApp ("Basis", "blessData", [(s1, (L'.TFfi ("Basis", "string"), loc))]), loc), + (L'.EStrcat ((L'.EPrim (Prim.String "=\""), loc), + (L'.EStrcat ((L'.EFfiApp ("Basis", "attrifyString", [(s2, (L'.TFfi ("Basis", "string"), loc))]), loc), + (L'.EPrim (Prim.String "\""), loc)), loc)), + loc)), loc)), loc), + fm) + end + + | L.EFfiApp ("Basis", "data_attrs", [(s1, _), (s2, _)]) => + let + val (s1, fm) = monoExp (env, st, fm) s1 + val (s2, fm) = monoExp (env, st, fm) s2 + in + ((L'.EStrcat (s1, (L'.EStrcat ((L'.EPrim (Prim.String " "), loc), s2), loc)), loc), + fm) + end + | L.EFfiApp ("Basis", "css_url", [(s, _)]) => let val (s, fm) = monoExp (env, st, fm) s @@ -3317,6 +3341,12 @@ fun monoExp (env, st, fm) (all as (e, loc)) = val (s, fm) = foldl (fn (("Action", _, _), acc) => acc | (("Source", _, _), acc) => acc + | (("Data", e, _), (s, fm)) => + ((L'.EStrcat (s, + (L'.EStrcat ( + (L'.EPrim (Prim.String " "), loc), + e), loc)), loc), + fm) | ((x, e, t), (s, fm)) => case t of (L'.TFfi ("Basis", "bool"), _) => diff --git a/src/settings.sml b/src/settings.sml index 6282577d..4cdb4119 100644 --- a/src/settings.sml +++ b/src/settings.sml @@ -309,6 +309,7 @@ val jsFuncsBase = basisM [("alert", "alert"), ("checkUrl", "checkUrl"), ("bless", "bless"), + ("blessData", "blessData"), ("eq_time", "eq"), ("lt_time", "lt"), diff --git a/src/urweb.grm b/src/urweb.grm index 84a337f8..bb195cda 100644 --- a/src/urweb.grm +++ b/src/urweb.grm @@ -225,7 +225,7 @@ fun tagIn bt = datatype prop_kind = Delete | Update -datatype attr = Class of exp | DynClass of exp | Style of exp | DynStyle of exp | Normal of con * exp +datatype attr = Class of exp | DynClass of exp | Style of exp | DynStyle of exp | Normal of con * exp | Data of string * exp fun patType loc (p : pat) = case #1 p of @@ -453,7 +453,7 @@ fun applyWindow loc e window = | rpat of (string * pat) list * bool | ptuple of pat list - | attrs of exp option * exp option * exp option * exp option * (con * exp) list + | attrs of exp option * exp option * exp option * exp option * (string * exp) list * (con * exp) list | attr of attr | attrv of exp @@ -1602,7 +1602,31 @@ tag : tagHead attrs (let | SOME e => (EApp ((EVar (["Basis"], "Some", Infer), pos), e), pos) val e = (EApp (e, eo), pos) - val e = (EApp (e, (ERecord (#5 attrs), pos)), pos) + + val atts = case #5 attrs of + [] => #6 attrs + | data :: datas => + let + fun doOne (name, value) = + let + val e = (EVar (["Basis"], "data_attr", Infer), pos) + val e = (EApp (e, (EPrim (Prim.String name), pos)), pos) + in + (EApp (e, value), pos) + end + + val datas' = foldl (fn (nv, acc) => + let + val e = (EVar (["Basis"], "data_attrs", Infer), pos) + val e = (EApp (e, acc), pos) + in + (EApp (e, doOne nv), pos) + end) (doOne data) datas + in + ((CName "Data", pos), datas') :: #6 attrs + end + + val e = (EApp (e, (ERecord atts, pos)), pos) val e = (EApp (e, (EApp (#2 tagHead, (ERecord [], pos)), pos)), pos) in @@ -1618,7 +1642,7 @@ tagHead: BEGIN_TAG (let end) | tagHead LBRACE cexp RBRACE (#1 tagHead, (ECApp (#2 tagHead, cexp), s (tagHeadleft, RBRACEright))) -attrs : (NONE, NONE, NONE, NONE, []) +attrs : (NONE, NONE, NONE, NONE, [], []) | attr attrs (let val loc = s (attrleft, attrsright) in @@ -1627,24 +1651,26 @@ attrs : (NONE, NONE, NONE, NONE, []) (case #1 attrs of NONE => () | SOME _ => ErrorMsg.errorAt loc "Multiple classes specified for tag"; - (SOME e, #2 attrs, #3 attrs, #4 attrs, #5 attrs)) + (SOME e, #2 attrs, #3 attrs, #4 attrs, #5 attrs, #6 attrs)) | DynClass e => (case #2 attrs of NONE => () | SOME _ => ErrorMsg.errorAt loc "Multiple dynamic classes specified for tag"; - (#1 attrs, SOME e, #3 attrs, #4 attrs, #5 attrs)) + (#1 attrs, SOME e, #3 attrs, #4 attrs, #5 attrs, #6 attrs)) | Style e => (case #3 attrs of NONE => () | SOME _ => ErrorMsg.errorAt loc "Multiple styles specified for tag"; - (#1 attrs, #2 attrs, SOME e, #4 attrs, #5 attrs)) + (#1 attrs, #2 attrs, SOME e, #4 attrs, #5 attrs, #6 attrs)) | DynStyle e => (case #4 attrs of NONE => () | SOME _ => ErrorMsg.errorAt loc "Multiple dynamic classes specified for tag"; - (#1 attrs, #2 attrs, #3 attrs, SOME e, #5 attrs)) + (#1 attrs, #2 attrs, #3 attrs, SOME e, #5 attrs, #6 attrs)) + | Data xe => + (#1 attrs, #2 attrs, #3 attrs, #4 attrs, xe :: #5 attrs, #6 attrs) | Normal xe => - (#1 attrs, #2 attrs, #3 attrs, #4 attrs, xe :: #5 attrs) + (#1 attrs, #2 attrs, #3 attrs, #4 attrs, #5 attrs, xe :: #6 attrs) end) attr : SYMBOL EQ attrv (case SYMBOL of @@ -1653,23 +1679,26 @@ attr : SYMBOL EQ attrv (case SYMBOL of | "style" => Style attrv | "dynStyle" => DynStyle attrv | _ => - let - val sym = makeAttr SYMBOL - in - Normal ((CName sym, s (SYMBOLleft, SYMBOLright)), - if (sym = "Href" orelse sym = "Src") - andalso (case #1 attrv of - EPrim _ => true - | _ => false) then - let - val loc = s (attrvleft, attrvright) - in - (EApp ((EVar (["Basis"], "bless", Infer), loc), - attrv), loc) - end - else - attrv) - end) + if String.isPrefix "data-" SYMBOL then + Data (String.extract (SYMBOL, 5, NONE), attrv) + else + let + val sym = makeAttr SYMBOL + in + Normal ((CName sym, s (SYMBOLleft, SYMBOLright)), + if (sym = "Href" orelse sym = "Src") + andalso (case #1 attrv of + EPrim _ => true + | _ => false) then + let + val loc = s (attrvleft, attrvright) + in + (EApp ((EVar (["Basis"], "bless", Infer), loc), + attrv), loc) + end + else + attrv) + end) attrv : INT (EPrim (Prim.Int INT), s (INTleft, INTright)) | FLOAT (EPrim (Prim.Float FLOAT), s (FLOATleft, FLOATright)) diff --git a/tests/data_attr.ur b/tests/data_attr.ur new file mode 100644 index 00000000..80dda857 --- /dev/null +++ b/tests/data_attr.ur @@ -0,0 +1,26 @@ +fun dynd r = return +
How about that?
+ + +fun main () : transaction page = + s <- source ; + a <- source ""; + v <- source ""; + return +
Whoa there, cowboy!
+ +
+ +
+ = + + + +
+ + = +