helm/uwobo/uwobo.ml

   1 (*
   2  * Copyright (C) 2003:
   3  *    Stefano Zacchiroli <zack@cs.unibo.it>
   4  *    for the HELM Team http://helm.cs.unibo.it/
   5  *
   6  *  This file is part of HELM, an Hypertextual, Electronic
   7  *  Library of Mathematics, developed at the Computer Science
   8  *  Department, University of Bologna, Italy.
   9  *
  10  *  HELM is free software; you can redistribute it and/or
  11  *  modify it under the terms of the GNU General Public License
  12  *  as published by the Free Software Foundation; either version 2
  13  *  of the License, or (at your option) any later version.
  14  *
  15  *  HELM is distributed in the hope that it will be useful,
  16  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
  17  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18  *  GNU General Public License for more details.
  19  *
  20  *  You should have received a copy of the GNU General Public License
  21  *  along with HELM; if not, write to the Free Software
  22  *  Foundation, Inc., 59 Temple Place - Suite 330, Boston,
  23  *  MA  02111-1307, USA.
  24  *
  25  *  For details, see the HELM World-Wide-Web page,
  26  *  http://helm.cs.unibo.it/
  27  *)
  28
  29 open Printf;;
  30 open Uwobo_common;;
  31
  32  (* debugging settings *)
  33 let debug = false ;;
  34 let debug_level = `Notice ;;
  35 let debug_print s = if debug then prerr_endline s ;;
  36 Http_common.debug := false ;;
  37
  38   (* other settings *)
  39 let daemon_name = "UWOBO OCaml" ;;
  40 let default_log_base_file = "log/uwobo" ;; (* relative to execution dir *)
  41 let log_extension = ".log" ;;
  42 let default_port = 58080 ;;
  43 let port_env_var = "UWOBO_PORT" ;;
  44 let log_env_var = "UWOBO_LOG_FILE" ;; (* The extension _pid.log will be added *)
  45 let default_media_type = "text/html" ;;
  46 let default_encoding = "utf8" ;;
  47
  48 let get_media_type props =
  49  try
  50   List.assoc "media-type" props
  51  with
  52   Not_found -> default_media_type
  53 ;;
  54
  55 let get_encoding props =
  56  try
  57   List.assoc "encoding" props
  58  with
  59   Not_found -> default_encoding
  60 ;;
  61
  62 let port =
  63   try
  64     int_of_string (Sys.getenv port_env_var)
  65   with
  66   | Not_found -> default_port
  67   | Failure "int_of_string" ->
  68      prerr_endline "Warning: invalid port number" ;
  69      exit (-1)
  70 ;;
  71 let logfilename_of_port port =
  72  let basename =
  73   try
  74    Sys.getenv log_env_var
  75   with
  76    Not_found -> default_log_base_file
  77  in
  78   basename ^ "_" ^ string_of_int port ^ log_extension
  79 ;;
  80 let logfile = logfilename_of_port port;;
  81 let logfile_perm = 0o640 ;;
  82
  83 let respond_html body outchan =
  84   Http_daemon.respond ~body ~headers:["Content-Type", "text/html"] outchan
  85 ;;
  86
  87   (** perform an 'action' that can be applied to a list of keys or, if no keys
  88   was given, to all keys *)
  89 let act_on_keys
  90   keys_param styles logger per_key_action all_keys_action all_keys logmsg
  91 =
  92   let keys =
  93     try
  94       Pcre.split ~pat:"," keys_param
  95     with Http_types.Param_not_found _ -> []
  96   in
  97   match keys with
  98   | [] -> (* no key provided, act on all stylesheets *)
  99       logger#log (sprintf "%s all stylesheets (keys = %s) ..."
 100         logmsg (String.concat ", " all_keys));
 101       (try all_keys_action () with e -> logger#log (Printexc.to_string e));
 102       logger#log (sprintf "Done! (all stylesheets)")
 103   | keys ->
 104       List.iter
 105         (fun key -> (* act on a single stylesheet *)
 106           logger#log (sprintf "%s stylesheet %s" logmsg key);
 107           (try per_key_action key with e -> logger#log (Printexc.to_string e));
 108           logger#log (sprintf "Done! (stylesheet %s)" key))
 109         keys
 110 ;;
 111
 112   (** parse parameters for '/apply' action *)
 113 let parse_apply_params =
 114   let is_global_param x = Pcre.pmatch ~pat:"^param(\\.[^.]+){1}$" x in
 115   let is_local_param x = Pcre.pmatch ~pat:"^param(\\.[^.]+){2}$" x in
 116   let is_property x = Pcre.pmatch ~pat:"^prop\\.[^.]+$" x in
 117   List.fold_left
 118     (fun (old_params, old_properties) (name, value) ->
 119       match name with
 120       | name when is_global_param name ->
 121           let name = Pcre.replace ~pat:"^param\\." name in
 122           ((fun x -> (old_params x) @ [name, value]), old_properties)
 123       | name when is_local_param name ->
 124           let pieces = Pcre.extract ~pat:"^param\\.([^.]+)\\.(.*)" name in
 125           let (key, name) = (pieces.(1), pieces.(2)) in
 126           ((function
 127             | x when x = key -> [name, value] @ (old_params x)
 128             | x -> old_params x),
 129            old_properties)
 130       | name when is_property name ->
 131           let name = Pcre.replace ~pat:"^prop\\." name in
 132           (old_params, ((name, value) :: old_properties))
 133       | _ -> (old_params, old_properties))
 134     ((fun _ -> []), []) (* no parameters, no properties *)
 135 ;;
 136
 137   (** Parse libxslt's message modes for error and debugging messages. Default is
 138   to ignore mesages of both kind *)
 139 let parse_libxslt_msgs_mode (req: Http_types.request) =
 140   ((try
 141     (match req#param "errormode" with
 142     | s when String.lowercase s = "ignore" -> LibXsltMsgIgnore
 143     | s when String.lowercase s = "comment" -> LibXsltMsgComment
 144     | s when String.lowercase s = "embed" -> LibXsltMsgEmbed
 145     | err ->
 146         raise (Uwobo_failure
 147           (sprintf
 148             "Unknown value '%s' for parameter '%s', use one of '%s' or '%s'"
 149             err "errormode" "ignore" "comment")))
 150   with Http_types.Param_not_found _ -> LibXsltMsgIgnore),
 151   (try
 152     (match req#param "debugmode" with
 153     | s when String.lowercase s = "ignore" -> LibXsltMsgIgnore
 154     | s when String.lowercase s = "comment" -> LibXsltMsgComment
 155     | s when String.lowercase s = "embed" -> LibXsltMsgEmbed
 156     | err ->
 157         raise (Uwobo_failure
 158           (sprintf
 159             "Unknown value '%s' for parameter '%s', use one of '%s' or '%s'"
 160             err "debugmode" "ignore" "comment")))
 161   with Http_types.Param_not_found _ -> LibXsltMsgIgnore))
 162 ;;
 163
 164   (** send ~cmd (without trailing "\n"!) through ~cmd_pipe, then wait for answer
 165   on ~res_pipe (with a timeout of 60 seconds) and send over outchan data
 166   received from ~res_pipe *)
 167 let short_circuit_grandfather_and_client ~cmd ~cmd_pipe ~res_pipe outchan =
 168 (*   debug_print (sprintf "Sending command '%s' to grandparent ..." cmd); *)
 169   output_string cmd_pipe (cmd ^ "\n");  (* send command to grandfather *)
 170   flush cmd_pipe;
 171   let res_pipe_fd = Unix.descr_of_in_channel res_pipe in
 172   let (read_fds, _, _) =  (* wait for an answer *)
 173     Unix.select [res_pipe_fd] [] [] 60.0
 174   in
 175   (match read_fds with
 176   | [fd] when fd = res_pipe_fd -> (* send answer to http client *)
 177       Http_daemon.send_basic_headers ~code:200 outchan;
 178       Http_daemon.send_header "Content-Type" "text/html" outchan;
 179       Http_daemon.send_CRLF outchan;
 180       (try
 181         while true do
 182           output_string outchan ((input_line res_pipe) ^ "\n")
 183         done
 184       with End_of_file -> flush outchan)
 185   | _ ->  (* no answer received from grandfather *)
 186       return_error "Timeout!" outchan)
 187 ;;
 188
 189 let (add_cmd_RE, remove_cmd_RE, reload_cmd_RE, kill_cmd_RE) =
 190   (Pcre.regexp "^add ", Pcre.regexp "^remove ", Pcre.regexp "^reload ",
 191    Pcre.regexp "^kill")
 192 ;;
 193
 194   (** raised by child processes when HTTP daemon process have to be restarted *)
 195 exception Restart_HTTP_daemon ;;
 196
 197   (** log a list of libxslt's messages using a processing logger *)
 198 let log_libxslt_msgs logger libxslt_logger =
 199   List.iter
 200     (function
 201       | (LibXsltErrorMsg _) as msg -> logger#logBold (string_of_xslt_msg msg)
 202       | (LibXsltDebugMsg _) as msg -> logger#logEmph (string_of_xslt_msg msg))
 203     libxslt_logger#msgs
 204 ;;
 205
 206   (* LibXSLT logger *)
 207 let veillogger = new Uwobo_common.libXsltLogger ;;
 208
 209   (* start_new_session cmd_pipe_exit res_pipe_entrance outchan port logfile
 210   @param cmd_pipe Pipe to be closed before forking
 211   @param res_pipe Pipe to be closed before forking
 212   @param outchan  To be closed before forking
 213   @param port The port to be used
 214   @param logfile The logfile to redirect the stdout and sterr to
 215   *)
 216   (* It can raise Failure "Connection refused" *)
 217   (* It can raise Failure "Port already in use" *)
 218 let start_new_session cmd_pipe res_pipe outchan port logfile =
 219  let environment =
 220   (* Here I am loosing the current value of port_env_var; *)
 221   (* this should not matter                               *)
 222   Unix.putenv port_env_var (string_of_int port) ;
 223   Unix.environment ()
 224  in
 225   (* Let's check that the port is free *)
 226   (try
 227     ignore
 228      (Http_client.Convenience.http_head_message
 229        ("http://127.0.0.1:" ^ string_of_int port ^ "/help")) ;
 230     raise (Failure "Port already in use")
 231    with
 232     Failure "Connection refused" -> ()
 233   ) ;
 234   match Unix.fork () with
 235      0 ->
 236        Unix.handle_unix_error
 237         (function () ->
 238           (* 1. We close all the open pipes to avoid duplicating them *)
 239           Unix.close (Unix.descr_of_out_channel cmd_pipe) ;
 240           Unix.close (Unix.descr_of_in_channel res_pipe) ;
 241           Unix.close (Unix.descr_of_out_channel outchan) ;
 242           (* 2. We redirect stdout and stderr to the logfile *)
 243           Unix.close Unix.stdout ;
 244           assert
 245            (Unix.openfile logfile [Unix.O_WRONLY ; Unix.O_APPEND ; Unix.O_CREAT]
 246              0o664 = Unix.stdout) ;
 247           Unix.close Unix.stderr ;
 248           assert
 249            (Unix.openfile logfile [Unix.O_WRONLY ; Unix.O_APPEND ; Unix.O_CREAT]
 250              0o664 = Unix.stderr) ;
 251           prerr_endline "***** Starting a new session" ;
 252           (* 3. We exec a new copy of uwobo *)
 253           Unix.execve Sys.executable_name [||] environment ;
 254           (* It should never reach this point *)
 255           assert false
 256         ) ()
 257    | child when child > 0 ->
 258       (* let's check if the new UWOBO started correctly *)
 259       Unix.sleep 5 ;
 260       (* It can raise Failure "Connection refused" *)
 261       ignore
 262         (Http_client.Convenience.http_head_message
 263           ("http://127.0.0.1:" ^ string_of_int port ^ "/help"))
 264    | _ -> failwith "Can't fork :-("
 265 ;;
 266
 267   (* request handler action
 268   @param syslogger Uwobo_logger.sysLogger instance used for logginf
 269   @param styles Uwobo_styles.styles instance which keeps the stylesheets list
 270   @param cmd_pipe output _channel_ used to _write_ update messages
 271   @param res_pipe input _channel_ used to _read_ grandparent results
 272   @param req http request instance
 273   @param outchan output channel connected to http client
 274   *)
 275 let callback
 276   ~syslogger ~styles ~cmd_pipe ~res_pipe () (req: Http_types.request) outchan
 277   =
 278   try
 279     syslogger#log `Notice (sprintf "Connection from %s" req#clientAddr);
 280     syslogger#log `Debug (sprintf "Received request: %s" req#path);
 281     (match req#path with
 282     | "/add" ->
 283         (let bindings = req#paramAll "bind" in
 284         if bindings = [] then
 285           return_error "No [key,stylesheet] binding provided" outchan
 286         else begin
 287           let cmd = sprintf "add %s" (String.concat ";" bindings) in
 288           short_circuit_grandfather_and_client ~cmd ~cmd_pipe ~res_pipe outchan
 289         end)
 290     | "/kill" ->
 291         let logger = new Uwobo_logger.processingLogger () in
 292          logger#log "Exiting" ;
 293          respond_html logger#asHtml outchan ;
 294          let cmd = "kill" in
 295           short_circuit_grandfather_and_client ~cmd ~cmd_pipe ~res_pipe outchan
 296     | "/newsession" ->
 297         let logger = new Uwobo_logger.processingLogger () in
 298         let port = int_of_string (req#param "port") in
 299         let logfile = logfilename_of_port port in
 300         (try
 301           start_new_session cmd_pipe res_pipe outchan port logfile ;
 302           logger#log (sprintf "New session started: port = %d" port) ;
 303           respond_html logger#asHtml outchan
 304          with
 305             Failure "int_of_string" ->
 306              logger#log (sprintf "Invalid port number") ;
 307              respond_html logger#asHtml outchan
 308           | Failure "Port already in use" ->
 309              Uwobo_common.return_error "port already in use" outchan
 310           | Failure "Connection refused" ->
 311              let log = ref [] in
 312               (try
 313                 let ch = open_in logfile in
 314                  while true do log := (input_line ch ^ "\n") :: !log ; done
 315                with
 316                   Sys_error _
 317                 | End_of_file -> ()
 318               ) ;
 319               let rec get_last_lines acc =
 320                function
 321                   (n,he::tl) when n > 0 ->
 322                     get_last_lines (he ^ "<br />" ^ acc) (n-1,tl)
 323                 | _ -> acc
 324               in
 325                (* we just show the last 10 lines of the log file *)
 326                let msg =
 327                 (if List.length !log > 0 then "<br />...<br />" else "<br />") ^
 328                  get_last_lines "" (10,!log)
 329                in
 330                 Uwobo_common.return_error "daemon not initialized"
 331                  ~body:msg outchan)
 332     | "/remove" ->
 333           let cmd = sprintf "remove %s" (req#param "keys") in
 334           short_circuit_grandfather_and_client ~cmd ~cmd_pipe ~res_pipe outchan
 335     | "/reload" ->
 336           let cmd = sprintf "reload %s" (req#param "keys") in
 337           short_circuit_grandfather_and_client ~cmd ~cmd_pipe ~res_pipe outchan
 338     | "/list" ->
 339         (let logger = new Uwobo_logger.processingLogger () in
 340         (match styles#list with
 341         | [] -> logger#log "No stylesheets loaded (yet)!"
 342         | l ->
 343             logger#log "Stylesheets list:";
 344             List.iter (fun s -> logger#log s) l);
 345         respond_html logger#asHtml outchan)
 346     | "/apply" ->
 347         let logger = new Uwobo_logger.processingLogger () in
 348         veillogger#clearMsgs;
 349         let xmluri = req#param "xmluri" in
 350         let keys = Pcre.split ~pat:"," (req#param "keys") in
 351         (* notation: "local" parameters are those defined on a per-stylesheet
 352         pasis (i.e. param.key.param=value), "global" parameters are those
 353         defined for all stylesheets (i.e. param.param=value) *)
 354         let (params, props) = parse_apply_params req#params in
 355         let (libxslt_errormode, libxslt_debugmode) =
 356           parse_libxslt_msgs_mode req
 357         in
 358         syslogger#log `Debug (sprintf "Parsing input document %s ..." xmluri);
 359         let domImpl = Gdome.domImplementation () in
 360         let input = domImpl#createDocumentFromURI ~uri:xmluri () in
 361         syslogger#log `Debug "Applying stylesheet chain ...";
 362         (try
 363           let (write_result, media_type, encoding) = (* out_channel -> unit *)
 364             Uwobo_engine.apply
 365               ~logger:syslogger ~styles ~keys ~params ~props ~veillogger
 366               ~errormode:libxslt_errormode ~debugmode:libxslt_debugmode
 367               input
 368           in
 369           let content_type = (* value of Content-Type HTTP response header *)
 370             sprintf "%s; charset=%s"
 371               (match media_type with None -> get_media_type props | Some t -> t)
 372               (match encoding with None -> get_encoding props | Some e -> e)
 373           in
 374           syslogger#log `Debug
 375             (sprintf "sending output to client (Content-Type: %s)...."
 376               content_type);
 377           Http_daemon.send_basic_headers ~code:200 outchan;
 378           Http_daemon.send_header "Content-Type" content_type outchan;
 379           Http_daemon.send_CRLF outchan;
 380           write_result outchan
 381         with Uwobo_failure errmsg ->
 382           return_error
 383             ("Stylesheet chain application failed: " ^ errmsg)
 384             ~body: ("<h2>LibXSLT's messages:</h2>" ^
 385               String.concat "<br />\n"
 386                 (List.map string_of_xslt_msg veillogger#msgs))
 387             outchan)
 388     | "/help" -> respond_html usage_string outchan
 389     | invalid_request ->
 390         Http_daemon.respond_error ~status:(`Client_error `Bad_request) outchan);
 391     syslogger#log `Debug (sprintf "%s done!" req#path);
 392   with
 393   | Http_types.Param_not_found attr_name ->
 394       bad_request (sprintf "Parameter '%s' is missing" attr_name) outchan
 395   | exc ->
 396       return_error ("Uncaught exception: " ^ (Printexc.to_string exc)) outchan
 397 ;;
 398
 399   (* UWOBO's startup *)
 400 let main () =
 401     (* (1) system logger *)
 402   let logger_outchan =
 403    debug_print (sprintf "Logging to file %s" logfile);
 404    open_out_gen [Open_wronly; Open_append; Open_creat] logfile_perm logfile
 405   in
 406   let syslogger =
 407     new Uwobo_logger.sysLogger ~level:debug_level ~outchan:logger_outchan ()
 408   in
 409   syslogger#enable;
 410     (* (2) stylesheets list *)
 411   let styles = new Uwobo_styles.styles in
 412     (* (3) clean up actions *)
 413   let last_process = ref true in
 414   let http_child = ref None in
 415   let die_nice () = (** at_exit callback *)
 416     if !last_process then begin
 417       (match !http_child with
 418       | None -> ()
 419       | Some pid -> Unix.kill pid Sys.sigterm);
 420       syslogger#log `Notice (sprintf "%s is terminating, bye!" daemon_name);
 421       syslogger#disable;
 422       close_out logger_outchan
 423     end
 424   in
 425   at_exit die_nice;
 426   ignore (Sys.signal Sys.sigterm
 427     (Sys.Signal_handle (fun _ -> raise Sys.Break)));
 428   syslogger#log `Notice
 429     (sprintf "%s started and listening on port %d" daemon_name port);
 430   syslogger#log `Notice (sprintf "current directory is %s" (Sys.getcwd ()));
 431   Unix.putenv "http_proxy" "";  (* reset http_proxy to avoid libxslt problems *)
 432   while true do
 433     let (cmd_pipe_exit, cmd_pipe_entrance) = Unix.pipe () in
 434     let (res_pipe_exit, res_pipe_entrance) = Unix.pipe () in
 435     match Unix.fork () with
 436     | child when child > 0 -> (* (4) parent: listen on cmd pipe for updates *)
 437         http_child := Some child;
 438         let stop_http_daemon () =  (* kill child *)
 439           debug_print (sprintf "UWOBOmaster: killing pid %d" child);
 440           Unix.kill child Sys.sigterm;  (* kill child ... *)
 441           ignore (Unix.waitpid [] child);  (* ... and its zombie *)
 442         in
 443         Unix.close cmd_pipe_entrance;
 444         Unix.close res_pipe_exit;
 445         let cmd_pipe = Unix.in_channel_of_descr cmd_pipe_exit in
 446         let res_pipe = Unix.out_channel_of_descr res_pipe_entrance in
 447         (try
 448           while true do
 449             (* INVARIANT: 'Restart_HTTP_daemon' exception is raised only after
 450             child process has been killed *)
 451             debug_print "UWOBOmaster: waiting for commands ...";
 452             let cmd = input_line cmd_pipe in
 453             debug_print (sprintf "UWOBOmaster: received %s command" cmd);
 454             (match cmd with  (* command from grandchild *)
 455             | "test" ->
 456                 stop_http_daemon ();
 457                 output_string res_pipe "UWOBOmaster: Hello, world!\n";
 458                 flush res_pipe;
 459                 raise Restart_HTTP_daemon
 460             | line when Pcre.pmatch ~rex:kill_cmd_RE line -> (* /kill *)
 461                 exit 0
 462             | line when Pcre.pmatch ~rex:add_cmd_RE line -> (* /add *)
 463                 let bindings =
 464                   Pcre.split ~pat:";" (Pcre.replace ~rex:add_cmd_RE line)
 465                 in
 466                 stop_http_daemon ();
 467                 let logger = new Uwobo_logger.processingLogger () in
 468                 List.iter
 469                   (fun binding -> (* add a <key, stylesheet> binding *)
 470                     let pieces = Pcre.split ~pat:"," binding in
 471                     match pieces with
 472                     | [key; style] ->
 473                         logger#log (sprintf "adding binding <%s,%s>" key style);
 474                         veillogger#clearMsgs;
 475                         (try
 476                           veillogger#clearMsgs;
 477                           styles#add key style;
 478                           log_libxslt_msgs logger veillogger;
 479                         with e ->
 480                           logger#log (Printexc.to_string e))
 481                     | _ -> logger#log (sprintf "invalid binding %s" binding))
 482                   bindings;
 483                 output_string res_pipe logger#asHtml;
 484                 flush res_pipe;
 485                 raise Restart_HTTP_daemon
 486             | line when Pcre.pmatch ~rex:remove_cmd_RE line ->  (* /remove *)
 487                 stop_http_daemon ();
 488                 let arg = Pcre.replace ~rex:remove_cmd_RE line in
 489                 let logger = new Uwobo_logger.processingLogger () in
 490                 veillogger#clearMsgs;
 491                 act_on_keys
 492                   arg styles logger
 493                   styles#remove (fun () -> styles#removeAll) styles#keys
 494                   "removing";
 495                 log_libxslt_msgs logger veillogger;
 496                 output_string res_pipe (logger#asHtml);
 497                 raise Restart_HTTP_daemon
 498             | line when Pcre.pmatch ~rex:reload_cmd_RE line ->  (* /reload *)
 499                 stop_http_daemon ();
 500                 let arg = Pcre.replace ~rex:reload_cmd_RE line in
 501                 let logger = new Uwobo_logger.processingLogger () in
 502                 veillogger#clearMsgs;
 503                 act_on_keys
 504                   arg styles logger
 505                   styles#reload (fun () -> styles#reloadAll) styles#keys
 506                   "reloading";
 507                 output_string res_pipe (logger#asHtml);
 508                 raise Restart_HTTP_daemon
 509             | cmd ->  (* invalid interprocess command received *)
 510                 syslogger#log `Warning
 511                   (sprintf "Ignoring invalid interprocess command: '%s'" cmd))
 512           done
 513         with Restart_HTTP_daemon ->
 514           close_in cmd_pipe;  (* these calls close also fds *)
 515           close_out res_pipe;)
 516     | 0 ->  (* (5) child: serve http requests *)
 517         Unix.close cmd_pipe_exit;
 518         Unix.close res_pipe_entrance;
 519         last_process := false;
 520         let cmd_pipe = Unix.out_channel_of_descr cmd_pipe_entrance in
 521         let res_pipe = Unix.in_channel_of_descr res_pipe_exit in
 522         debug_print (sprintf "Starting HTTP daemon on port %d ..." port);
 523           (* next invocation doesn't return, process will keep on serving HTTP
 524           requests until it will get killed by father *)
 525         Http_daemon.start'~port ~mode:`Fork
 526           (callback ~syslogger ~styles ~cmd_pipe ~res_pipe ())
 527     | _ (* < 0 *) ->  (* fork failed :-((( *)
 528         failwith "Can't fork :-("
 529   done
 530 ;;
 531
 532   (* daemon initialization *)
 533 try
 534   Sys.catch_break true;
 535   main ()
 536 with Sys.Break -> ()  (* 'die_nice' registered with at_exit *)
 537 ;;
 538