Mercurial > urweb
changeset 1307:d2ad997ca157
Interface for setting memory limits
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Thu, 14 Oct 2010 11:06:26 -0400 |
| parents | 3a845f2ce9e9 |
| children | 714e8b84221b |
| files | src/cgi.sml src/cjr_print.sml src/compiler.sml src/fastcgi.sml src/http.sml src/main.mlton.sml src/settings.sig src/settings.sml tests/hog.ur tests/hog.urp tests/hog.urs |
| diffstat | 11 files changed, 77 insertions(+), 8 deletions(-) [+] |
line wrap: on
line diff
--- a/src/cgi.sml Sun Oct 10 20:33:10 2010 -0400 +++ b/src/cgi.sml Thu Oct 14 11:06:26 2010 -0400 @@ -36,7 +36,6 @@ linkDynamic = "-lurweb_cgi", persistent = false, code = fn () => box [string "void uw_global_custom() {", - newline, case getSigFile () of NONE => box [] | SOME sf => box [string "extern char *uw_sig_file;", @@ -45,6 +44,8 @@ string sf, string "\";", newline], + string "uw_setup_limits();", + newline, string "}", newline]}
--- a/src/cjr_print.sml Sun Oct 10 20:33:10 2010 -0400 +++ b/src/cjr_print.sml Thu Oct 14 11:06:26 2010 -0400 @@ -2828,6 +2828,26 @@ newline, newline, + box [string "static void uw_setup_limits() {", + newline, + box [p_list_sep (box []) (fn (class, num) => + let + val num = case class of + "page" => Int.max (2048, num) + | _ => num + in + box [string ("uw_" ^ class ^ "_max"), + space, + string "=", + space, + string (Int.toString num), + string ";", + newline] + end) (Settings.limits ())], + string "}", + newline, + newline], + #code (Settings.currentProtocol ()) (), if hasDb then @@ -2837,17 +2857,17 @@ views = !views, sequences = !sequences} else - box [string "void uw_client_init(void) { };", + box [string "static void uw_client_init(void) { };", newline, - string "void uw_db_init(uw_context ctx) { };", + string "static void uw_db_init(uw_context ctx) { };", newline, - string "int uw_db_begin(uw_context ctx) { return 0; };", + string "static int uw_db_begin(uw_context ctx) { return 0; };", newline, - string "void uw_db_close(uw_context ctx) { };", + string "static void uw_db_close(uw_context ctx) { };", newline, - string "int uw_db_commit(uw_context ctx) { return 0; };", + string "static int uw_db_commit(uw_context ctx) { return 0; };", newline, - string "int uw_db_rollback(uw_context ctx) { return 0; };"], + string "static int uw_db_rollback(uw_context ctx) { return 0; };"], newline, newline,
--- a/src/compiler.sml Sun Oct 10 20:33:10 2010 -0400 +++ b/src/compiler.sml Thu Oct 14 11:06:26 2010 -0400 @@ -698,6 +698,17 @@ m1 :: (fs as _ :: _) => onError := SOME (m1, List.take (fs, length fs - 1), List.last fs) | _ => ErrorMsg.error "invalid 'onError' argument") + | "limit" => + (case String.fields Char.isSpace arg of + [class, num] => + (case Int.fromString num of + NONE => ErrorMsg.error ("invalid limit number '" ^ num ^ "'") + | SOME n => + if n < 0 then + ErrorMsg.error ("invalid limit number '" ^ num ^ "'") + else + Settings.addLimit (class, n)) + | _ => ErrorMsg.error "invalid 'limit' arguments") | _ => ErrorMsg.error ("Unrecognized command '" ^ cmd ^ "'"); read ()
--- a/src/fastcgi.sml Sun Oct 10 20:33:10 2010 -0400 +++ b/src/fastcgi.sml Thu Oct 14 11:06:26 2010 -0400 @@ -45,6 +45,8 @@ string sf, string "\";", newline], + string "uw_setup_limits();", + newline, string "}", newline]}
--- a/src/http.sml Sun Oct 10 20:33:10 2010 -0400 +++ b/src/http.sml Thu Oct 14 11:06:26 2010 -0400 @@ -45,6 +45,8 @@ string sf, string "\";", newline], + string "uw_setup_limits();", + newline, string "}", newline]}
--- a/src/main.mlton.sml Sun Oct 10 20:33:10 2010 -0400 +++ b/src/main.mlton.sml Thu Oct 14 11:06:26 2010 -0400 @@ -91,6 +91,15 @@ | "-noEmacs" :: rest => (Demo.noEmacs := true; doArgs rest) + | "-limit" :: class :: num :: rest => + (case Int.fromString num of + NONE => raise Fail ("Invalid limit number '" ^ num ^ "'") + | SOME n => + if n < 0 then + raise Fail ("Invalid limit number '" ^ num ^ "'") + else + Settings.addLimit (class, n); + doArgs rest) | arg :: rest => (if size arg > 0 andalso String.sub (arg, 0) = #"-" then raise Fail ("Unknown flag " ^ arg)
--- a/src/settings.sig Sun Oct 10 20:33:10 2010 -0400 +++ b/src/settings.sig Thu Oct 14 11:06:26 2010 -0400 @@ -1,4 +1,4 @@ -(* Copyright (c) 2008-2009, Adam Chlipala +(* Copyright (c) 2008-2010, Adam Chlipala * All rights reserved. * * Redistribution and use in source and binary forms, with or without @@ -208,4 +208,7 @@ val setOnError : (string * string list * string) option -> unit val getOnError : unit -> (string * string list * string) option + + val addLimit : string * int -> unit + val limits : unit -> (string * int) list end
--- a/src/settings.sml Sun Oct 10 20:33:10 2010 -0400 +++ b/src/settings.sml Thu Oct 14 11:06:26 2010 -0400 @@ -490,4 +490,16 @@ fun setOnError x = onError := x fun getOnError () = !onError +val limits = ["messages", "clients", "headers", "page", "heap", "script", + "inputs", "subinputs", "cleanup", "deltas", "transactionals", + "globals", "database"] + +val limitsList = ref ([] : (string * int) list) +fun addLimit (v as (name, _)) = + if List.exists (fn name' => name' = name) limits then + limitsList := v :: !limitsList + else + raise Fail ("Unknown limit category '" ^ name ^ "'") +fun limits () = !limitsList + end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/hog.ur Thu Oct 14 11:06:26 2010 -0400 @@ -0,0 +1,7 @@ +fun more n = + if n <= 0 then + "!" + else + more (n-1) ^ more (n-1) + +fun main n = return <xml>{[more n]}</xml>