Fortran · 20768 bytes Raw Blame History
1 ! ==============================================================================
2 ! Module: command_builtin
3 ! Purpose: Command identification built-ins (type, which, command)
4 ! ==============================================================================
5 module command_builtin
6 use shell_types
7 use variables
8 use system_interface, only: F_OK, X_OK
9 use iso_fortran_env, only: output_unit, error_unit
10 use iso_c_binding, only: c_int, c_char, c_null_char
11 use io_helpers, only: write_stdout
12 implicit none
13
14 interface
15 function access_c(path, mode) bind(c, name='access') result(status)
16 import :: c_int, c_char
17 character(kind=c_char), intent(in) :: path(*)
18 integer(c_int), value :: mode
19 integer(c_int) :: status
20 end function
21 end interface
22
23 contains
24
25 subroutine builtin_type(cmd, shell)
26 type(command_t), intent(in) :: cmd
27 type(shell_state_t), intent(inout) :: shell
28
29 integer :: i, arg_index
30 logical :: all_flag, path_flag, type_flag, function_flag
31 character(len=256) :: command_name
32
33 if (cmd%num_tokens < 2) then
34 write(error_unit, '(a)') 'type: usage: type [-afptP] name [name ...]'
35 shell%last_exit_status = 2
36 return
37 end if
38
39 all_flag = .false.
40 path_flag = .false.
41 type_flag = .false.
42 function_flag = .false.
43 arg_index = 2
44
45 ! Parse options
46 do while (arg_index <= cmd%num_tokens)
47 if (cmd%tokens(arg_index)(1:1) == '-') then
48 select case (trim(cmd%tokens(arg_index)))
49 case ('-a')
50 all_flag = .true.
51 case ('-p')
52 path_flag = .true.
53 case ('-t')
54 type_flag = .true.
55 case ('-f')
56 function_flag = .true.
57 case ('-P')
58 path_flag = .true.
59 case ('--')
60 arg_index = arg_index + 1
61 exit
62 case default
63 write(error_unit, '(a,a)') 'type: unknown option: ', trim(cmd%tokens(arg_index))
64 shell%last_exit_status = 1
65 return
66 end select
67 arg_index = arg_index + 1
68 else
69 exit
70 end if
71 end do
72
73 if (arg_index > cmd%num_tokens) then
74 write(error_unit, '(a)') 'type: usage: type [-afptP] name [name ...]'
75 shell%last_exit_status = 2
76 return
77 end if
78
79 shell%last_exit_status = 0
80
81 ! Process each command name
82 do i = arg_index, cmd%num_tokens
83 command_name = cmd%tokens(i)
84 call identify_command_type(shell, command_name, all_flag, path_flag, type_flag, function_flag)
85 end do
86 end subroutine
87
88 subroutine builtin_which(cmd, shell)
89 type(command_t), intent(in) :: cmd
90 type(shell_state_t), intent(inout) :: shell
91
92 integer :: i, arg_index
93 logical :: all_flag, silent_flag
94 character(len=256) :: command_name
95
96 if (cmd%num_tokens < 2) then
97 write(error_unit, '(a)') 'which: usage: which [-as] command [command ...]'
98 shell%last_exit_status = 2
99 return
100 end if
101
102 all_flag = .false.
103 silent_flag = .false.
104 arg_index = 2
105
106 ! Parse options
107 do while (arg_index <= cmd%num_tokens)
108 if (cmd%tokens(arg_index)(1:1) == '-') then
109 select case (trim(cmd%tokens(arg_index)))
110 case ('-a')
111 all_flag = .true.
112 case ('-s')
113 silent_flag = .true.
114 case ('--')
115 arg_index = arg_index + 1
116 exit
117 case default
118 write(error_unit, '(a,a)') 'which: unknown option: ', trim(cmd%tokens(arg_index))
119 shell%last_exit_status = 1
120 return
121 end select
122 arg_index = arg_index + 1
123 else
124 exit
125 end if
126 end do
127
128 if (arg_index > cmd%num_tokens) then
129 write(error_unit, '(a)') 'which: usage: which [-as] command [command ...]'
130 shell%last_exit_status = 2
131 return
132 end if
133
134 shell%last_exit_status = 0
135
136 ! Process each command name
137 do i = arg_index, cmd%num_tokens
138 command_name = cmd%tokens(i)
139 call find_command_in_path(shell, command_name, all_flag, silent_flag)
140 end do
141 end subroutine
142
143 subroutine builtin_command(cmd, shell)
144 use executor, only: execute_pipeline
145 type(command_t), intent(in) :: cmd
146 type(shell_state_t), intent(inout) :: shell
147
148 integer :: arg_index, j
149 logical :: path_flag, verbose_flag, big_v_flag
150 character(len=256) :: command_name
151 type(pipeline_t) :: temp_pipeline
152
153 if (cmd%num_tokens < 2) then
154 write(error_unit, '(a)') 'command: usage: command [-pVv] command [arg ...]'
155 shell%last_exit_status = 2
156 return
157 end if
158
159 path_flag = .false.
160 verbose_flag = .false.
161 big_v_flag = .false.
162 arg_index = 2
163
164 ! Parse options
165 do while (arg_index <= cmd%num_tokens)
166 if (cmd%tokens(arg_index)(1:1) == '-') then
167 select case (trim(cmd%tokens(arg_index)))
168 case ('-p')
169 path_flag = .true.
170 case ('-V')
171 verbose_flag = .true.
172 big_v_flag = .true.
173 case ('-v')
174 verbose_flag = .true.
175 case ('--')
176 arg_index = arg_index + 1
177 exit
178 case default
179 write(error_unit, '(a,a)') 'command: unknown option: ', trim(cmd%tokens(arg_index))
180 shell%last_exit_status = 1
181 return
182 end select
183 arg_index = arg_index + 1
184 else
185 exit
186 end if
187 end do
188
189 if (arg_index > cmd%num_tokens) then
190 write(error_unit, '(a)') 'command: usage: command [-pVv] command [arg ...]'
191 shell%last_exit_status = 2
192 return
193 end if
194
195 command_name = cmd%tokens(arg_index)
196
197 if (verbose_flag) then
198 if (big_v_flag) then
199 ! command -V: verbose output like type (e.g., "echo is a shell builtin")
200 call identify_command_type(shell, command_name, .false., path_flag, .false., .false., .true., .false.)
201 else
202 ! command -v: minimal output, just the path/name (POSIX format)
203 call identify_command_type(shell, command_name, .false., path_flag, .false., .false., .true., .true.)
204 end if
205 ! Don't overwrite exit status set by identify_command_type
206 else
207 ! Execute the command bypassing functions
208 ! Build a pipeline directly from the tokens we already have
209 allocate(temp_pipeline%commands(1))
210 temp_pipeline%num_commands = 1
211 temp_pipeline%commands(1)%num_tokens = cmd%num_tokens - arg_index + 1
212 temp_pipeline%commands(1)%separator = SEP_NONE
213 temp_pipeline%commands(1)%background = .false.
214 temp_pipeline%commands(1)%num_redirections = 0
215 temp_pipeline%commands(1)%num_prefix_assignments = 0
216
217 ! Allocate and copy tokens directly from cmd
218 allocate(character(len=MAX_TOKEN_LEN) :: temp_pipeline%commands(1)%tokens(temp_pipeline%commands(1)%num_tokens))
219 allocate(temp_pipeline%commands(1)%token_quoted(temp_pipeline%commands(1)%num_tokens))
220 allocate(temp_pipeline%commands(1)%token_escaped(temp_pipeline%commands(1)%num_tokens))
221 allocate(temp_pipeline%commands(1)%token_quote_type(temp_pipeline%commands(1)%num_tokens))
222 allocate(temp_pipeline%commands(1)%token_lengths(temp_pipeline%commands(1)%num_tokens))
223
224 do j = 1, temp_pipeline%commands(1)%num_tokens
225 temp_pipeline%commands(1)%tokens(j) = cmd%tokens(arg_index + j - 1)
226 if (allocated(cmd%token_quoted)) then
227 temp_pipeline%commands(1)%token_quoted(j) = cmd%token_quoted(arg_index + j - 1)
228 else
229 temp_pipeline%commands(1)%token_quoted(j) = .false.
230 end if
231 if (allocated(cmd%token_escaped)) then
232 temp_pipeline%commands(1)%token_escaped(j) = cmd%token_escaped(arg_index + j - 1)
233 else
234 temp_pipeline%commands(1)%token_escaped(j) = .false.
235 end if
236 if (allocated(cmd%token_quote_type)) then
237 temp_pipeline%commands(1)%token_quote_type(j) = cmd%token_quote_type(arg_index + j - 1)
238 else
239 temp_pipeline%commands(1)%token_quote_type(j) = QUOTE_NONE
240 end if
241 if (allocated(cmd%token_lengths)) then
242 temp_pipeline%commands(1)%token_lengths(j) = cmd%token_lengths(arg_index + j - 1)
243 else
244 temp_pipeline%commands(1)%token_lengths(j) = len_trim(cmd%tokens(arg_index + j - 1))
245 end if
246 end do
247
248 ! Set bypass flags and execute
249 shell%bypass_functions = .true.
250 shell%bypass_aliases = .true.
251 call execute_pipeline(temp_pipeline, shell, '')
252 shell%bypass_functions = .false.
253 shell%bypass_aliases = .false.
254
255 ! Cleanup
256 if (allocated(temp_pipeline%commands(1)%tokens)) deallocate(temp_pipeline%commands(1)%tokens)
257 if (allocated(temp_pipeline%commands(1)%token_quoted)) deallocate(temp_pipeline%commands(1)%token_quoted)
258 if (allocated(temp_pipeline%commands(1)%token_escaped)) deallocate(temp_pipeline%commands(1)%token_escaped)
259 if (allocated(temp_pipeline%commands(1)%token_quote_type)) deallocate(temp_pipeline%commands(1)%token_quote_type)
260 if (allocated(temp_pipeline%commands(1)%token_lengths)) deallocate(temp_pipeline%commands(1)%token_lengths)
261 deallocate(temp_pipeline%commands)
262 end if
263 end subroutine
264
265 subroutine identify_command_type(shell, command_name, all_flag, path_flag, type_flag, function_flag, silent_errors, v_flag)
266 type(shell_state_t), intent(inout) :: shell
267 character(len=*), intent(in) :: command_name
268 logical, intent(in) :: all_flag, path_flag, type_flag, function_flag
269 logical, intent(in), optional :: silent_errors, v_flag
270
271 logical :: found_any, suppress_errors, is_v_flag
272 character(len=MAX_PATH_LEN) :: full_path
273
274 if (.false.) print *, function_flag ! Silence unused warning
275
276 found_any = .false.
277 suppress_errors = .false.
278 is_v_flag = .false.
279 if (present(silent_errors)) suppress_errors = silent_errors
280 if (present(v_flag)) is_v_flag = v_flag
281
282 ! Check if it's a shell keyword
283 if (.not. path_flag .and. is_shell_keyword(command_name)) then
284 if (type_flag) then
285 call write_stdout('keyword')
286 else if (is_v_flag) then
287 call write_stdout(trim(command_name))
288 else
289 call write_stdout(trim(command_name) // ' is a shell keyword')
290 end if
291 found_any = .true.
292 if (.not. all_flag) return
293 end if
294
295 ! Check if it's an alias (bash only reports aliases in interactive mode)
296 if (.not. path_flag .and. shell%is_interactive .and. &
297 is_shell_alias(shell, command_name)) then
298 if (type_flag) then
299 call write_stdout('alias')
300 else if (is_v_flag) then
301 call write_stdout(trim(command_name))
302 else
303 call write_stdout(trim(command_name) // ' is aliased')
304 end if
305 found_any = .true.
306 if (.not. all_flag) return
307 end if
308
309 ! Check if it's a function
310 if (.not. path_flag .and. is_shell_function(shell, command_name)) then
311 if (type_flag) then
312 call write_stdout('function')
313 else if (is_v_flag) then
314 call write_stdout(trim(command_name))
315 else
316 call write_stdout(trim(command_name) // ' is a function')
317 end if
318 found_any = .true.
319 if (.not. all_flag) return
320 end if
321
322 ! Check if it's a built-in
323 if (.not. path_flag .and. is_builtin_command(command_name)) then
324 if (type_flag) then
325 call write_stdout('builtin')
326 else if (is_v_flag) then
327 call write_stdout(trim(command_name))
328 else
329 call write_stdout(trim(command_name) // ' is a shell builtin')
330 end if
331 found_any = .true.
332 if (.not. all_flag) return
333 end if
334
335 ! Search in PATH
336 if (find_executable_in_path(shell, command_name, full_path)) then
337 if (type_flag) then
338 call write_stdout('file')
339 else if (is_v_flag) then
340 call write_stdout(trim(full_path))
341 else
342 call write_stdout(trim(command_name) // ' is ' // trim(full_path))
343 end if
344 found_any = .true.
345 end if
346
347 if (.not. found_any) then
348 if (.not. suppress_errors .and. .not. type_flag) then
349 write(error_unit, '(a,a,a)') trim(command_name), ': not found'
350 end if
351 shell%last_exit_status = 1
352 end if
353 end subroutine
354
355 subroutine find_command_in_path(shell, command_name, all_flag, silent_flag)
356 type(shell_state_t), intent(inout) :: shell
357 character(len=*), intent(in) :: command_name
358 logical, intent(in) :: all_flag, silent_flag
359
360 character(len=MAX_PATH_LEN) :: full_path
361
362 if (.false.) print *, all_flag ! Silence unused warning
363
364 if (find_executable_in_path(shell, command_name, full_path)) then
365 if (.not. silent_flag) then
366 call write_stdout(trim(full_path))
367 end if
368 else
369 if (.not. silent_flag) then
370 write(error_unit, '(a,a,a)') trim(command_name), ': not found'
371 end if
372 shell%last_exit_status = 1
373 end if
374 end subroutine
375
376 function find_executable_in_path(shell, command_name, full_path) result(found)
377 type(shell_state_t), intent(in) :: shell
378 character(len=*), intent(in) :: command_name
379 character(len=*), intent(out) :: full_path
380 logical :: found
381
382 character(len=4096) :: path_var
383 character(len=:), allocatable :: path_component
384 character(len=MAX_PATH_LEN) :: candidate_buf
385 character(len=:), allocatable :: candidate_path
386 integer :: start_pos, end_pos, colon_pos
387
388 found = .false.
389 full_path = ''
390
391 ! If command contains '/', it's an absolute or relative path
392 if (index(command_name, '/') > 0) then
393 if (is_executable_file(command_name)) then
394 full_path = command_name
395 found = .true.
396 end if
397 return
398 end if
399
400 ! Get PATH variable
401 path_var = get_shell_variable(shell, 'PATH')
402 if (len_trim(path_var) == 0) then
403 path_var = '/usr/bin:/bin'
404 end if
405
406 ! Search each directory in PATH
407 start_pos = 1
408 do while (start_pos <= len_trim(path_var))
409 colon_pos = index(path_var(start_pos:), ':')
410 if (colon_pos == 0) then
411 end_pos = len_trim(path_var)
412 else
413 end_pos = start_pos + colon_pos - 2
414 end if
415
416 path_component = path_var(start_pos:end_pos)
417 if (len_trim(path_component) == 0) then
418 path_component = '.'
419 end if
420
421 ! Construct full path
422 if (path_component(len_trim(path_component):len_trim(path_component)) == '/') then
423 write(candidate_buf, '(a,a)') trim(path_component), trim(command_name)
424 else
425 write(candidate_buf, '(a,a,a)') trim(path_component), '/', trim(command_name)
426 end if
427 candidate_path = trim(candidate_buf)
428
429 if (is_executable_file(candidate_path)) then
430 full_path = trim(candidate_path)
431 found = .true.
432 return
433 end if
434
435 if (colon_pos == 0) exit
436 start_pos = start_pos + colon_pos
437 end do
438 end function
439
440 function is_executable_file(path) result(executable)
441 character(len=*), intent(in) :: path
442 logical :: executable
443
444 character(kind=c_char) :: c_path(len_trim(path) + 1)
445 integer :: i, status
446
447 ! Convert to C string
448 do i = 1, len_trim(path)
449 c_path(i) = path(i:i)
450 end do
451 c_path(len_trim(path) + 1) = c_null_char
452
453 ! Check if file exists and is executable
454 status = access_c(c_path, F_OK + X_OK)
455 executable = (status == 0)
456 end function
457
458 function is_shell_keyword(command_name) result(is_keyword)
459 character(len=*), intent(in) :: command_name
460 logical :: is_keyword
461
462 character(len=16), parameter :: keywords(20) = [ &
463 'if ', 'then ', 'else ', 'elif ', 'fi ', &
464 'for ', 'while ', 'until ', 'do ', 'done ', &
465 'case ', 'esac ', 'function ', 'select ', 'time ', &
466 'coproc ', '{ ', '} ', '! ', '[[ ' ]
467
468 integer :: i
469
470 is_keyword = .false.
471 do i = 1, size(keywords)
472 if (trim(command_name) == trim(keywords(i))) then
473 is_keyword = .true.
474 return
475 end if
476 end do
477 end function
478
479 function is_builtin_command(command_name) result(is_builtin)
480 character(len=*), intent(in) :: command_name
481 logical :: is_builtin
482
483 character(len=16), parameter :: builtins(56) = [ &
484 'cd ', 'pwd ', 'echo ', 'printf ', &
485 'read ', 'export ', 'unset ', 'set ', &
486 'shift ', 'test ', 'true ', 'false ', &
487 'exit ', 'return ', 'break ', 'continue ', &
488 'source ', '. ', 'eval ', 'exec ', &
489 'jobs ', 'fg ', 'bg ', 'kill ', &
490 'wait ', 'declare ', 'local ', 'readonly ', &
491 'alias ', 'unalias ', 'type ', 'command ', &
492 'hash ', 'trap ', 'umask ', 'ulimit ', &
493 'times ', 'let ', 'getopts ', 'fc ', &
494 'help ', 'defun ', 'abbr ', 'which ', &
495 'history ', 'shopt ', 'complete ', 'compgen ', &
496 'coproc ', 'printenv ', 'pushd ', 'popd ', &
497 'dirs ', 'prevd ', 'nextd ', 'dirh ' ]
498
499 integer :: i
500
501 is_builtin = .false.
502 do i = 1, size(builtins)
503 if (trim(command_name) == trim(builtins(i))) then
504 is_builtin = .true.
505 return
506 end if
507 end do
508 end function
509
510 function is_shell_function(shell, command_name) result(is_function)
511 use ast_executor, only: is_ast_function
512 type(shell_state_t), intent(in) :: shell
513 character(len=*), intent(in) :: command_name
514 logical :: is_function
515 integer :: i
516
517 is_function = .false.
518
519 ! Check old executor's function storage
520 do i = 1, shell%num_functions
521 if (trim(shell%functions(i)%name) == trim(command_name) .and. &
522 len_trim(shell%functions(i)%name) > 0) then
523 is_function = .true.
524 return
525 end if
526 end do
527
528 ! Also check AST executor's function cache
529 is_function = is_ast_function(command_name)
530 end function
531
532 function is_shell_alias(shell, command_name) result(is_alias)
533 type(shell_state_t), intent(in) :: shell
534 character(len=*), intent(in) :: command_name
535 logical :: is_alias
536 integer :: i
537
538 is_alias = .false.
539 do i = 1, shell%num_aliases
540 if (trim(shell%aliases(i)%name) == trim(command_name)) then
541 is_alias = .true.
542 return
543 end if
544 end do
545 end function
546
547 function find_command_full_path(command_name) result(full_path)
548 use system_interface, only: get_environment_var
549 character(len=*), intent(in) :: command_name
550 character(len=MAX_PATH_LEN) :: full_path
551 character(len=:), allocatable :: path_var_alloc
552 character(len=4096) :: path_var
553 character(len=:), allocatable :: path_component
554 character(len=MAX_PATH_LEN) :: candidate_buf
555 character(len=:), allocatable :: candidate_path
556 integer :: start_pos, end_pos, colon_pos
557
558 full_path = ''
559
560 ! If command contains '/', it's an absolute or relative path
561 if (index(command_name, '/') > 0) then
562 if (is_executable_file(command_name)) then
563 full_path = command_name
564 end if
565 return
566 end if
567
568 ! Get PATH environment variable
569 path_var_alloc = get_environment_var('PATH')
570 if (allocated(path_var_alloc)) then
571 path_var = path_var_alloc
572 else
573 path_var = '/usr/bin:/bin'
574 end if
575
576 if (len_trim(path_var) == 0) then
577 path_var = '/usr/bin:/bin'
578 end if
579
580 ! Search each directory in PATH
581 start_pos = 1
582 do while (start_pos <= len_trim(path_var))
583 colon_pos = index(path_var(start_pos:), ':')
584 if (colon_pos == 0) then
585 end_pos = len_trim(path_var)
586 else
587 end_pos = start_pos + colon_pos - 2
588 end if
589
590 path_component = path_var(start_pos:end_pos)
591 if (len_trim(path_component) == 0) then
592 path_component = '.'
593 end if
594
595 ! Construct full path
596 if (path_component(len_trim(path_component):len_trim(path_component)) == '/') then
597 write(candidate_buf, '(a,a)') trim(path_component), trim(command_name)
598 else
599 write(candidate_buf, '(a,a,a)') trim(path_component), '/', trim(command_name)
600 end if
601 candidate_path = trim(candidate_buf)
602
603 if (is_executable_file(candidate_path)) then
604 full_path = trim(candidate_path)
605 return
606 end if
607
608 if (colon_pos == 0) exit
609 start_pos = start_pos + colon_pos
610 end do
611 end function
612
613 end module command_builtin