Fortran · 14499 bytes Raw Blame History
1 ! ==============================================================================
2 ! Module: signal_handling
3 ! Purpose: POSIX signal handling for trap builtin
4 ! ==============================================================================
5 module signal_handling
6 use iso_c_binding
7 use shell_types
8 use iso_fortran_env, only: output_unit, error_unit
9 implicit none
10
11 ! Signal constants (1-15 are same on Linux and macOS)
12 integer(c_int), parameter :: SIGHUP = 1
13 integer(c_int), parameter :: SIGINT = 2
14 integer(c_int), parameter :: SIGQUIT = 3
15 integer(c_int), parameter :: SIGILL = 4
16 integer(c_int), parameter :: SIGTRAP = 5
17 integer(c_int), parameter :: SIGABRT = 6
18 integer(c_int), parameter :: SIGBUS = 7
19 integer(c_int), parameter :: SIGFPE = 8
20 integer(c_int), parameter :: SIGKILL = 9
21 integer(c_int), parameter :: SIGUSR1 = 10
22 integer(c_int), parameter :: SIGSEGV = 11
23 integer(c_int), parameter :: SIGUSR2 = 12
24 integer(c_int), parameter :: SIGPIPE = 13
25 integer(c_int), parameter :: SIGALRM = 14
26 integer(c_int), parameter :: SIGTERM = 15
27 #ifdef __APPLE__
28 ! macOS/Darwin signal numbers (16+ differ from Linux)
29 integer(c_int), parameter :: SIGSTKFLT = 16 ! Not used on macOS
30 integer(c_int), parameter :: SIGCHLD = 20
31 integer(c_int), parameter :: SIGCONT = 19
32 integer(c_int), parameter :: SIGSTOP = 17
33 integer(c_int), parameter :: SIGTSTP = 18
34 integer(c_int), parameter :: SIGTTIN = 21
35 integer(c_int), parameter :: SIGTTOU = 22
36 #else
37 ! Linux signal numbers
38 integer(c_int), parameter :: SIGSTKFLT = 16
39 integer(c_int), parameter :: SIGCHLD = 17
40 integer(c_int), parameter :: SIGCONT = 18
41 integer(c_int), parameter :: SIGSTOP = 19
42 integer(c_int), parameter :: SIGTSTP = 20
43 integer(c_int), parameter :: SIGTTIN = 21
44 integer(c_int), parameter :: SIGTTOU = 22
45 #endif
46
47 ! Special trap signals (bash extensions)
48 integer, parameter :: TRAP_EXIT = 0 ! EXIT pseudo-signal
49 integer, parameter :: TRAP_DEBUG = -1 ! DEBUG pseudo-signal
50 integer, parameter :: TRAP_ERR = -2 ! ERR pseudo-signal
51 integer, parameter :: TRAP_RETURN = -3 ! RETURN pseudo-signal
52
53 ! Signal handler type (void (*handler)(int))
54 type, bind(C) :: c_sighandler_t
55 type(c_funptr) :: handler
56 end type
57
58 ! sigaction structure (simplified for Linux)
59 type, bind(C) :: sigaction_t
60 type(c_funptr) :: sa_handler ! Signal handler function pointer
61 integer(c_long) :: sa_mask(16) ! Signal mask (sigset_t, typically 128 bytes / 8 = 16 longs)
62 integer(c_int) :: sa_flags ! Flags
63 type(c_funptr) :: sa_restorer ! Obsolete
64 end type
65
66 ! C interface for signal functions
67 interface
68 ! int sigaction(int signum, const struct sigaction *act, struct sigaction *oldact)
69 function c_sigaction(signum, act, oldact) bind(C, name="sigaction")
70 use iso_c_binding
71 import :: sigaction_t
72 integer(c_int), value :: signum
73 type(sigaction_t), intent(in) :: act
74 type(sigaction_t), intent(out) :: oldact
75 integer(c_int) :: c_sigaction
76 end function c_sigaction
77
78 ! int raise(int sig)
79 function c_raise(sig) bind(C, name="raise")
80 use iso_c_binding
81 integer(c_int), value :: sig
82 integer(c_int) :: c_raise
83 end function c_raise
84 end interface
85
86 ! Special signal handler constants
87 type(c_funptr), parameter :: SIG_DFL = c_null_funptr ! Default action
88 ! SIG_IGN needs to be set to (void(*)(int))1 but we'll handle this specially
89
90 ! Module-level variable to store shell state pointer for signal handlers
91 ! Note: This is a simplification - in production, we'd need thread-safe access
92 type(shell_state_t), pointer, save :: global_shell_state => null()
93
94 ! Pending signals array - set by signal handlers, checked by shell
95 logical, save :: pending_signals(32) = .false.
96
97 contains
98
99 ! Generic signal handler (BIND(C) so it can be called from C)
100 subroutine generic_signal_handler(signum) bind(C, name="fortsh_signal_handler")
101 integer(c_int), value :: signum
102
103 ! Just set the flag - don't do anything complex in a signal handler
104 if (signum > 0 .and. signum <= 32) then
105 pending_signals(signum) = .true.
106 end if
107 end subroutine
108
109 ! Initialize signal handling module with shell state
110 subroutine init_signal_handling(shell)
111 type(shell_state_t), target, intent(inout) :: shell
112 global_shell_state => shell
113 end subroutine
114
115 ! Convert signal name to signal number
116 function signal_name_to_number(name) result(signum)
117 character(len=*), intent(in) :: name
118 integer :: signum
119 character(len=256) :: upper_name
120 integer :: i
121
122 ! Convert to uppercase
123 upper_name = name
124 do i = 1, len_trim(upper_name)
125 if (upper_name(i:i) >= 'a' .and. upper_name(i:i) <= 'z') then
126 upper_name(i:i) = char(ichar(upper_name(i:i)) - 32)
127 end if
128 end do
129
130 ! Strip SIG prefix if present
131 if (upper_name(1:3) == 'SIG') then
132 upper_name = upper_name(4:)
133 end if
134
135 select case(trim(upper_name))
136 case('HUP', '1')
137 signum = SIGHUP
138 case('INT', '2')
139 signum = SIGINT
140 case('QUIT', '3')
141 signum = SIGQUIT
142 case('ILL', '4')
143 signum = SIGILL
144 case('TRAP', '5')
145 signum = SIGTRAP
146 case('ABRT', '6', 'IOT')
147 signum = SIGABRT
148 case('BUS', '7')
149 signum = SIGBUS
150 case('FPE', '8')
151 signum = SIGFPE
152 case('KILL', '9')
153 signum = SIGKILL
154 case('USR1', '10')
155 signum = SIGUSR1
156 case('SEGV', '11')
157 signum = SIGSEGV
158 case('USR2', '12')
159 signum = SIGUSR2
160 case('PIPE', '13')
161 signum = SIGPIPE
162 case('ALRM', '14')
163 signum = SIGALRM
164 case('TERM', '15')
165 signum = SIGTERM
166 case('STKFLT', '16')
167 signum = SIGSTKFLT
168 case('CHLD', 'CLD', '17')
169 signum = SIGCHLD
170 case('CONT', '18')
171 signum = SIGCONT
172 case('STOP', '19')
173 signum = SIGSTOP
174 case('TSTP', '20')
175 signum = SIGTSTP
176 case('TTIN', '21')
177 signum = SIGTTIN
178 case('TTOU', '22')
179 signum = SIGTTOU
180 ! Bash extensions
181 case('EXIT', '0')
182 signum = TRAP_EXIT
183 case('DEBUG')
184 signum = TRAP_DEBUG
185 case('ERR')
186 signum = TRAP_ERR
187 case('RETURN')
188 signum = TRAP_RETURN
189 case default
190 signum = -999 ! Invalid signal
191 end select
192 end function
193
194 ! Convert signal number to signal name
195 function signal_number_to_name(signum) result(name)
196 integer, intent(in) :: signum
197 character(len=16) :: name
198
199 ! Bash uses full signal names with SIG prefix for trap output
200 select case(signum)
201 case(SIGHUP)
202 name = 'SIGHUP'
203 case(SIGINT)
204 name = 'SIGINT'
205 case(SIGQUIT)
206 name = 'SIGQUIT'
207 case(SIGILL)
208 name = 'SIGILL'
209 case(SIGTRAP)
210 name = 'SIGTRAP'
211 case(SIGABRT)
212 name = 'SIGABRT'
213 case(SIGBUS)
214 name = 'SIGBUS'
215 case(SIGFPE)
216 name = 'SIGFPE'
217 case(SIGKILL)
218 name = 'SIGKILL'
219 case(SIGUSR1)
220 name = 'SIGUSR1'
221 case(SIGSEGV)
222 name = 'SIGSEGV'
223 case(SIGUSR2)
224 name = 'SIGUSR2'
225 case(SIGPIPE)
226 name = 'SIGPIPE'
227 case(SIGALRM)
228 name = 'SIGALRM'
229 case(SIGTERM)
230 name = 'SIGTERM'
231 case(SIGSTKFLT)
232 name = 'SIGSTKFLT'
233 case(SIGCHLD)
234 name = 'SIGCHLD'
235 case(SIGCONT)
236 name = 'SIGCONT'
237 case(SIGSTOP)
238 name = 'SIGSTOP'
239 case(SIGTSTP)
240 name = 'SIGTSTP'
241 case(SIGTTIN)
242 name = 'SIGTTIN'
243 case(SIGTTOU)
244 name = 'SIGTTOU'
245 case(TRAP_EXIT)
246 name = 'EXIT'
247 case(TRAP_DEBUG)
248 name = 'DEBUG'
249 case(TRAP_ERR)
250 name = 'ERR'
251 case(TRAP_RETURN)
252 name = 'RETURN'
253 case default
254 write(name, '(i15)') signum
255 end select
256 end function
257
258 ! Set a signal trap
259 subroutine set_signal_trap(shell, signum, command)
260 type(shell_state_t), intent(inout) :: shell
261 integer, intent(in) :: signum
262 character(len=*), intent(in) :: command
263 integer :: i, free_slot
264 logical :: found
265 type(sigaction_t) :: sa, old_sa
266 integer(c_int) :: ret
267
268 ! Find existing trap or free slot
269 found = .false.
270 free_slot = -1
271 do i = 1, size(shell%traps)
272 if (shell%traps(i)%signal == signum .and. shell%traps(i)%active) then
273 ! Update existing trap
274 shell%traps(i)%command = command
275 shell%traps(i)%inherited = .false.
276 found = .true.
277 exit
278 else if (.not. shell%traps(i)%active .and. free_slot == -1) then
279 free_slot = i
280 end if
281 end do
282
283 if (.not. found) then
284 if (free_slot == -1) then
285 write(error_unit, '(a)') 'trap: too many traps'
286 return
287 end if
288
289 ! Add new trap
290 shell%traps(free_slot)%signal = signum
291 shell%traps(free_slot)%command = command
292 shell%traps(free_slot)%active = .true.
293 shell%num_traps = shell%num_traps + 1
294 end if
295
296 ! For real signals (not pseudo-signals like EXIT), register signal handler
297 if (signum > 0 .and. signum <= 31) then
298 ! Initialize sigaction structure
299 sa%sa_handler = c_funloc(generic_signal_handler)
300 sa%sa_mask = 0
301 sa%sa_flags = 0 ! Could add SA_RESTART for automatic syscall restart
302 sa%sa_restorer = c_null_funptr
303
304 ! Register the signal handler
305 ret = c_sigaction(int(signum, c_int), sa, old_sa)
306 if (ret /= 0) then
307 write(error_unit, '(a,i15)') 'trap: failed to set signal handler for signal ', signum
308 end if
309 end if
310 end subroutine
311
312 ! Remove a signal trap
313 subroutine remove_signal_trap(shell, signum)
314 type(shell_state_t), intent(inout) :: shell
315 integer, intent(in) :: signum
316 integer :: i
317 type(sigaction_t) :: sa, old_sa
318 integer(c_int) :: ret
319
320 ! Find and deactivate trap
321 do i = 1, size(shell%traps)
322 if (shell%traps(i)%signal == signum .and. shell%traps(i)%active) then
323 shell%traps(i)%active = .false.
324 shell%traps(i)%command = ''
325 shell%num_traps = shell%num_traps - 1
326
327 ! Reset signal to default handler
328 if (signum > 0 .and. signum <= 31) then
329 sa%sa_handler = SIG_DFL
330 sa%sa_mask = 0
331 sa%sa_flags = 0
332 sa%sa_restorer = c_null_funptr
333
334 ret = c_sigaction(int(signum, c_int), sa, old_sa)
335 if (ret /= 0) then
336 write(error_unit, '(a,i15)') 'trap: failed to reset signal handler for signal ', signum
337 end if
338 end if
339
340 exit
341 end if
342 end do
343 end subroutine
344
345 ! List all active traps
346 subroutine list_traps(shell)
347 type(shell_state_t), intent(in) :: shell
348 integer :: i
349 character(len=16) :: sig_name
350
351 ! Use num_traps instead of size(traps) so that subshells can clear traps
352 ! Note: Bash displays inherited traps in subshells (for listing), though they don't execute
353 do i = 1, shell%num_traps
354 if (shell%traps(i)%active) then
355 sig_name = signal_number_to_name(shell%traps(i)%signal)
356 write(output_unit, '(a)') 'trap -- ' // "'" // trim(shell%traps(i)%command) // &
357 "' " // trim(sig_name)
358 end if
359 end do
360 flush(output_unit)
361 end subroutine
362
363 ! Get trap command for a signal (returns empty string if no trap set)
364 function get_trap_command(shell, signum) result(command)
365 type(shell_state_t), intent(in) :: shell
366 integer, intent(in) :: signum
367 character(len=4096) :: command
368 integer :: i
369
370 command = ''
371
372 ! Find the trap command for this signal
373 do i = 1, size(shell%traps)
374 if (shell%traps(i)%signal == signum .and. shell%traps(i)%active) then
375 command = trim(shell%traps(i)%command)
376 exit
377 end if
378 end do
379 end function
380
381 ! Check if a trap is inherited from parent shell (visible but not executable)
382 function is_trap_inherited(shell, signum) result(inherited)
383 type(shell_state_t), intent(in) :: shell
384 integer, intent(in) :: signum
385 logical :: inherited
386 integer :: i
387
388 inherited = .false.
389
390 ! Find the trap for this signal
391 do i = 1, size(shell%traps)
392 if (shell%traps(i)%signal == signum .and. shell%traps(i)%active) then
393 inherited = shell%traps(i)%inherited
394 exit
395 end if
396 end do
397 end function is_trap_inherited
398
399 ! Get pending trap signals and clear flags
400 ! Returns array of signal numbers that have pending traps (0-terminated)
401 subroutine get_pending_trap_signals(signals, count)
402 integer, intent(out) :: signals(32)
403 integer, intent(out) :: count
404 integer :: signum
405
406 count = 0
407 signals = 0
408
409 ! Check each signal
410 do signum = 1, 32
411 if (pending_signals(signum)) then
412 ! Clear the flag
413 pending_signals(signum) = .false.
414
415 ! Add to list
416 count = count + 1
417 signals(count) = signum
418 end if
419 end do
420 end subroutine
421
422 ! Check if a signal can be trapped
423 function is_trappable_signal(signum) result(trappable)
424 integer, intent(in) :: signum
425 logical :: trappable
426
427 ! SIGKILL and SIGSTOP cannot be caught or ignored
428 trappable = (signum /= SIGKILL .and. signum /= SIGSTOP)
429 end function
430
431 ! Execute a trap command
432 ! Returns .true. if trap was executed, .false. if no trap was set
433 function execute_trap(shell, signum, saved_exit_status) result(executed)
434 type(shell_state_t), intent(inout) :: shell
435 integer, intent(in) :: signum
436 integer, intent(in), optional :: saved_exit_status
437 logical :: executed
438 character(len=4096) :: trap_cmd
439 integer :: original_status
440
441 ! Prevent recursive trap execution (traps don't trigger traps)
442 if (shell%executing_trap) then
443 executed = .false.
444 return
445 end if
446
447 ! Get the trap command
448 trap_cmd = get_trap_command(shell, signum)
449
450 if (len_trim(trap_cmd) == 0) then
451 executed = .false.
452 return
453 end if
454
455 ! Save current exit status
456 original_status = shell%last_exit_status
457
458 ! If saved_exit_status provided (for ERR trap), use it
459 if (present(saved_exit_status)) then
460 original_status = saved_exit_status
461 end if
462
463 ! Store the trap command for execution by the caller (executor module)
464 ! This avoids circular dependency between signal_handling and executor modules
465 ! The executor will parse and execute the trap command using execute_eval style
466 shell%pending_trap_command = trim(trap_cmd)
467 shell%pending_trap_signal = signum
468
469 ! Restore original exit status (traps don't affect $?)
470 shell%last_exit_status = original_status
471
472 executed = .true.
473 end function
474
475 end module signal_handling
476