%---------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %---------------------------------------------------------------------------% % Copyright (C) 2001-2012 The University of Melbourne. % Copyright (C) 2013, 2015, 2017, 2020-2023 The Mercury team. % This file may only be copied under the terms of the GNU General % Public License - see the file COPYING in the Mercury distribution. %---------------------------------------------------------------------------% % % File: mdprof_cgi.m. % Author of initial version: conway. % Author of this version: zs. % % This file contains the CGI "script" that is executed by the web server % to handle web page requests implemented by the Mercury deep profiler server. % %---------------------------------------------------------------------------% :- module mdprof_cgi. :- interface. :- import_module io. %---------------------------------------------------------------------------% :- pred main(io::di, io::uo) is cc_multi. %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% :- implementation. :- import_module conf. :- import_module interface. :- import_module profile. :- import_module query. :- import_module startup. :- import_module timeout. :- import_module bool. :- import_module char. :- import_module getopt. :- import_module int. :- import_module io.call_system. :- import_module io.environment. :- import_module io.file. :- import_module library. :- import_module list. :- import_module map. :- import_module maybe. :- import_module require. :- import_module string. %---------------------------------------------------------------------------% % The web server should always set QUERY_STRING. It may also pass its contents % as arguments, but if any characters special to the shell occur in the query, % they will screw up the argument list. We therefore look at the argument list % only if QUERY_STRING isn't set, which means that the program was invoked % from the command line for debugging. main(!IO) :- io.stdin_stream(StdIn, !IO), io.stdout_stream(StdOut, !IO), write_html_header(StdOut, !IO), io.environment.get_environment_var("QUERY_STRING", MaybeQueryString, !IO), ( MaybeQueryString = yes(QueryString0), OptionOps = option_ops_multi(short, long, defaults), getopt.process_options(OptionOps, [], _, MaybeOptions), ( MaybeOptions = ok(Options) ; MaybeOptions = error(_Msg), error("mdprof_cgi: error parsing empty command line") ), string_to_maybe_query(QueryString0) = MaybeDeepQuery, ( MaybeDeepQuery = yes(DeepQuery), DeepQuery = deep_query(MaybeCmd, DeepFileName, MaybePrefs), ( MaybeCmd = yes(Cmd) ; MaybeCmd = no, Cmd = default_command ), process_query(StdOut, Cmd, DeepFileName, MaybePrefs, Options, !IO) ; MaybeDeepQuery = no, io.set_exit_status(1, !IO), % Give the simplest URL in the error message. io.write_string(StdOut, "Bad URL; expected filename\n", !IO) ) ; MaybeQueryString = no, process_command_line(StdIn, StdOut, !IO) ). :- pred process_command_line(io.text_input_stream::in, io.text_output_stream::in, io::di, io::uo) is cc_multi. process_command_line(InputStream, OutputStream, !IO) :- io.progname_base(mdprof_cgi_progname, ProgName, !IO), io.command_line_arguments(Args0, !IO), trace [compiletime(flag("debug-args")), io(!DIO)] ( BracketedArgs0 = list.map(bracket_string, Args0), io.format(OutputStream, "command line: %s\n", [s(string.join_list(" ", BracketedArgs0))], !DIO) ), getopt.process_options(option_ops_multi(short, long, defaults), Args0, Args, MaybeOptions), ( MaybeOptions = ok(Options), lookup_bool_option(Options, help, Help), lookup_bool_option(Options, version, Version), lookup_bool_option(Options, decode, Decode), lookup_bool_option(Options, decode_cmd, DecodeCmd), lookup_bool_option(Options, decode_prefs, DecodePrefs), ( Help = yes, write_help_message(OutputStream, ProgName, !IO) ; Help = no ), ( Version = yes, write_version_message(OutputStream, ProgName, !IO) ; Version = no ), ( if Decode = no, DecodeCmd = no, DecodePrefs = no then true else decode_input_lines(InputStream, OutputStream, Decode, DecodeCmd, DecodePrefs, !IO) ), ( if Help = no, Version = no, Decode = no, DecodeCmd = no, DecodePrefs = no then process_args(OutputStream, ProgName, Args, Options, !IO) else true ) ; MaybeOptions = error(Error), Msg = option_error_to_string(Error), io.set_exit_status(1, !IO), io.format(OutputStream, "%s: error parsing options: %s\n", [s(ProgName), s(Msg)], !IO) ). :- pred decode_input_lines(io.text_input_stream::in, io.text_output_stream::in, bool::in, bool::in, bool::in, io::di, io::uo) is det. decode_input_lines(InputStream, OutputStream, Decode, DecodeCmd, DecodePrefs, !IO) :- io.read_line_as_string(InputStream, LineResult, !IO), ( LineResult = ok(LineStr), ( Decode = no ; Decode = yes, io.write_string(OutputStream, "considering as query string:\n", !IO), string_to_maybe_query(LineStr) = MaybeQuery, ( MaybeQuery = yes(deep_query(MaybeCmd, DeepFileName, MaybePrefs)), io.write_string(OutputStream, "Maybe Command:\n", !IO), io.write_line(OutputStream, MaybeCmd, !IO), io.format(OutputStream, "Deep File Name: %s\n", [s(DeepFileName)], !IO), % The preferences may fail to parse, in this case no % preferences are assumed. io.write_string(OutputStream, "Maybe Preferences:\n", !IO), io.write_line(OutputStream, MaybePrefs, !IO) ; MaybeQuery = no, io.write_string(OutputStream, "invalid query string: cannot split into components\n", !IO) ) ), ( DecodeCmd = no ; DecodeCmd = yes, io.write_string(OutputStream, "considering as cmd string:\n", !IO), MaybeCmd1 = string_to_maybe_cmd(LineStr), ( MaybeCmd1 = no, io.format(OutputStream, "invalid command string %s\n", [s(LineStr)], !IO) ; MaybeCmd1 = yes(Cmd), io.write_line(OutputStream, Cmd, !IO) ) ), ( DecodePrefs = no ; DecodePrefs = yes, io.write_string(OutputStream, "considering as preference string:\n", !IO), MaybePref = string_to_maybe_pref(LineStr), ( MaybePref = no, io.format(OutputStream, "invalid preferences string %s\n", [s(LineStr)], !IO) ; MaybePref = yes(Pref), io.write_line(OutputStream, Pref, !IO) ) ), decode_input_lines(InputStream, OutputStream, Decode, DecodeCmd, DecodePrefs, !IO) ; LineResult = error(Error), io.error_message(Error, Msg), io.format(OutputStream, "%s\n", [s(Msg)], !IO) ; LineResult = eof ). :- func mdprof_cgi_progname = string. mdprof_cgi_progname = "mdprof_cgi". :- pred write_version_message(io.text_output_stream::in, string::in, io::di, io::uo) is det. write_version_message(OutputStream, ProgName, !IO) :- library.version(Version, Fullarch), io.format(OutputStream, "%s: Mercury deep profiler\n", [s(ProgName)], !IO), io.format(OutputStream, "version: %s, on %s.\n", [s(Version), s(Fullarch)], !IO). :- pred write_help_message(io.text_output_stream::in, string::in, io::di, io::uo) is det. write_help_message(OutputStream, ProgName, !IO) :- % The options are deliberately not documented; they can change % quite rapidly, based on the debugging needs of the moment. % The optional filename argument is also for implementors only. io.format(OutputStream, "Usage: %s\n", [s(ProgName)], !IO), io.write_strings(OutputStream, ["This program doesn't expect any arguments;\n", "instead it decides what to do based on the\n", "QUERY_STRING environment variable.\n"], !IO). %---------------------------------------------------------------------------% :- pred process_args(io.text_output_stream::in, string::in, list(string)::in, option_table::in, io::di, io::uo) is cc_multi. process_args(OutputStream, ProgName, Args, Options, !IO) :- ( if Args = [DeepFileName] then % Although this mode of usage is not intended for production use, % allowing the filename and a limited range of commands to be supplied % on the command line makes debugging very much easier. process_query(OutputStream, default_cmd(Options), DeepFileName, no, Options, !IO) else io.set_exit_status(1, !IO), write_help_message(OutputStream, ProgName, !IO), trace [compiletime(flag("debug-args")), io(!DIO)] ( BracketedArgs = list.map(bracket_string, Args), io.format(OutputStream, "processed args: %s\n", [s(string.join_list(" ", BracketedArgs))], !DIO) ) ). % This predicate is for debugging the command line given to mdprof_cgi by the % web server, should that be necessary. :- func bracket_string(string) = string. bracket_string(S) = "<" ++ S ++ ">". :- pred write_html_header(io.text_output_stream::in, io::di, io::uo) is det. write_html_header(OutputStream, !IO) :- io.write_string(OutputStream, html_header_text, !IO), io.flush_output(OutputStream, !IO). :- func html_header_text = string. html_header_text = "Content-type: text/html\n\n". %---------------------------------------------------------------------------% :- pred process_query(io.text_output_stream::in, cmd::in, string::in, maybe(preferences)::in, option_table::in, io::di, io::uo) is cc_multi. process_query(OutputStream, Cmd0, DeepFileName0, MaybePref, Options0, !IO) :- ( if Cmd0 = deep_cmd_restart then % This process got started because there was no server, and this % process will become the new server, so the user just got the freshly % started server they asked for. There is no point in starting it % again. As it is, create_report would throw an exception for % deep_cmd_restart, expecting it to be filtered out by its usual caller % server_loop. To avoid the exception, we have to filter it out too. Cmd = deep_cmd_menu else Cmd = Cmd0 ), ( MaybePref = yes(Pref), PrefInd = given_pref(Pref) ; MaybePref = no, PrefInd = default_pref ), ( if string.remove_suffix(DeepFileName0, ".localhost", DeepFileNamePrime) then DeepFileName = DeepFileNamePrime, map.det_update(localhost, bool(yes), Options0, Options) else DeepFileName = DeepFileName0, Options = Options0 ), ( if string.remove_suffix(DeepFileName, ".data", _BaseFileName) then ToServerPipe = to_server_pipe_name(DeepFileName), FromServerPipe = from_server_pipe_name(DeepFileName), StartupFile = server_startup_name(DeepFileName), MutexFile = mutex_file_name(DeepFileName), lookup_bool_option(Options, debug, Debug), WantFile = want_file_name, make_want_file(WantFile, !IO), get_lock(Debug, MutexFile, !IO), ( Debug = yes % Do not set up any cleanups; leave all files around, % since they may be needed for postmortem examination. ; Debug = no, setup_signals(MutexFile, want_dir, want_prefix, !IO) ), check_for_existing_fifos(ToServerPipe, FromServerPipe, FifoCount, !IO), ( if FifoCount = 0 then handle_query_from_new_server(OutputStream, Cmd, PrefInd, DeepFileName, ToServerPipe, FromServerPipe, StartupFile, MutexFile, WantFile, Options, !IO) else if FifoCount = 2 then handle_query_from_existing_server(Cmd, PrefInd, ToServerPipe, FromServerPipe, MutexFile, WantFile, Options, !IO) else release_lock(Debug, MutexFile, !IO), remove_want_file(WantFile, !IO), io.set_exit_status(1, !IO), io.write_string(OutputStream, "mdprof internal error: bad fifo count\n", !IO) ) else io.set_exit_status(1, !IO), io.format(OutputStream, "

