[m-rev.] for review: minimal server for view deep profiling data
Peter Wang
wangp at students.csse.unimelb.edu.au
Thu May 24 11:45:47 AEST 2007
Branches: main
extras/posix/samples/Mmakefile:
extras/posix/samples/mdprof_cgid.m:
extras/posix/samples/README:
Add a minimal server program that accepts and passes through requests
to mdprof. It's useful when you want to view deep profiling data
without configuring and running a proper web server.
Index: extras/posix/samples/Mmakefile
===================================================================
RCS file: extras/posix/samples/Mmakefile
diff -N extras/posix/samples/Mmakefile
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ extras/posix/samples/Mmakefile 24 May 2007 01:37:57 -0000
@@ -0,0 +1,20 @@
+POSIX_DIR = ..
+
+DEMOS = mdprof_cgid
+
+depend: $(DEMOS:%=%.depend)
+all: demos
+clean: $(DEMOS:%=%.clean)
+realclean: $(DEMOS:%=%.realclean)
+demos: $(DEMOS)
+
+# The following stuff tells Mmake to use the posix library.
+VPATH = $(POSIX_DIR):$(MMAKE_VPATH)
+MCFLAGS = -I$(POSIX_DIR) $(EXTRA_MCFLAGS)
+MGNUCFLAGS = -I$(POSIX_DIR)
+MLFLAGS = -R$(POSIX_DIR) $(EXTRA_MLFLAGS) \
+ -L$(POSIX_DIR)
+MLLIBS = -lposix $(EXTRA_MLLIBS)
+C2INITARGS = $(POSIX_DIR)/posix.init
+
+MAIN_TARGET = mdprof_cgid
Index: extras/posix/samples/README
===================================================================
RCS file: extras/posix/samples/README
diff -N extras/posix/samples/README
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ extras/posix/samples/README 24 May 2007 01:37:57 -0000
@@ -0,0 +1,42 @@
+mdprof_cgid is a minimal server that accepts and passes through requests to
+the deep profiler CGI program, mdprof_cgi. It's useful when you want to view
+deep profiling data without configuring and running a proper web server.
+
+Building
+--------
+
+After building the posix library in the parent directory,
+
+ mmake depend
+ mmake
+
+
+Starting
+--------
+
+ ./mdprof_cgid --host localhost --port 8081 --mdprof mdprof \
+ --script-name /cgi-bin/mdprof_cgi
+
+The default values for options are shown.
+
+The --mdprof option specifies the location of the `mdprof' executable.
+If it is in the path then the default setting should be fine.
+Since `mdprof' is just a wrapper script around `mdprof_cgi' you can also pass
+the location of `mdprof_cgi' directly instead.
+
+The --script-name option specifies the virtual path under which the deep
+profiler will be accessible. This server ignores all requests except to that
+virtual path.
+
+
+Using
+-----
+
+Once the server is running, point the browser to your deep profiling data,
+e.g.
+
+ firefox http://localhost:8081/cgi-bin/mdprof_cgi?/path/to/Deep.data
+
+Note that running instances of mdprof_cgi won't be automatically killed when
+mdprof_cgid is terminated.
+
Index: extras/posix/samples/mdprof_cgid.m
===================================================================
RCS file: extras/posix/samples/mdprof_cgid.m
diff -N extras/posix/samples/mdprof_cgid.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ extras/posix/samples/mdprof_cgid.m 24 May 2007 01:37:57 -0000
@@ -0,0 +1,359 @@
+%------------------------------------------------------------------------------%
+% Copyright (C) 2007 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Module: mdprof_cgid.
+% Author: wangp.
+%
+% This is a minimal server that accepts and passes through requests to
+% mdprof. It's useful when you want to view deep profiling data without
+% configuring and running a proper web server.
+%
+%-----------------------------------------------------------------------------%
+
+:- module mdprof_cgid.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module char.
+:- import_module getopt.
+:- import_module int.
+:- import_module list.
+:- import_module require.
+:- import_module string.
+
+:- import_module posix.
+:- import_module posix.dup.
+:- import_module posix.read.
+:- import_module posix.open.
+:- import_module posix.select.
+:- import_module posix.socket.
+:- import_module text.
+
+%-----------------------------------------------------------------------------%
+%
+% Command-line options
+%
+
+:- type option
+ ---> server_name
+ ; server_port
+ ; mdprof_path
+ ; script_name.
+
+:- type data
+ ---> data(
+ data_mdprof_path :: string,
+ data_script_name :: string
+ ).
+
+:- pred short_option(char::in, option::out) is semidet.
+:- pred long_option(string::in, option::out) is semidet.
+:- pred option_default(option::out, option_data::out) is multi.
+:- pred option_defaults(option::out, option_data::out) is nondet.
+:- pred show_usage(io::di, io::uo) is det.
+
+short_option('h', server_name).
+short_option('p', server_port).
+short_option('m', mdprof_path).
+short_option('s', script_name).
+
+long_option("host", server_name).
+long_option("name", server_name).
+long_option("port", server_port).
+long_option("mdprof", mdprof_path).
+long_option("script-name", script_name).
+
+option_default(server_name, string("localhost")).
+option_default(server_port, int(8081)).
+option_default(mdprof_path, string("mdprof")).
+option_default(script_name, string("/cgi-bin/mdprof_cgi")).
+
+option_defaults(Option, Default) :-
+ option_default(Option, Default),
+ semidet_true.
+
+show_usage(!IO) :-
+ list.foldl(io.write_string, [
+ "Options:\n",
+ " -h, --host HOSTNAME (default: localhost)\n",
+ " -p, --port PORT (default: 8081)\n",
+ " -m, --mdprof PATH (default: mdprof)\n",
+ " -s, --script-name NAME (default: /cgi-bin/mdprof_cgi)\n",
+ "\n"
+ ], !IO).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+ io.command_line_arguments(Args0, !IO),
+ OptionOpts = option_ops(short_option, long_option, option_defaults),
+ getopt.process_options(OptionOpts, Args0, _Args, OptionsResults),
+ (
+ OptionsResults = ok(OptTable),
+ main_2(OptTable, !IO)
+ ;
+ OptionsResults = error(OptionErrorString),
+ io.write_string(OptionErrorString, !IO),
+ io.nl(!IO),
+ show_usage(!IO),
+ io.set_exit_status(1, !IO)
+ ).
+
+:- pred main_2(option_table(option)::in, io::di, io::uo) is det.
+
+main_2(OptTable, !IO) :-
+ %
+ % Handle command-line options.
+ %
+ getopt.lookup_string_option(OptTable, server_name, ServerName),
+ getopt.lookup_int_option(OptTable, server_port, ServerPort),
+ getopt.lookup_string_option(OptTable, script_name, ScriptName0),
+ ( if string.prefix(ScriptName0, "/") then
+ ScriptName = ScriptName0
+ else
+ ScriptName = "/" ++ ScriptName0
+ ),
+ getopt.lookup_string_option(OptTable, mdprof_path, MdprofPath),
+ %
+ % Set CGI environment variables.
+ %
+ io.set_environment_var("SERVER_NAME", ServerName, !IO),
+ io.set_environment_var("SERVER_PORT", from_int(ServerPort), !IO),
+ io.set_environment_var("SCRIPT_NAME", ScriptName, !IO),
+ %
+ % Listen for requests.
+ %
+ create_listen_conn(ServerPort, ListenFd, !IO),
+ io.format("%s started on %s:%d\n",
+ [s(prog_name), s(ServerName), i(ServerPort)], !IO),
+ Data = data(MdprofPath, ScriptName),
+ main_loop(Data, ListenFd, !IO).
+
+:- pred create_listen_conn(int::in, fd::out, io::di, io::uo) is det.
+
+create_listen_conn(ServerPort, Fd, !IO) :-
+ socket(inet, stream, protocol(0), SocketResult, !IO),
+ (
+ SocketResult = ok(Fd)
+ ;
+ SocketResult = error(SocketError),
+ abort_with_error("socket failed", SocketError)
+ ),
+ bind(Fd, inet(port(ServerPort), inet_addr(0)), BindResult, !IO),
+ (
+ BindResult = ok
+ ;
+ BindResult = error(_BindError),
+ abort("bind failed (perhaps port " ++ string(ServerPort) ++
+ " is already in use?)")
+ ),
+ listen(Fd, 1, ListenResult, !IO),
+ (
+ ListenResult = ok
+ ;
+ ListenResult = error(ListenError),
+ abort_with_error("listen failed", ListenError)
+ ).
+
+:- pred main_loop(data::in, fd::in, io::di, io::uo) is det.
+
+main_loop(Data, ListenFd, !IO) :-
+ await_conn(ListenFd, ConnFd, !IO),
+ handle_conn(Data, ConnFd, !IO),
+ main_loop(Data, ListenFd, !IO).
+
+:- pred await_conn(fd::in, fd::out, io::di, io::uo) is det.
+
+await_conn(ListenFd, ConnFd, !IO) :-
+ wait_input_fd(ListenFd, SelectResult, !IO),
+ (
+ SelectResult = ok(_)
+ ;
+ SelectResult = error(SelectError),
+ abort_with_error("wait_input_fd failed", SelectError)
+ ),
+ accept(ListenFd, AcceptResult, !IO),
+ (
+ AcceptResult = ok(ConnFd)
+ ;
+ AcceptResult = error(AcceptError),
+ abort_with_error("accept failed", AcceptError)
+ ).
+
+:- pred wait_input_fd(fd::in, posix.result(int)::out, io::di, io::uo) is det.
+
+wait_input_fd(Fd @ fd(MaxFd), Result, !IO) :-
+ new_fdset_ptr(Rd, !IO),
+ new_fdset_ptr(Wr, !IO),
+ new_fdset_ptr(Ex, !IO),
+ fd_set(Fd, Rd, !IO),
+ LongTime = timeval(9999, 0),
+ select(MaxFd+1, Rd, Wr, Ex, LongTime, Result, !IO).
+
+:- pred handle_conn(data::in, fd::in, io::di, io::uo) is det.
+
+handle_conn(Data, ConnFd, !IO) :-
+ TextSize = 1024,
+ text.create(TextSize, 0, Text0),
+ read(ConnFd, TextSize, ReadResult, Text0, Text, !IO),
+ (
+ ReadResult = ok(Length),
+ Request = first_line(Text, Length),
+ with_stdout(ConnFd, handle_request(Data, Request), !IO)
+ ;
+ ReadResult = error(_),
+ io.print("read failed\n", !IO)
+ ),
+ close(ConnFd, _, !IO).
+
+ % with_stdout(OtherFd, P, !IO)
+ % Call P, with OtherFd substituted for standard output during
+ % the execution of P.
+ %
+:- pred with_stdout(fd::in, pred(io, io)::in(pred(di, uo) is det),
+ io::di, io::uo) is det.
+
+with_stdout(OtherFd, P, !IO) :-
+ Stdout = fd(1),
+ dup(Stdout, StdoutCopy, !IO),
+ dup2(OtherFd, Stdout, _, !IO),
+ P(!IO),
+ close(Stdout, _, !IO),
+ (
+ StdoutCopy = ok(Stdout1),
+ dup2(Stdout1, Stdout, _, !IO)
+ ;
+ StdoutCopy = error(_)
+ ).
+
+:- pred handle_request(data::in, string::in, io::di, io::uo) is det.
+
+handle_request(Data, Request, !IO) :-
+ (if string.words(Request) = [Method, Path, HttpProt] then
+ (if http_protocol(HttpProt) then
+ (if string.to_upper(Method) = "GET" then
+ (if string.prefix(Path, Data ^ data_script_name) then
+ handle_request_2(Data, Path, !IO)
+ else
+ write_http_response("404", "Not found", !IO)
+ )
+ else
+ write_http_response("501", "Not implemented", !IO)
+ )
+ else
+ write_http_response("505", "HTTP Version Not Supported", !IO)
+ )
+ else
+ write_http_response("400", "Bad request", !IO)
+ ).
+
+:- pred handle_request_2(data::in, string::in, io::di, io::uo) is det.
+
+handle_request_2(Data, Path, !IO) :-
+ %
+ % Set up the QUERY_STRING CGI environment variable.
+ %
+ (if string.sub_string_search(Path, "?", QuesIndex) then
+ Length = string.length(Path),
+ QueryString = string.substring(Path, QuesIndex + 1, Length)
+ else
+ QueryString = ""
+ ),
+ io.set_environment_var("QUERY_STRING", QueryString, !IO),
+ %
+ % Write the HTTP header and call the mdprof program to generate
+ % the rest of the output.
+ %
+ io.write_string("HTTP/1.0 200 OK\r\n", !IO),
+ MdprofPath = Data ^ data_mdprof_path,
+ io.call_system(MdprofPath, CgiResult, !IO),
+ (
+ CgiResult = ok(_)
+ ;
+ CgiResult = error(Error),
+ io.error_message(Error, ErrorMsg),
+ abort("call_system failed: " ++ ErrorMsg)
+ ).
+
+:- pred http_protocol(string::in) is semidet.
+
+http_protocol("HTTP/1.0").
+http_protocol("HTTP/1.1").
+
+:- pred write_http_response(string::in, string::in, io::di, io::uo)
+ is det.
+
+write_http_response(StatusCode, Message, !IO) :-
+ list.foldl(io.write_string, [
+ "HTTP/1.0 ", StatusCode, " OK\r\n",
+ "Content-Type: text/html\r\n\r\n",
+ "<html><body><p>", Message, "</p></body></html>\n"
+ ], !IO).
+
+%-----------------------------------------------------------------------------%
+
+ % first_line(Text, TextLen) = String
+ % Return the first line from the Text object as a string,
+ % i.e. everything up to the first CR or NL character.
+ %
+:- func first_line(text, int) = string.
+
+first_line(Text, TextLen) =
+ string.from_char_list(first_line_2(Text, 0, TextLen)).
+
+:- func first_line_2(text, int, int) = list(char).
+
+first_line_2(Text, Index, TextLen) = RevChars :-
+ ( if Index >= TextLen then
+ RevChars = []
+ else
+ Char = text_char(Text, Index),
+ ( if is_newline(Char) then
+ RevChars = []
+ else
+ RevChars = [Char | first_line_2(Text, Index + 1, TextLen)]
+ )
+ ).
+
+:- func text_char(text, int) = char.
+
+text_char(Text, Index) = char.det_from_int(Int) :-
+ text.index(Text, Index, Int).
+
+:- pred is_newline(char::in) is semidet.
+
+is_newline('\n').
+is_newline('\r').
+
+%-----------------------------------------------------------------------------%
+
+:- pred abort(string::in) is erroneous.
+
+abort(Msg) :-
+ error(prog_name ++ ": " ++ Msg).
+
+:- pred abort_with_error(string::in, posix.error::in) is erroneous.
+
+abort_with_error(Msg, Error) :-
+ Str = string.format("%s: %s %s",
+ [s(prog_name), s(Msg), s(string(Error))]),
+ error(Str).
+
+:- func prog_name = string.
+
+prog_name = "mdprof_cgid".
+
+%-----------------------------------------------------------------------------%
+% vi:ft=mercury:ts=8:sts=4:sw=4:et
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list