From 7bf0a0124a6c8a834983a660af53d8789ac0a8ac Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Thu, 14 Oct 2010 11:06:26 -0400 Subject: Interface for setting memory limits --- src/cgi.sml | 3 ++- src/cjr_print.sml | 32 ++++++++++++++++++++++++++------ src/compiler.sml | 11 +++++++++++ src/fastcgi.sml | 2 ++ src/http.sml | 2 ++ src/main.mlton.sml | 9 +++++++++ src/settings.sig | 5 ++++- src/settings.sml | 12 ++++++++++++ 8 files changed, 68 insertions(+), 8 deletions(-) (limited to 'src') diff --git a/src/cgi.sml b/src/cgi.sml index 9099d429..d8c7c3ec 100644 --- a/src/cgi.sml +++ b/src/cgi.sml @@ -36,7 +36,6 @@ val () = addProtocol {name = "cgi", 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 @@ val () = addProtocol {name = "cgi", string sf, string "\";", newline], + string "uw_setup_limits();", + newline, string "}", newline]} diff --git a/src/cjr_print.sml b/src/cjr_print.sml index ae347eb2..29f94fe6 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -2828,6 +2828,26 @@ fun p_file env (ds, ps) = 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 @@ fun p_file env (ds, ps) = 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 --git a/src/compiler.sml b/src/compiler.sml index bf9bfbdf..038fa0ff 100644 --- a/src/compiler.sml +++ b/src/compiler.sml @@ -698,6 +698,17 @@ fun parseUrp' accLibs fname = 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 --git a/src/fastcgi.sml b/src/fastcgi.sml index 31feaee9..5f849856 100644 --- a/src/fastcgi.sml +++ b/src/fastcgi.sml @@ -45,6 +45,8 @@ val () = addProtocol {name = "fastcgi", string sf, string "\";", newline], + string "uw_setup_limits();", + newline, string "}", newline]} diff --git a/src/http.sml b/src/http.sml index a760e195..5859f077 100644 --- a/src/http.sml +++ b/src/http.sml @@ -45,6 +45,8 @@ val () = addProtocol {name = "http", string sf, string "\";", newline], + string "uw_setup_limits();", + newline, string "}", newline]} diff --git a/src/main.mlton.sml b/src/main.mlton.sml index 09b53c58..a434ef12 100644 --- a/src/main.mlton.sml +++ b/src/main.mlton.sml @@ -91,6 +91,15 @@ fun doArgs args = | "-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 --git a/src/settings.sig b/src/settings.sig index 3ebf9300..b72d007b 100644 --- a/src/settings.sig +++ b/src/settings.sig @@ -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 @@ signature SETTINGS = sig 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 --git a/src/settings.sml b/src/settings.sml index 5da1a24e..4512b7d8 100644 --- a/src/settings.sml +++ b/src/settings.sml @@ -490,4 +490,16 @@ val onError = ref (NONE : (string * string list * string) option) 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 -- cgit v1.2.3