diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/c/memmem.c | 16 | ||||
-rw-r--r-- | src/c/openssl.c | 32 | ||||
-rw-r--r-- | src/c/request.c | 4 | ||||
-rw-r--r-- | src/c/urweb.c | 59 | ||||
-rw-r--r-- | src/compiler.sml | 2 | ||||
-rw-r--r-- | src/elisp/urweb-mode.el | 1 | ||||
-rw-r--r-- | src/main.mlton.sml | 10 | ||||
-rw-r--r-- | src/mysql.sml | 4 | ||||
-rw-r--r-- | src/postgres.sml | 12 | ||||
-rw-r--r-- | src/settings.sml | 13 |
10 files changed, 120 insertions, 33 deletions
diff --git a/src/c/memmem.c b/src/c/memmem.c index 68526714..f31f4e31 100644 --- a/src/c/memmem.c +++ b/src/c/memmem.c @@ -38,6 +38,8 @@ * POSSIBILITY OF SUCH DAMAGE. */ +// Function renamed by Adam Chlipala in 2016. + #include <sys/cdefs.h> #if defined(LIBC_SCCS) && !defined(lint) __RCSID("$NetBSD$"); @@ -53,13 +55,17 @@ __RCSID("$NetBSD$"); #endif /* - * memmem() returns the location of the first occurence of data + * urweb_memmem() returns the location of the first occurence of data * pattern b2 of size len2 in memory block b1 of size len1 or * NULL if none is found. */ void * -memmem(const void *b1, size_t len1, const void *b2, size_t len2) +urweb_memmem(const void *b1, size_t len1, const void *b2, size_t len2) { + /* Sanity check */ + if(!(b1 != NULL && b2 != NULL && len1 != 0 && len2 != 0)) + return NULL; + /* Initialize search pointer */ char *sp = (char *) b1; @@ -69,16 +75,12 @@ memmem(const void *b1, size_t len1, const void *b2, size_t len2) /* Intialize end of search address space pointer */ char *eos = sp + len1 - len2; - /* Sanity check */ - if(!(b1 && b2 && len1 && len2)) - return NULL; - while (sp <= eos) { if (*sp == *pp) if (memcmp(sp, pp, len2) == 0) return sp; - sp++; + sp++; } return NULL; diff --git a/src/c/openssl.c b/src/c/openssl.c index 15c4de5e..5982b831 100644 --- a/src/c/openssl.c +++ b/src/c/openssl.c @@ -1,6 +1,5 @@ #include "config.h" -#include <assert.h> #include <stdlib.h> #include <unistd.h> #include <sys/types.h> @@ -8,17 +7,13 @@ #include <fcntl.h> #include <stdio.h> #include <string.h> -#include <pthread.h> -#include <openssl/crypto.h> +#include <openssl/opensslv.h> #include <openssl/sha.h> #include <openssl/rand.h> #define PASSSIZE 4 -// OpenSSL locks array. See threads(3SSL). -static pthread_mutex_t *openssl_locks; - int uw_hash_blocksize = 32; static int password[PASSSIZE]; @@ -33,6 +28,17 @@ static void random_password() { } } +#if OPENSSL_VERSION_NUMBER < 0x10100000L +// We're using OpenSSL <1.1, so we need to specify threading callbacks. See +// threads(3SSL). + +#include <assert.h> +#include <pthread.h> + +#include <openssl/crypto.h> + +static pthread_mutex_t *openssl_locks; + // OpenSSL callbacks #ifdef PTHREAD_T_IS_POINTER static void thread_id(CRYPTO_THREADID *const result) { @@ -60,7 +66,7 @@ static void lock_or_unlock(const int mode, const int type, const char *file, } } -void uw_init_crypto() { +static void init_openssl() { int i; // Set up OpenSSL. assert(openssl_locks == NULL); @@ -74,6 +80,18 @@ void uw_init_crypto() { } CRYPTO_THREADID_set_callback(thread_id); CRYPTO_set_locking_callback(lock_or_unlock); +} + +#else +// We're using OpenSSL >=1.1, which is thread-safe by default. We don't need to +// do anything here. + +static void init_openssl() {} + +#endif // OPENSSL_VERSION_NUMBER < 0x10100000L + +void uw_init_crypto() { + init_openssl(); // Prepare signatures. if (uw_sig_file) { int fd; diff --git a/src/c/request.c b/src/c/request.c index cad84cb2..a7f23851 100644 --- a/src/c/request.c +++ b/src/c/request.c @@ -16,7 +16,7 @@ #define MAX_RETRIES 5 -void *memmem(const void *b1, size_t len1, const void *b2, size_t len2); +void *urweb_memmem(const void *b1, size_t len1, const void *b2, size_t len2); static int try_rollback(uw_context ctx, int will_retry, void *logger_data, uw_logger log_error) { int r = uw_rollback(ctx, will_retry); @@ -418,7 +418,7 @@ request_result uw_request(uw_request_context rc, uw_context ctx, } } - part = memmem(after_sub_headers, body + body_len - after_sub_headers, boundary, boundary_len); + part = urweb_memmem(after_sub_headers, body + body_len - after_sub_headers, boundary, boundary_len); if (!part) { log_error(logger_data, "Missing boundary after multipart payload\n"); return FAILED; diff --git a/src/c/urweb.c b/src/c/urweb.c index c23366fb..afe8457b 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -4517,6 +4517,54 @@ uw_Basis_int uw_Basis_round(uw_context ctx, uw_Basis_float n) { return round(n); } +uw_Basis_int uw_Basis_floor(uw_context ctx, uw_Basis_float n) { + return floor(n); +} + +uw_Basis_float uw_Basis_pow(uw_context ctx, uw_Basis_float n, uw_Basis_float m) { + return pow(n,m); +} + +uw_Basis_float uw_Basis_sqrt(uw_context ctx, uw_Basis_float n) { + return sqrt(n); +} + +uw_Basis_float uw_Basis_sin(uw_context ctx, uw_Basis_float n) { + return sin(n); +} + +uw_Basis_float uw_Basis_cos(uw_context ctx, uw_Basis_float n) { + return cos(n); +} + +uw_Basis_float uw_Basis_log(uw_context ctx, uw_Basis_float n) { + return log(n); +} + +uw_Basis_float uw_Basis_exp(uw_context ctx, uw_Basis_float n) { + return exp(n); +} + +uw_Basis_float uw_Basis_asin(uw_context ctx, uw_Basis_float n) { + return asin(n); +} + +uw_Basis_float uw_Basis_acos(uw_context ctx, uw_Basis_float n) { + return acos(n); +} + +uw_Basis_float uw_Basis_atan(uw_context ctx, uw_Basis_float n) { + return atan(n); +} + +uw_Basis_float uw_Basis_atan2(uw_context ctx, uw_Basis_float n, uw_Basis_float m) { + return atan2(n, m); +} + +uw_Basis_float uw_Basis_abs(uw_context ctx, uw_Basis_float n) { + return fabs(n); +} + uw_Basis_string uw_Basis_atom(uw_context ctx, uw_Basis_string s) { char *p; @@ -4713,7 +4761,7 @@ uw_Sqlcache_Value *uw_Sqlcache_check(uw_context ctx, uw_Sqlcache_Cache *cache, c char *key = uw_Sqlcache_allocKeyBuffer(keys, numKeys); char *buf = key; time_t timeInvalid = cache->timeInvalid; - uw_Sqlcache_Entry *entry; + uw_Sqlcache_Entry *entry = NULL; if (numKeys == 0) { entry = cache->table; if (!entry) { @@ -4748,7 +4796,7 @@ static void uw_Sqlcache_storeCommitOne(uw_Sqlcache_Cache *cache, char **keys, uw pthread_rwlock_wrlock(&cache->lockIn); size_t numKeys = cache->numKeys; time_t timeNow = uw_Sqlcache_getTimeNow(cache); - uw_Sqlcache_Entry *entry; + uw_Sqlcache_Entry *entry = NULL; if (numKeys == 0) { entry = cache->table; if (!entry) { @@ -4920,3 +4968,10 @@ void uw_Sqlcache_flush(uw_context ctx, uw_Sqlcache_Cache *cache, char **keys) { } pthread_rwlock_unlock(&cache->lockIn); } + +int strcmp_nullsafe(const char *str1, const char *str2) { + if (str1) + return strcmp(str1, str2); + else + return 1; +} diff --git a/src/compiler.sml b/src/compiler.sml index 76743fad..dccda06d 100644 --- a/src/compiler.sml +++ b/src/compiler.sml @@ -434,7 +434,7 @@ fun parseUrp' accLibs fname = sql = NONE, debug = Settings.getDebug (), profile = false, - timeout = 60, + timeout = 120, ffi = [], link = [], linker = NONE, diff --git a/src/elisp/urweb-mode.el b/src/elisp/urweb-mode.el index bc71a052..d1eec2a1 100644 --- a/src/elisp/urweb-mode.el +++ b/src/elisp/urweb-mode.el @@ -395,7 +395,6 @@ This mode runs `urweb-mode-hook' just before exiting. ;; Treat paragraph-separators in comments as paragraph-separators. (set (make-local-variable 'paragraph-separate) (concat "\\([ \t]*\\*)?\\)?\\(" paragraph-separate "\\)")) - (set (make-local-variable 'require-final-newline) t) ;; forward-sexp-function is an experimental variable in my hacked Emacs. (set (make-local-variable 'forward-sexp-function) 'urweb-user-forward-sexp) ;; For XEmacs diff --git a/src/main.mlton.sml b/src/main.mlton.sml index f595134f..6d368106 100644 --- a/src/main.mlton.sml +++ b/src/main.mlton.sml @@ -246,7 +246,7 @@ fun oneRun args = fun send (sock, s) = let - val n = Socket.sendVec (sock, Word8VectorSlice.full (Vector.map (Word8.fromInt o ord) s)) + val n = Socket.sendVec (sock, Word8VectorSlice.full (MLton.Word8Vector.fromPoly (Vector.map (Word8.fromInt o ord) (MLton.CharVector.toPoly s)))) in if n >= size s then () @@ -272,7 +272,7 @@ val () = case CommandLine.arguments () of val s = if CharVector.exists (fn ch => ch = #"\n") buf then "" else - Vector.map (chr o Word8.toInt) (Socket.recvVec (sock, 1024)) + MLton.CharVector.fromPoly (Vector.map (chr o Word8.toInt) (MLton.Word8Vector.toPoly (Socket.recvVec (sock, 1024)))) val s = buf ^ s val (befor, after) = Substring.splitl (fn ch => ch <> #"\n") (Substring.full s) in @@ -345,12 +345,12 @@ val () = case CommandLine.arguments () of let val v = Socket.recvVec (sock, 1024) in - if Vector.length v = 0 then + if Word8Vector.length v = 0 then OS.Process.failure else let - val s = Vector.map (chr o Word8.toInt) v - val last = Vector.sub (v, Vector.length v - 1) + val s = MLton.CharVector.fromPoly (Vector.map (chr o Word8.toInt) (MLton.Word8Vector.toPoly v)) + val last = Word8Vector.sub (v, Word8Vector.length v - 1) val (rc, s) = if last = Word8.fromInt 1 then (SOME OS.Process.success, String.substring (s, 0, size s - 1)) else if last = Word8.fromInt 2 then diff --git a/src/mysql.sml b/src/mysql.sml index 539428f6..52e4921e 100644 --- a/src/mysql.sml +++ b/src/mysql.sml @@ -867,7 +867,7 @@ fun queryCommon {loc, query, cols, doCols} = newline, string "uw_error(ctx, FATAL, \"", string (ErrorMsg.spanToString loc), - string ": Error reseting statement: %s\\n%s\", ", + string ": Error resetting statement: %s\\n%s\", ", query, string ", mysql_error(conn->conn));", newline], @@ -931,7 +931,7 @@ fun queryCommon {loc, query, cols, doCols} = string "if (mysql_stmt_reset(stmt)) uw_error(ctx, FATAL, \"", string (ErrorMsg.spanToString loc), - string ": Error reseting statement: %s\\n%s\", ", + string ": Error resetting statement: %s\\n%s\", ", query, string ", mysql_error(conn->conn));", newline, diff --git a/src/postgres.sml b/src/postgres.sml index ddfe0ad6..404384d2 100644 --- a/src/postgres.sml +++ b/src/postgres.sml @@ -443,7 +443,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} = newline, newline, string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {", - box [string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40001\")) {", + box [string "if (!strcmp_nullsafe(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40001\")) {", box [newline, string "PQclear(res);", newline, @@ -451,7 +451,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} = newline], string "}", newline, - string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40P01\")) {", + string "if (!strcmp_nullsafe(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40P01\")) {", box [newline, string "PQclear(res);", newline, @@ -629,7 +629,7 @@ fun queryCommon {loc, query, cols, doCols} = string "if (PQresultStatus(res) != PGRES_TUPLES_OK) {", newline, - box [string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40001\")) {", + box [string "if (!strcmp_nullsafe(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40001\")) {", box [newline, string "PQclear(res);", newline, @@ -637,7 +637,7 @@ fun queryCommon {loc, query, cols, doCols} = newline], string "}", newline, - string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40P01\")) {", + string "if (!strcmp_nullsafe(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40P01\")) {", box [newline, string "PQclear(res);", newline, @@ -800,7 +800,7 @@ fun dmlCommon {loc, dml, mode} = string "if (PQresultStatus(res) != PGRES_COMMAND_OK) {", newline, - box [string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40001\")) {", + box [string "if (!strcmp_nullsafe(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40001\")) {", box [newline, string "PQclear(res);", newline, @@ -808,7 +808,7 @@ fun dmlCommon {loc, dml, mode} = newline], string "}", newline, - string "if (!strcmp(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40P01\")) {", + string "if (!strcmp_nullsafe(PQresultErrorField(res, PG_DIAG_SQLSTATE), \"40P01\")) {", box [newline, string "PQclear(res);", newline, diff --git a/src/settings.sml b/src/settings.sml index 85cab207..b72789df 100644 --- a/src/settings.sml +++ b/src/settings.sml @@ -335,6 +335,19 @@ val jsFuncsBase = basisM [("alert", "alert"), ("ceil", "ceil"), ("trunc", "trunc"), ("round", "round"), + ("floor", "floor"), + + ("pow", "pow"), + ("sqrt", "sqrt"), + ("sin", "sin"), + ("cos", "cos"), + ("log", "log"), + ("exp", "exp"), + ("asin", "asin"), + ("acos", "acos"), + ("atan", "atan"), + ("atan2", "atan2"), + ("abs", "abs"), ("now", "now"), ("timeToString", "showTime"), |