fortsh Public

Watch 0 Fork 0 Star 0
Fortran · 8874 bytes Raw Blame History
1 ! ==============================================================================
2 ! Module: signal_handler
3 ! Purpose: Enhanced signal handling and process control
4 ! ==============================================================================
5 module signal_handler
6 use iso_c_binding
7 use system_interface
8 use shell_types
9 implicit none
10
11 ! Additional signal constants not in system_interface
12 integer, parameter :: SIGHUP = 1
13 integer, parameter :: SIGQUIT = 3
14 integer, parameter :: SIGKILL = 9
15 integer, parameter :: SIGTERM = 15
16 integer, parameter :: SIGALRM = 14
17
18 #ifdef __APPLE__
19 ! macOS/BSD: SIGWINCH = 28
20 integer, parameter :: SIGWINCH = 28
21 #else
22 ! Linux: SIGWINCH = 28 (same on Linux)
23 integer, parameter :: SIGWINCH = 28
24 #endif
25
26 ! Timeout support
27 type :: timeout_t
28 integer :: seconds = 0
29 logical :: active = .false.
30 integer(c_pid_t) :: target_pid = 0
31 character(len=256) :: command = ''
32 end type timeout_t
33
34 type(timeout_t), save :: active_timeout
35
36 ! Global flag for terminal resize detection
37 ! volatile ensures compiler doesn't optimize away checks
38 logical, save, volatile :: g_terminal_resized = .false.
39
40 interface
41 function kill_c(pid, sig) bind(C, name="kill") result(ret)
42 import :: c_int, c_pid_t
43 integer(c_pid_t), value :: pid
44 integer(c_int), value :: sig
45 integer(c_int) :: ret
46 end function
47
48 function alarm_c(seconds) bind(C, name="alarm") result(ret)
49 import :: c_int
50 integer(c_int), value :: seconds
51 integer(c_int) :: ret
52 end function
53
54 function setpgid_c(pid, pgid) bind(C, name="setpgid") result(ret)
55 import :: c_int, c_pid_t
56 integer(c_pid_t), value :: pid, pgid
57 integer(c_int) :: ret
58 end function
59
60 function getpgrp_c() bind(C, name="getpgrp") result(pgid)
61 import :: c_pid_t
62 integer(c_pid_t) :: pgid
63 end function
64 end interface
65
66 contains
67
68 subroutine setup_signal_handlers()
69 use iso_fortran_env, only: error_unit
70 type(c_funptr) :: old_handler
71
72 ! Initialize signal constants first
73 call init_signal_constants()
74
75 ! CRITICAL: Set SIGCHLD to default handler
76 ! If inherited as SIG_IGN from parent shell, children are auto-reaped on macOS/BSD
77 ! This prevents waitpid from working correctly
78 old_handler = c_signal(SIGCHLD, SIG_DFL)
79
80 ! Ignore interactive signals for shell itself
81 old_handler = c_signal(SIGINT, SIG_IGN)
82 #ifndef __APPLE__
83 ! On Linux/other platforms, ignore SIGTSTP like other shells
84 old_handler = c_signal(SIGTSTP, SIG_IGN)
85 #endif
86 ! On macOS, setting SIGTSTP to SIG_IGN breaks waitpid by causing
87 ! children to be auto-reaped, so we leave it at default
88 old_handler = c_signal(SIGTTIN, SIG_IGN)
89 old_handler = c_signal(SIGTTOU, SIG_IGN)
90
91 ! Handle alarm for timeouts
92 old_handler = c_signal(SIGALRM, c_funloc(sigalrm_handler))
93
94 ! Handle terminal window resize
95 old_handler = c_signal(SIGWINCH, c_funloc(sigwinch_handler))
96 end subroutine
97
98 subroutine sigchld_handler() bind(C)
99 ! Child process terminated - will be handled by job control
100 end subroutine
101
102 subroutine sigalrm_handler() bind(C)
103 ! Timeout occurred
104 if (active_timeout%active .and. active_timeout%target_pid > 0) then
105 ! Kill the timed-out process
106 call send_signal_to_process(active_timeout%target_pid, SIGTERM)
107 active_timeout%active = .false.
108 end if
109 end subroutine
110
111 subroutine sigwinch_handler() bind(C)
112 ! Terminal window size changed
113 ! Set flag to trigger re-query of terminal dimensions
114 g_terminal_resized = .true.
115 end subroutine
116
117 ! Enhanced process group management
118 function create_process_group(pid) result(success)
119 integer(c_pid_t), intent(in) :: pid
120 logical :: success
121 integer :: ret
122
123 ret = setpgid_c(pid, pid)
124 success = (ret == 0)
125 end function
126
127 function set_process_group(pid, pgid) result(success)
128 integer(c_pid_t), intent(in) :: pid, pgid
129 logical :: success
130 integer :: ret
131
132 ret = setpgid_c(pid, pgid)
133 success = (ret == 0)
134 end function
135
136 function get_shell_process_group() result(pgid)
137 integer(c_pid_t) :: pgid
138
139 pgid = getpgrp_c()
140 end function
141
142 ! Send signal to process or process group
143 subroutine send_signal_to_process(pid, signal)
144 integer(c_pid_t), intent(in) :: pid
145 integer, intent(in) :: signal
146 integer :: ret
147
148 ret = kill_c(pid, signal)
149 end subroutine
150
151 function send_signal_to_group(pgid, signal) result(success)
152 integer(c_pid_t), intent(in) :: pgid
153 integer, intent(in) :: signal
154 logical :: success
155 integer :: ret
156
157 ! Negative PID sends signal to process group
158 ret = kill_c(-pgid, signal)
159 success = (ret == 0)
160 end function
161
162 ! Enhanced trap handling with multiple signals
163 subroutine install_trap(signals, command, shell)
164 character(len=*), intent(in) :: signals
165 character(len=*), intent(in) :: command
166 type(shell_state_t), intent(inout) :: shell
167
168 character(len=32) :: signal_names(20)
169 integer :: signal_count, i
170
171 ! Parse space-separated signal list
172 call parse_signal_list(signals, signal_names, signal_count)
173
174 do i = 1, signal_count
175 call install_single_trap(signal_names(i), command, shell)
176 end do
177 end subroutine
178
179 subroutine install_single_trap(signal_name, command, shell)
180 character(len=*), intent(in) :: signal_name, command
181 type(shell_state_t), intent(inout) :: shell
182
183 integer :: signal_num, i, empty_slot
184
185 signal_num = get_signal_number(signal_name)
186 if (signal_num == 0) return
187
188 empty_slot = -1
189
190 ! Find existing trap or empty slot
191 do i = 1, size(shell%traps)
192 if (shell%traps(i)%signal == signal_num) then
193 ! Update existing trap
194 shell%traps(i)%command = command
195 shell%traps(i)%active = (len_trim(command) > 0)
196 return
197 else if (shell%traps(i)%signal == 0 .and. empty_slot == -1) then
198 empty_slot = i
199 end if
200 end do
201
202 ! Install new trap
203 if (empty_slot > 0) then
204 shell%traps(empty_slot)%signal = signal_num
205 shell%traps(empty_slot)%command = command
206 shell%traps(empty_slot)%active = (len_trim(command) > 0)
207 shell%num_traps = max(shell%num_traps, empty_slot)
208 end if
209 end subroutine
210
211 function get_signal_number(signal_name) result(signal_num)
212 character(len=*), intent(in) :: signal_name
213 integer :: signal_num
214
215 character(len=32) :: name_upper
216
217 name_upper = to_upper(signal_name)
218
219 select case (trim(name_upper))
220 case ('HUP', 'SIGHUP', '1')
221 signal_num = SIGHUP
222 case ('INT', 'SIGINT', '2')
223 signal_num = 2
224 case ('QUIT', 'SIGQUIT', '3')
225 signal_num = SIGQUIT
226 case ('KILL', 'SIGKILL', '9')
227 signal_num = SIGKILL
228 case ('TERM', 'SIGTERM', '15')
229 signal_num = SIGTERM
230 case ('TSTP', 'SIGTSTP')
231 signal_num = SIGTSTP
232 case ('CONT', 'SIGCONT')
233 signal_num = SIGCONT
234 case ('EXIT', '0')
235 signal_num = 0 ! Special case for exit trap
236 case default
237 signal_num = 0
238 end select
239 end function
240
241 subroutine parse_signal_list(signals, signal_names, count)
242 character(len=*), intent(in) :: signals
243 character(len=32), intent(out) :: signal_names(20)
244 integer, intent(out) :: count
245
246 integer :: pos, start_pos
247
248 count = 0
249 pos = 1
250 start_pos = 1
251
252 do while (pos <= len_trim(signals))
253 if (signals(pos:pos) == ' ') then
254 if (pos > start_pos .and. count < 20) then
255 count = count + 1
256 signal_names(count) = signals(start_pos:pos-1)
257 end if
258 start_pos = pos + 1
259 end if
260 pos = pos + 1
261 end do
262
263 ! Handle last signal
264 if (start_pos <= len_trim(signals) .and. count < 20) then
265 count = count + 1
266 signal_names(count) = signals(start_pos:)
267 end if
268 end subroutine
269
270 ! Command timeout support
271 subroutine set_command_timeout(pid, seconds, command)
272 integer(c_pid_t), intent(in) :: pid
273 integer, intent(in) :: seconds
274 character(len=*), intent(in) :: command
275
276 integer :: ret
277
278 active_timeout%target_pid = pid
279 active_timeout%seconds = seconds
280 active_timeout%command = command
281 active_timeout%active = .true.
282
283 ret = alarm_c(seconds)
284 end subroutine
285
286 subroutine clear_command_timeout()
287 integer :: ret
288
289 ret = alarm_c(0) ! Cancel alarm
290 active_timeout%active = .false.
291 active_timeout%target_pid = 0
292 end subroutine
293
294 function to_upper(str) result(upper_str)
295 character(len=*), intent(in) :: str
296 character(len=len(str)) :: upper_str
297 integer :: i
298
299 upper_str = str
300 do i = 1, len_trim(str)
301 if (str(i:i) >= 'a' .and. str(i:i) <= 'z') then
302 upper_str(i:i) = char(ichar(str(i:i)) - 32)
303 end if
304 end do
305 end function
306
307 end module signal_handler