15.4.1064  src/lib/std/safely.pkg

## safely.pkg

# Compiled by:
#     src/lib/std/standard.lib

# Guarding IO against file descriptor leakage...

api Safely {

    do: { open_it:   Void -> X,
          close_it:  X -> Void,
          cleanup:   Bool -> Void       # Arg is TRUE when called due to an interrupt.  Whatever "interrupt" means.
        }
        ->
        (X -> Y)
        ->
        Y;
};

stipulate
    package is  =  interprocess_signals;                                        # interprocess_signals  is from   src/lib/std/src/nj/interprocess-signals.pkg
herein

    package   safely
    :         Safely
    {


        fun do { open_it, close_it, cleanup }
               work
            =
            {   old_handler
                    =
                    is::get_signal_handler  is::SIGINT;

                int_mask
                    =
                    is::MASK [is::SIGINT];

                is::mask_signals  int_mask;

                s =  open_it ()
                     except
                         e =  {   is::unmask_signals  int_mask;
                                  cleanup  FALSE;
                                  raise exception  e;
                              };

                fun reset ()
                    =
                    {   close_it  s;
                        ignore  (is::set_signal_handler  (is::SIGINT, old_handler));
                    };

                fun int_handler arg
                    =
                    {  include package   winix__premicrothread::process;

                       reset ();
                       cleanup TRUE;

                       case old_handler
                            #                
                            is::HANDLER h =>  h arg;
                            _            =>  exit_x failure;
                       esac;
                    };

                is::override_signal_handler (
                    is::SIGINT,
                    is::HANDLER int_handler
                );

                is::unmask_signals  int_mask;

                (  work s
                   except
                       e =  {   reset ();
                                cleanup  FALSE;
                                raise exception  e;
                            }
                )
                then
                    reset ();
            };                          # fun do

    };
end;


## Copyright (c) 1998 by Lucent Bell Laboratories
## author: Matthias Blume (blume@cs.princeton.edu)
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.