/src/yolk-process_control.adb
Ada | 192 lines | 96 code | 36 blank | 60 comment | 6 complexity | ce521a621df777d876aca68da8856196 MD5 | raw file
1------------------------------------------------------------------------------- 2-- -- 3-- Copyright (C) 2010-, Thomas Løcke -- 4-- -- 5-- This library is free software; you can redistribute it and/or modify -- 6-- it under terms of the GNU General Public License as published by the -- 7-- Free Software Foundation; either version 3, or (at your option) any -- 8-- later version. This library is distributed in the hope that it will be -- 9-- useful, but WITHOUT ANY WARRANTY; without even the implied warranty of -- 10-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 11-- -- 12-- As a special exception under Section 7 of GPL version 3, you are -- 13-- granted additional permissions described in the GCC Runtime Library -- 14-- Exception, version 3.1, as published by the Free Software Foundation. -- 15-- -- 16-- You should have received a copy of the GNU General Public License and -- 17-- a copy of the GCC Runtime Library Exception along with this program; -- 18-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 19-- <http://www.gnu.org/licenses/>. -- 20-- -- 21------------------------------------------------------------------------------- 22 23with Ada.Directories; 24with Ada.Interrupts.Names; 25with Ada.Strings.Fixed; 26with Ada.Text_IO; 27with POSIX.Process_Identification; 28 29package body Yolk.Process_Control is 30 31 use Ada.Directories; 32 33 type Controller_State is (Running, Shutdown, Stopped); 34 35 PID : constant String := PID_File; 36 -- Path to the PID file. If this is empty, then no PID file is written. 37 38 Wait_Called : Boolean := False; 39 -- Is set to True when Wait has been called. This is used to test if we've 40 -- already called Wait earlier, and if so, ignore the call. 41 42 procedure Create_PID_File; 43 procedure Delete_PID_File; 44 -- Create and delete the PID file. 45 46 ------------------ 47 -- Controller -- 48 ------------------ 49 50 protected Controller is 51 entry Check; 52 -- If Controller_State is Shutdown the Wait procedure completes. If PID 53 -- is non-empty then Delete_PID_File is called. 54 55 procedure Handle_Kill; 56 -- Set Controller.State to Shutdown. 57 58 pragma Attach_Handler (Handle_Kill, Ada.Interrupts.Names.SIGINT); 59 pragma Attach_Handler (Handle_Kill, Ada.Interrupts.Names.SIGTERM); 60 pragma Attach_Handler (Handle_Kill, Ada.Interrupts.Names.SIGPWR); 61 -- Handles the SIGINT, SIGTERM and SIGPWR signals. These signalhandlers 62 -- change the Controller.State to Shutdown. 63 64 entry Start; 65 -- Called by Wait. Set Controller.State to Running and calls 66 -- Create_PID_File if PID is non-empty. 67 68 private 69 State : Controller_State := Stopped; 70 end Controller; 71 72 ---------------------- 73 -- Create_PID_File -- 74 ---------------------- 75 76 procedure Create_PID_File 77 is 78 use Ada.Strings; 79 use Ada.Text_IO; 80 use POSIX.Process_Identification; 81 82 File : File_Type; 83 begin 84 if Exists (PID) then 85 raise PID_File_Exists with PID; 86 end if; 87 88 Create (File => File, 89 Name => PID); 90 Put (File => File, 91 Item => Fixed.Trim (Image (Get_Process_ID), Both)); 92 Close (File); 93 exception 94 when Ada.Text_IO.Name_Error | 95 Ada.Text_IO.Use_Error | 96 Ada.Text_IO.Device_Error => 97 raise Cannot_Create_PID_File with PID; 98 end Create_PID_File; 99 100 ----------------------- 101 -- Delete_PID_File -- 102 ----------------------- 103 104 procedure Delete_PID_File 105 is 106 use Ada.Text_IO; 107 begin 108 if Exists (PID) then 109 Delete_File (PID); 110 end if; 111 112 exception 113 when Ada.Text_IO.Name_Error | 114 Ada.Text_IO.Use_Error | 115 Ada.Text_IO.Device_Error => 116 raise Cannot_Delete_PID_File with PID; 117 end Delete_PID_File; 118 119 ------------ 120 -- Stop -- 121 ------------ 122 123 procedure Stop 124 is 125 begin 126 Controller.Handle_Kill; 127 end Stop; 128 129 ------------ 130 -- Wait -- 131 ------------ 132 133 procedure Wait 134 is 135 begin 136 if not Wait_Called then 137 Wait_Called := True; 138 Controller.Start; 139 140 Controller.Check; 141 -- We'll hang here until Controller.State is Shutdown. 142 143 Wait_Called := False; 144 end if; 145 end Wait; 146 147 ------------------ 148 -- Controller -- 149 ------------------ 150 151 protected body Controller is 152 ------------- 153 -- Check -- 154 ------------- 155 156 entry Check when State = Shutdown 157 is 158 begin 159 if PID /= "" then 160 Delete_PID_File; 161 end if; 162 163 State := Stopped; 164 end Check; 165 166 ------------- 167 -- Start -- 168 ------------- 169 170 entry Start when State = Stopped 171 is 172 begin 173 State := Running; 174 175 if PID /= "" then 176 Create_PID_File; 177 end if; 178 end Start; 179 180 ------------------- 181 -- Handle_Kill -- 182 ------------------- 183 184 procedure Handle_Kill is 185 begin 186 if State /= Shutdown then 187 State := Shutdown; 188 end if; 189 end Handle_Kill; 190 end Controller; 191 192end Yolk.Process_Control;