Mercurial > urweb
changeset 1349:87156c44824f
Periodic tasks
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Sat, 18 Dec 2010 15:17:09 -0500 |
| parents | 8a169fc0838b |
| children | a6d421812b93 |
| files | doc/manual.tex include/types.h include/urweb.h lib/ur/basis.urs src/c/request.c src/c/urweb.c src/cjr.sml src/cjr_print.sml src/cjrize.sml tests/periodic.ur |
| diffstat | 10 files changed, 115 insertions(+), 10 deletions(-) [+] |
line wrap: on
line diff
--- a/doc/manual.tex Sat Dec 18 14:17:45 2010 -0500 +++ b/doc/manual.tex Sat Dec 18 15:17:09 2010 -0500 @@ -2100,15 +2100,17 @@ $$\begin{array}{l} \mt{con} \; \mt{task\_kind} :: \mt{Type} \to \mt{Type} \\ \mt{val} \; \mt{initialize} : \mt{task\_kind} \; \mt{unit} \\ -\mt{val} \; \mt{clientLeaves} : \mt{task\_kind} \; \mt{client} +\mt{val} \; \mt{clientLeaves} : \mt{task\_kind} \; \mt{client} \\ +\mt{val} \; \mt{periodic} : \mt{int} \to \mt{task\_kind} \; \mt{unit} \end{array}$$ A task kind names a particular extension point of generated applications, where the type parameter of a task kind describes which extra input data is available at that extension point. Add task code with the special declaration form $\mt{task} \; e_1 = e_2$, where $e_1$ is a task kind with data $\tau$, and $e_2$ is a function from $\tau$ to $\mt{transaction} \; \mt{unit}$. The currently supported task kinds are: \begin{itemize} -\item $\mt{initialize}$: Code that is run in each freshly-allocated request context. +\item $\mt{initialize}$: Code that is run when the application starts up. \item $\mt{clientLeaves}$: Code that is run for each client that the runtime system decides has surfed away. When a request that generates a new client handle is aborted, that handle will still eventually be passed to $\mt{clientLeaves}$ task code, even though the corresponding browser was never informed of the client handle's existence. In other words, in general, $\mt{clientLeaves}$ handlers will be called more times than there are actual clients. +\item $\mt{periodic} \; n$: Code that is run when the application starts up and then every $n$ seconds thereafter. \end{itemize}
--- a/include/types.h Sat Dec 18 14:17:45 2010 -0500 +++ b/include/types.h Sat Dec 18 15:17:09 2010 -0500 @@ -59,6 +59,11 @@ typedef void (*uw_logger)(void*, const char *fmt, ...); typedef struct { + void (*callback)(uw_context); + unsigned int period; +} uw_periodic; + +typedef struct { int inputs_len, timeout; char *url_prefix; @@ -80,6 +85,8 @@ int (*check_mime)(const char *); void (*on_error)(uw_context, char *); + + uw_periodic *periodics; // 0-terminated array } uw_app; #define ERROR_BUF_LEN 1024
--- a/include/urweb.h Sat Dec 18 14:17:45 2010 -0500 +++ b/include/urweb.h Sat Dec 18 15:17:09 2010 -0500 @@ -293,4 +293,6 @@ extern int uw_time_max, uw_supports_direct_status, uw_min_heap; +failure_kind uw_runCallback(uw_context, void (*callback)(uw_context)); + #endif
--- a/lib/ur/basis.urs Sat Dec 18 14:17:45 2010 -0500 +++ b/lib/ur/basis.urs Sat Dec 18 15:17:09 2010 -0500 @@ -813,6 +813,7 @@ con task_kind :: Type -> Type val initialize : task_kind unit val clientLeaves : task_kind client +val periodic : int -> task_kind unit (** Information flow security *)
--- a/src/c/request.c Sat Dec 18 14:17:45 2010 -0500 +++ b/src/c/request.c Sat Dec 18 15:17:09 2010 -0500 @@ -79,9 +79,44 @@ return NULL; } +typedef struct { + uw_app *app; + void *logger_data; + uw_logger log_error, log_debug; +} loggers; + +typedef struct { + loggers *ls; + uw_periodic pdic; +} periodic; + +static void *periodic_loop(void *data) { + periodic *p = (periodic *)data; + uw_context ctx = uw_request_new_context(p->ls->app, p->ls->logger_data, p->ls->log_error, p->ls->log_debug); + + if (!ctx) + exit(1); + + while (1) { + failure_kind r; + do { + r = uw_runCallback(ctx, p->pdic.callback); + } while (r == UNLIMITED_RETRY); + + sleep(p->pdic.period); + }; +} + void uw_request_init(uw_app *app, void *logger_data, uw_logger log_error, uw_logger log_debug) { uw_context ctx; failure_kind fk; + uw_periodic *ps; + loggers *ls = malloc(sizeof(loggers)); + + 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); @@ -113,6 +148,18 @@ } uw_free(ctx); + + for (ps = app->periodics; ps->callback; ++ps) { + pthread_t thread; + periodic *arg = malloc(sizeof(periodic)); + arg->ls = ls; + arg->pdic = *ps; + + if (pthread_create(&thread, NULL, periodic_loop, arg)) { + fprintf(stderr, "Error creating periodic thread\n"); + exit(1); + } + } } @@ -468,12 +515,6 @@ } } -typedef struct { - uw_app *app; - void *logger_data; - uw_logger log_error, log_debug; -} loggers; - void *client_pruner(void *data) { loggers *ls = (loggers *)data; uw_context ctx = uw_request_new_context(ls->app, ls->logger_data, ls->log_error, ls->log_debug);
--- a/src/c/urweb.c Sat Dec 18 14:17:45 2010 -0500 +++ b/src/c/urweb.c Sat Dec 18 15:17:09 2010 -0500 @@ -3492,3 +3492,19 @@ else uw_error(ctx, FATAL, "Asked for POST body when none exists"); } + +failure_kind uw_runCallback(uw_context ctx, void (*callback)(uw_context)) { + int r = setjmp(ctx->jmp_buf); + + if (ctx->app->db_begin(ctx)) + uw_error(ctx, BOUNDED_RETRY, "Error running SQL BEGIN"); + + if (r == 0) { + callback(ctx); + uw_commit(ctx); + } + else + uw_rollback(ctx, 0); + + return r; +}
--- a/src/cjr.sml Sat Dec 18 14:17:45 2010 -0500 +++ b/src/cjr.sml Sat Dec 18 15:17:09 2010 -0500 @@ -103,7 +103,7 @@ withtype exp = exp' located -datatype task = Initialize | ClientLeaves +datatype task = Initialize | ClientLeaves | Periodic of Int64.int datatype decl' = DStruct of int * (string * typ) list
--- a/src/cjr_print.sml Sat Dec 18 14:17:45 2010 -0500 +++ b/src/cjr_print.sml Sat Dec 18 15:17:09 2010 -0500 @@ -2796,6 +2796,7 @@ val initializers = List.mapPartial (fn (DTask (Initialize, x1, x2, e), _) => SOME (x1, x2, e) | _ => NONE) ds val expungers = List.mapPartial (fn (DTask (ClientLeaves, x1, x2, e), _) => SOME (x1, x2, e) | _ => NONE) ds + val periodics = List.mapPartial (fn (DTask (Periodic n, x1, x2, e), _) => SOME (n, x1, x2, e) | _ => NONE) ds val onError = ListUtil.search (fn (DOnError n, _) => SOME n | _ => NONE) ds @@ -2887,6 +2888,36 @@ newline, newline, + box (ListUtil.mapi (fn (i, (_, x1, x2, e)) => + box [string "static void uw_periodic", + string (Int.toString i), + string "(uw_context ctx) {", + newline, + box [string "uw_unit __uwr_", + string x1, + string "_0 = uw_unit_v, __uwr_", + string x2, + string "_1 = uw_unit_v;", + newline, + p_exp (E.pushERel (E.pushERel env x1 dummyt) x2 dummyt) e, + string ";", + newline], + string "}", + newline, + newline]) periodics), + + string "static uw_periodic my_periodics[] = {", + box (ListUtil.mapi (fn (i, (n, _, _, _)) => + box [string "{uw_periodic", + string (Int.toString i), + string ",", + space, + string (Int64.toString n), + string "},"]) periodics), + string "{NULL}};", + newline, + newline, + string "static const char begin_xhtml[] = \"<?xml version=\\\"1.0\\\" encoding=\\\"utf-8\\\" ?>\\n<!DOCTYPE html PUBLIC \\\"-//W3C//DTD XHTML 1.0 Transitional//EN\\\" \\\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\\\">\\n<html xmlns=\\\"http://www.w3.org/1999/xhtml\\\" xml:lang=\\\"en\\\" lang=\\\"en\\\">\";", newline, newline, @@ -3043,7 +3074,7 @@ "uw_db_init", "uw_db_begin", "uw_db_commit", "uw_db_rollback", "uw_db_close", "uw_handle", "uw_input_num", "uw_cookie_sig", "uw_check_url", "uw_check_mime", - case onError of NONE => "NULL" | SOME _ => "uw_onError"], + case onError of NONE => "NULL" | SOME _ => "uw_onError", "my_periodics"], string "};", newline] end
--- a/src/cjrize.sml Sat Dec 18 14:17:45 2010 -0500 +++ b/src/cjrize.sml Sat Dec 18 15:17:09 2010 -0500 @@ -667,6 +667,7 @@ val tk = case #1 e1 of L.EFfi ("Basis", "initialize") => L'.Initialize | L.EFfi ("Basis", "clientLeaves") => L'.ClientLeaves + | L.EFfiApp ("Basis", "periodic", [(L.EPrim (Prim.Int n), _)]) => L'.Periodic n | _ => (ErrorMsg.errorAt loc "Task kind not fully determined"; L'.Initialize) val (e, sm) = cifyExp (e, sm)