Invalid file name %s.

\n\n", [s(DeepFileName)], !IO), io.write_string(OutputStream, "Deep profiling data files must have a .data suffix, " ++ "to allow the deep profiler to locate any related files.\n", !IO) ). % This type is used to pass queries between the two servers. % :- type cmd_pref ---> cmd_pref(cmd, preferences_indication). % Handle the given query using the existing server. Delete the mutex and % want files when we get out of the critical region. % :- pred handle_query_from_existing_server(cmd::in, preferences_indication::in, string::in, string::in, string::in, string::in, option_table::in, io::di, io::uo) is det. handle_query_from_existing_server(Cmd, PrefInd, ToServerPipe, FromServerPipe, MutexFile, WantFile, Options, !IO) :- lookup_bool_option(Options, debug, Debug), trace [compiletime(flag("debug_client_server")), io(!S)] ( io.open_append("/tmp/deep_debug", Res1, !S), ( Res1 = ok(DebugStream1), io.write_string(DebugStream1, "sending query to existing server.\n", !S), io.write(DebugStream1, cmd_pref(Cmd, PrefInd), !S), io.close_output(DebugStream1, !S) ; Res1 = error(_) ) ), send_term(ToServerPipe, Debug, cmd_pref(Cmd, PrefInd), !IO), release_lock(Debug, MutexFile, !IO), remove_want_file(WantFile, !IO), recv_string(FromServerPipe, Debug, ResponseFileName, !IO), CatCmd = string.format("cat %s", [s(ResponseFileName)]), io.call_system.call_system(CatCmd, _, !IO), trace [compiletime(flag("debug_client_server")), io(!T)] ( io.open_append("/tmp/deep_debug", Res2, !T), ( Res2 = ok(DebugStream2), io.write_string(DebugStream2, "sending reply from existing server.\n", !T), io.close_output(DebugStream2, !T), DebugCatCmd = string.format("cat %s >> /tmp/deep_debug", [s(ResponseFileName)]), io.call_system.call_system(DebugCatCmd, _, !T) ; Res2 = error(_) ) ), ( Debug = yes % Leave the response file to be examined. ; Debug = no, io.file.remove_file(ResponseFileName, _, !IO) ). % Handle the given query and then become the new server. Delete the mutex % and want files when we get out of the critical region. % :- pred handle_query_from_new_server(io.text_output_stream::in, cmd::in, preferences_indication::in, string::in, string::in, string::in, string::in, string::in, string::in, option_table::in, io::di, io::uo) is cc_multi. handle_query_from_new_server(OutputStream, Cmd, PrefInd, FileName, ToServerPipe, FromServerPipe, StartupFile, MutexFile, WantFile, Options, !IO) :- lookup_bool_option(Options, localhost, LocalHost), ( LocalHost = no, server_name_port(Machine, !IO) ; LocalHost = yes, Machine = "localhost" ), script_name(ScriptName, !IO), lookup_bool_option(Options, canonical_clique, Canonical), lookup_bool_option(Options, server_process, ServerProcess), lookup_bool_option(Options, debug, Debug), lookup_bool_option(Options, record_startup, RecordStartup), ( RecordStartup = yes, io.open_output(StartupFile, StartupStreamRes, !IO), ( StartupStreamRes = ok(StartupStream0), MaybeStartupStream = yes(StartupStream0), register_file_for_cleanup(StartupFile, !IO) ; StartupStreamRes = error(_), error("cannot create startup file") ) ; RecordStartup = no, MaybeStartupStream = no ), read_and_startup_default_deep_options(Machine, ScriptName, FileName, Canonical, MaybeStartupStream, [], StartupResult, !IO), ( StartupResult = ok(Deep), Pref = solidify_preference(Deep, PrefInd), try_exec(Cmd, Pref, Deep, HTML), ( MaybeStartupStream = yes(StartupStream1), io.format(StartupStream1, "query 0 output:\n%s\n", [s(HTML)], !IO), % If we don't flush the output before the fork, it will be flushed % twice, once by the parent process and once by the child process. io.flush_output(StartupStream1, !IO) ; MaybeStartupStream = no ), ( ServerProcess = no, % --no-server-process should be specified only during debugging. release_lock(Debug, MutexFile, !IO), remove_want_file(WantFile, !IO), io.write_string(OutputStream, HTML, !IO) ; ServerProcess = yes, make_pipes(FileName, Success, !IO), ( Success = yes, io.write_string(OutputStream, HTML, !IO), io.flush_output(OutputStream, !IO), start_server(Options, ToServerPipe, FromServerPipe, MaybeStartupStream, MutexFile, WantFile, Deep, !IO) ; Success = no, release_lock(Debug, MutexFile, !IO), remove_want_file(WantFile, !IO), io.set_exit_status(1, !IO), io.write_string(OutputStream, "could not make pipes\n", !IO) ) ) ; StartupResult = error(Error), release_lock(Debug, MutexFile, !IO), remove_want_file(WantFile, !IO), io.set_exit_status(1, !IO), io.format(OutputStream, "%s\n", [s(Error)], !IO) ). % Become the new server. Delete the mutex and want files when we get out % of the critical region. % :- pred start_server(option_table::in, string::in, string::in, maybe(io.text_output_stream)::in, string::in, string::in, deep::in, io::di, io::uo) is cc_multi. start_server(Options, ToServerPipe, FromServerPipe, MaybeStartupStream, MutexFile, WantFile, Deep, !IO) :- lookup_bool_option(Options, detach_process, DetachProcess), lookup_bool_option(Options, record_loop, RecordLoop), lookup_bool_option(Options, debug, Debug), ( DetachProcess = no, % We behave as if we were in the child, to allow the server % loop to be debugged. DetachRes = in_child(child_has_no_parent) ; DetachProcess = yes, detach_process(DetachRes, !IO) ), ( DetachRes = in_child(ChildHasParent), % We are in the child; start serving queries. ( ChildHasParent = child_has_parent, % Our parent process will perform the file removals needed to exit % the critical section; we don't want to duplicate them. We also % don't want to delete the pipes we need or the startup file. unregister_file_for_cleanup(MutexFile, !IO), unregister_file_for_cleanup(WantFile, !IO), % We need to close stdout and stderr to let the web server % know that there will be no further outputs on those streams. % We also close stdin, since that may also be a named pipe. % % The binary streams are clones of the text streams, and we must % close them too to let the web server finish displaying the page. io.stdin_stream(StdIn, !IO), io.close_input(StdIn, !IO), io.stdout_stream(StdOut, !IO), io.close_output(StdOut, !IO), io.stderr_stream(StdErr, !IO), io.close_output(StdErr, !IO), io.binary_input_stream(BinaryStdIn, !IO), io.close_binary_input(BinaryStdIn, !IO), io.binary_output_stream(BinaryStdOut, !IO), io.close_binary_output(BinaryStdOut, !IO) ; ChildHasParent = child_has_no_parent, % We don't actually have a parent process, so we need to perform % the file removals needed to exit the critical section ourselves. release_lock(Debug, MutexFile, !IO), remove_want_file(WantFile, !IO) ), ( RecordLoop = yes, MaybeDebugStream = MaybeStartupStream ; RecordLoop = no, MaybeDebugStream = no ), lookup_int_option(Options, timeout, TimeOut), lookup_bool_option(Options, canonical_clique, Canonical), server_loop(ToServerPipe, FromServerPipe, TimeOut, MaybeDebugStream, Debug, Canonical, 0, Deep, !IO) ; DetachRes = in_parent, % We are in the parent after we spawned the child. We cause the process % to exit simply by not calling server_loop. % % We leave the pipes and the startup file; we clean up only the files % involved in the critical section. release_lock(Debug, MutexFile, !IO), remove_want_file(WantFile, !IO) ; DetachRes = fork_failed, % We are in the parent because the fork failed. Again we cause % the process to exit simply by not calling server_loop, but we also % report the failure through the exit status. We don't report it % via the generated web page, since the cause could be transitory % and may not recur. % % This deletes all the files created by the process, including % WantFile and MutexFile, with MutexFile being deleted last. delete_cleanup_files(!IO), io.set_exit_status(1, !IO) ). :- pred server_loop(string::in, string::in, int::in, maybe(io.text_output_stream)::in, bool::in, bool::in, int::in, deep::in, io::di, io::uo) is cc_multi. server_loop(ToServerPipe, FromServerPipe, TimeOut0, MaybeStartupStream, Debug, Canonical, QueryNum0, Deep0, !IO) :- setup_timeout(TimeOut0, !IO), QueryNum = QueryNum0 + 1, recv_term(ToServerPipe, Debug, CmdPref0, !IO), ( MaybeStartupStream = yes(StartupStream0), io.format(StartupStream0, "server loop query %d\n", [i(QueryNum)], !IO), io.write(StartupStream0, CmdPref0, !IO), io.nl(StartupStream0, !IO), io.flush_output(StartupStream0, !IO) ; MaybeStartupStream = no ), CmdPref0 = cmd_pref(Cmd0, PrefInd0), ( if Cmd0 = deep_cmd_restart then read_and_startup_default_deep_options(Deep0 ^ server_name_port, Deep0 ^ script_name, Deep0 ^ data_file_name, Canonical, MaybeStartupStream, [], MaybeDeep, !IO), ( MaybeDeep = ok(Deep), MaybeMsg = no, Cmd = deep_cmd_menu ; MaybeDeep = error(ErrorMsg), MaybeMsg = yes(ErrorMsg), Deep = Deep0, Cmd = deep_cmd_quit ) else Deep = Deep0, MaybeMsg = no, Cmd = Cmd0 ), Pref0 = solidify_preference(Deep, PrefInd0), ( MaybeMsg = yes(HTML) ; MaybeMsg = no, try_exec(Cmd, Pref0, Deep, HTML) ), ResponseFileName = response_file_name(Deep0 ^ data_file_name, QueryNum), io.open_output(ResponseFileName, ResponseRes, !IO), ( ResponseRes = ok(ResponseStream) ; ResponseRes = error(_), error("cannot open response file") ), io.write_string(ResponseStream, HTML, !IO), io.close_output(ResponseStream, !IO), send_string(FromServerPipe, Debug, ResponseFileName, !IO), ( MaybeStartupStream = yes(StartupStream1), io.format(StartupStream1, "query %d output:\n%s\n", [i(QueryNum), s(HTML)], !IO), io.flush_output(StartupStream1, !IO) ; MaybeStartupStream = no ), ( if Cmd = deep_cmd_quit then % The lack of a recursive call here shuts down the server. % % This deletes all the files created by the process, including % WantFile and MutexFile, with MutexFile being deleted last. delete_cleanup_files(!IO) else if Cmd = deep_cmd_timeout(TimeOut) then server_loop(ToServerPipe, FromServerPipe, TimeOut, MaybeStartupStream, Debug, Canonical, QueryNum, Deep, !IO) else server_loop(ToServerPipe, FromServerPipe, TimeOut0, MaybeStartupStream, Debug, Canonical, QueryNum, Deep, !IO) ). %---------------------------------------------------------------------------% :- pred make_pipes(string::in, bool::out, io::di, io::uo) is det. make_pipes(FileName, Success, !IO) :- ToServerPipe = to_server_pipe_name(FileName), FromServerPipe = from_server_pipe_name(FileName), MakeToServerPipeCmd = make_pipe_cmd(ToServerPipe), MakeFromServerPipeCmd = make_pipe_cmd(FromServerPipe), io.call_system.call_system(MakeToServerPipeCmd, ToServerRes, !IO), io.call_system.call_system(MakeFromServerPipeCmd, FromServerRes, !IO), ( if ToServerRes = ok(0), FromServerRes = ok(0) then register_file_for_cleanup(ToServerPipe, !IO), register_file_for_cleanup(FromServerPipe, !IO), Success = yes else % In case one of the pipes *was* created. We ignore the return values % because at least one of these calls *will* fail (since we did not % create both pipes), and if we can't remove a named pipe we did % succeed in creating, then something is so screwed up that probably % there is nothing we can do to fix the situation. io.file.remove_file(ToServerPipe, _, !IO), io.file.remove_file(FromServerPipe, _, !IO), Success = no ). %---------------------------------------------------------------------------% :- pragma foreign_decl("C", " #ifdef MR_DEEP_PROFILER_ENABLED #include #include #include #include #include #endif "). :- pred check_for_existing_fifos(string::in, string::in, int::out, io::di, io::uo) is det. :- pragma foreign_proc("C", check_for_existing_fifos(Fifo1::in, Fifo2::in, FifoCount::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure, tabled_for_io], " #ifdef MR_DEEP_PROFILER_ENABLED struct stat statbuf; int status; FifoCount = 0; status = stat(Fifo1, &statbuf); if ((status == 0) && (S_ISFIFO(statbuf.st_mode))) { FifoCount++; } status = stat(Fifo2, &statbuf); if ((status == 0) && (S_ISFIFO(statbuf.st_mode))) { FifoCount++; } #else MR_fatal_error(""deep profiling not enabled""); #endif "). :- type child_has_parent ---> child_has_parent ; child_has_no_parent. :- type detach_process_result ---> in_child(child_has_parent) ; in_parent ; fork_failed. :- pred detach_process(detach_process_result::out, io::di, io::uo) is cc_multi. detach_process(Result, !IO) :- raw_detach_process(ResCode, !IO), ( if ResCode < 0 then Result = fork_failed else if ResCode > 0 then Result = in_parent else Result = in_child(child_has_parent) ). % Raw_detach_process performs a fork. % % If the fork succeeds, the result returned by detach_process is: % % - a positive number in the parent, and % - zero in the child. % % If the fork fails, the result returned by detach_process is: % % - a negative number in the parent (there is no child process). % :- pred raw_detach_process(int::out, io::di, io::uo) is cc_multi. :- pragma foreign_proc("C", raw_detach_process(ResCode::out, _IO0::di, _IO::uo), [will_not_call_mercury, promise_pure], "{ #ifdef MR_DEEP_PROFILER_ENABLED pid_t status; fflush(stdout); fflush(stderr); status = fork(); if (status < 0) { ResCode = -1; } else if (status > 0) { ResCode = 1; } else { #ifdef MR_HAVE_SETPGID /* ** Try to detach the server process from the parent's process group, ** in case it uses the number of processes in the process group ** to decide when the cgi `script' is done. */ setpgid(0, 0); #else /* Hope that web server doesn't depend on the process group. */ #endif ResCode = 0; } #else MR_fatal_error(""deep profiling not enabled""); #endif }"). %---------------------------------------------------------------------------% :- type option ---> canonical_clique ; clique ; debug ; decode ; decode_cmd ; decode_prefs ; detach_process ; help ; localhost ; modules ; proc ; quit ; root ; record_startup ; record_loop ; server_process ; timeout ; version ; write_query_string. :- type option_table == (option_table(option)). :- pred short(char::in, option::out) is semidet. short('c', canonical_clique). short('C', clique). short('d', debug). short('m', modules). short('p', proc). short('q', quit). short('r', root). short('s', server_process). short('t', timeout). short('w', write_query_string). :- pred long(string::in, option::out) is semidet. long("canonical-clique", canonical_clique). long("clique", clique). long("debug", debug). long("decode", decode). long("decode-cmd", decode_cmd). long("decode-prefs", decode_prefs). long("detach-process", detach_process). long("help", help). long("localhost", localhost). long("modules", modules). long("proc", proc). long("quit", quit). long("root", root). long("record-startup", record_startup). long("record-loop", record_loop). long("server-process", server_process). long("timeout", timeout). long("version", version). long("write-query-string", write_query_string). :- pred defaults(option::out, option_data::out) is multi. defaults(canonical_clique, bool(no)). defaults(clique, int(0)). defaults(debug, bool(no)). defaults(decode, bool(no)). defaults(decode_cmd, bool(no)). defaults(decode_prefs, bool(no)). defaults(detach_process, bool(yes)). defaults(help, bool(no)). defaults(localhost, bool(no)). defaults(modules, bool(no)). defaults(proc, int(0)). defaults(quit, bool(no)). defaults(root, bool(no)). defaults(record_loop, bool(yes)). defaults(record_startup, bool(yes)). defaults(server_process, bool(yes)). defaults(timeout, int(30)). defaults(version, bool(no)). defaults(write_query_string, bool(yes)). :- func default_cmd(option_table) = cmd. default_cmd(Options) = Cmd :- lookup_bool_option(Options, quit, Quit), lookup_bool_option(Options, root, Root), lookup_bool_option(Options, modules, Modules), lookup_int_option(Options, clique, CliqueNum), lookup_int_option(Options, proc, ProcProcNum), ( if Root = yes then Cmd = deep_cmd_root(no) else if Modules = yes then Cmd = deep_cmd_program_modules else if CliqueNum > 0 then Cmd = deep_cmd_clique(clique_ptr(CliqueNum)) else if ProcProcNum > 0 then Cmd = deep_cmd_proc(proc_static_ptr(ProcProcNum)) else if Quit = yes then Cmd = deep_cmd_quit else Cmd = deep_cmd_menu ). %---------------------------------------------------------------------------% :- end_module mdprof_cgi. %---------------------------------------------------------------------------%