# HG changeset patch # User Adam Chlipala # Date 1287068786 14400 # Node ID d2ad997ca1574cdc25eb8f11c37a8ffdcfdcfb2d # Parent 3a845f2ce9e94b92fbd5be7c1d996cd08cf1bdd6 Interface for setting memory limits diff -r 3a845f2ce9e9 -r d2ad997ca157 src/cgi.sml --- 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]} diff -r 3a845f2ce9e9 -r d2ad997ca157 src/cjr_print.sml --- 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, diff -r 3a845f2ce9e9 -r d2ad997ca157 src/compiler.sml --- 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 () diff -r 3a845f2ce9e9 -r d2ad997ca157 src/fastcgi.sml --- 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]} diff -r 3a845f2ce9e9 -r d2ad997ca157 src/http.sml --- 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]} diff -r 3a845f2ce9e9 -r d2ad997ca157 src/main.mlton.sml --- 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) diff -r 3a845f2ce9e9 -r d2ad997ca157 src/settings.sig --- 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 diff -r 3a845f2ce9e9 -r d2ad997ca157 src/settings.sml --- 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 diff -r 3a845f2ce9e9 -r d2ad997ca157 tests/hog.ur --- /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 {[more n]} diff -r 3a845f2ce9e9 -r d2ad997ca157 tests/hog.urp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/hog.urp Thu Oct 14 11:06:26 2010 -0400 @@ -0,0 +1,1 @@ +hog diff -r 3a845f2ce9e9 -r d2ad997ca157 tests/hog.urs --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/hog.urs Thu Oct 14 11:06:26 2010 -0400 @@ -0,0 +1,1 @@ +val main : int -> transaction page