nandi.uk
A structured-data shell in Gleam, inspired by Nushell
1%% Erlang FFI for gleshell: REPL I/O, cwd, env, external processes.
2-module(gleshell_ffi).
3-include_lib("kernel/include/file.hrl").
4-export([
5 get_line/1,
6 parse_line/2,
7 run_as_shell/1,
8 spawn_shell/2,
9 set_cwd/1,
10 get_cwd/0,
11 getenv/1,
12 setenv/2,
13 list_env/0,
14 run_cmd/2,
15 run_cmd_tty/2,
16 which/1,
17 which_all/1,
18 home_dir/0,
19 stdout_isatty/0,
20 println/1,
21 take_output_shown/0,
22 clear_output_shown/0
23]).
24
25-define(ESC, 16#1b).
26-define(CSI_CLEAR_EOL, "\e[K").
27-define(HISTORY_MAX, 2000).
28
29%% ---------------------------------------------------------------------------
30%% Public: write a line (CRLF in raw TTY mode so multi-line output does not
31%% staircase — raw mode does not map LF → CR+LF the way cooked mode does).
32%% ---------------------------------------------------------------------------
33
34-spec println(binary()) -> nil.
35println(Text) when is_binary(Text) ->
36 case get(gleshell_raw) of
37 true ->
38 io:put_chars([to_crlf(Text), <<"\r\n">>]),
39 nil;
40 _ ->
41 io:put_chars([Text, $\n]),
42 nil
43 end.
44
45%% Normalize newlines to CRLF without turning existing \r\n into \r\r\n.
46to_crlf(Bin) when is_binary(Bin) ->
47 B1 = binary:replace(Bin, <<"\r\n">>, <<"\n">>, [global]),
48 B2 = binary:replace(B1, <<"\r">>, <<"\n">>, [global]),
49 binary:replace(B2, <<"\n">>, <<"\r\n">>, [global]).
50
51%% ---------------------------------------------------------------------------
52%% Public: read a line (syntax-highlighted when raw TTY mode is active)
53%% ---------------------------------------------------------------------------
54
55-spec get_line(binary()) -> {ok, binary()} | {error, binary()}.
56get_line(Prompt) when is_binary(Prompt) ->
57 case get(gleshell_raw) of
58 true ->
59 raw_get_line(Prompt);
60 _ ->
61 classic_get_line(Prompt)
62 end.
63
64%% Edlin / get_until path (non-TTY or when raw mode unavailable).
65classic_get_line(Prompt) ->
66 PromptChars = unicode:characters_to_list(Prompt),
67 case io:request(
68 standard_io,
69 {get_until, unicode, PromptChars, ?MODULE, parse_line, []}
70 ) of
71 eof ->
72 {error, <<"eof">>};
73 {error, interrupted} ->
74 %% Ctrl+C while reading: cancel line, keep the REPL alive.
75 {error, <<"interrupted">>};
76 {error, _} ->
77 {error, <<"io_error">>};
78 Line when is_list(Line); is_binary(Line) ->
79 Bin = unicode:characters_to_binary(Line),
80 Stripped = string:trim(Bin, trailing, [$\n, $\r]),
81 {ok, Stripped};
82 Other ->
83 try
84 Bin = unicode:characters_to_binary(Other),
85 Stripped = string:trim(Bin, trailing, [$\n, $\r]),
86 {ok, Stripped}
87 catch
88 _:_ ->
89 {error, <<"io_error">>}
90 end
91 end.
92
93%% get_until callback: edlin already gathers a full line.
94-spec parse_line(term(), term()) ->
95 {done, eof | string(), list()} | {more, term()}.
96parse_line(_Cont, eof) ->
97 {done, eof, []};
98parse_line(_Cont, Chars) when is_list(Chars) ->
99 {done, Chars, []}.
100
101%% ---------------------------------------------------------------------------
102%% Shell bootstrap: prefer OTP raw mode for live syntax highlighting.
103%% Falls back to edlin interactive shell when raw is unavailable.
104%%
105%% Ctrl+C: the BEAM default opens the BREAK menu (a = abort → process exit).
106%% Re-exec once with +Bc so Ctrl+C is delivered as a character to our editor
107%% (cancel line) instead of killing the shell. See erl(1) +B.
108%% ---------------------------------------------------------------------------
109
110-spec run_as_shell(fun(() -> term())) -> nil.
111run_as_shell(Fun) when is_function(Fun, 0) ->
112 case ensure_plus_bc() of
113 {parent, Port} ->
114 %% Child owns the TTY; we only wait for its exit status.
115 receive
116 {Port, {exit_status, Status}} ->
117 erlang:halt(Status)
118 end;
119 child ->
120 enable_shell_history(),
121 case try_start_raw() of
122 true ->
123 put(gleshell_raw, true),
124 load_line_history(),
125 configure_line_editor(),
126 try
127 Fun()
128 after
129 save_line_history()
130 end,
131 nil;
132 false ->
133 erase(gleshell_raw),
134 Parent = self(),
135 case try_start_interactive(Parent, Fun) of
136 {ok, started} ->
137 receive
138 {gleshell_shell_done, ok} ->
139 nil;
140 {gleshell_shell_done, {error, Class, Reason, Stack}} ->
141 erlang:raise(Class, Reason, Stack)
142 end;
143 {ok, direct} ->
144 configure_line_editor(),
145 Fun(),
146 nil
147 end
148 end
149 end.
150
151%% Ensure the emulator was started with +Bc (Ctrl+C → char, not BREAK/abort).
152%% Returns `child` when this process should run the REPL, or `{parent, Port}`
153%% when we re-exec'd and should wait on the child.
154-spec ensure_plus_bc() -> child | {parent, port()}.
155ensure_plus_bc() ->
156 case os:getenv("GLESHELL_PLUS_BC") of
157 "1" ->
158 child;
159 _ ->
160 case already_has_plus_bc() of
161 true ->
162 os:putenv("GLESHELL_PLUS_BC", "1"),
163 child;
164 false ->
165 reexec_with_plus_bc()
166 end
167 end.
168
169already_has_plus_bc() ->
170 lists:any(
171 fun(Var) ->
172 case os:getenv(Var) of
173 false ->
174 false;
175 Flags ->
176 string:find(Flags, "+Bc") =/= nomatch
177 end
178 end,
179 ["ERL_AFLAGS", "ERL_FLAGS", "ERL_ZFLAGS"]
180 ).
181
182reexec_with_plus_bc() ->
183 os:putenv("GLESHELL_PLUS_BC", "1"),
184 case os:getenv("ERL_AFLAGS") of
185 false ->
186 os:putenv("ERL_AFLAGS", "+Bc");
187 Flags ->
188 case string:find(Flags, "+Bc") of
189 nomatch ->
190 os:putenv("ERL_AFLAGS", "+Bc " ++ Flags);
191 _ ->
192 ok
193 end
194 end,
195 case os:find_executable("erl") of
196 false ->
197 %% No erl on PATH — continue without +Bc (BREAK menu may appear).
198 child;
199 Erl ->
200 Pa = lists:flatmap(fun(D) -> ["-pa", D] end, code:get_path()),
201 Extra = init:get_plain_arguments(),
202 Args =
203 ["+Bc", "-noshell"] ++
204 Pa ++
205 ["-eval", "gleshell@@main:run(gleshell)", "-extra" | Extra],
206 try
207 Port = open_port(
208 {spawn_executable, Erl},
209 [exit_status, nouse_stdio, {args, Args}]
210 ),
211 {parent, Port}
212 catch
213 _:_ ->
214 child
215 end
216 end.
217
218try_start_raw() ->
219 case stdout_isatty() of
220 false ->
221 false;
222 true ->
223 case catch shell:start_interactive({noshell, raw}) of
224 ok ->
225 true;
226 {error, already_started} ->
227 %% Cannot switch an existing interactive shell into raw.
228 false;
229 _ ->
230 false
231 end
232 end.
233
234try_start_interactive(Parent, Fun) ->
235 _ = application:set_env(stdlib, shell_slogan, "", [{persistent, true}]),
236 case shell:start_interactive({gleshell_ffi, spawn_shell, [Parent, Fun]}) of
237 ok ->
238 {ok, started};
239 {error, already_started} ->
240 {ok, direct};
241 {error, _} ->
242 {ok, direct}
243 end.
244
245-spec spawn_shell(pid(), fun(() -> term())) -> pid().
246spawn_shell(Parent, Fun) when is_pid(Parent), is_function(Fun, 0) ->
247 spawn(fun() ->
248 try
249 configure_line_editor(),
250 Fun()
251 of
252 _ ->
253 Parent ! {gleshell_shell_done, ok},
254 exit(die)
255 catch
256 Class:Reason:Stack ->
257 Parent ! {gleshell_shell_done, {error, Class, Reason, Stack}},
258 erlang:raise(Class, Reason, Stack)
259 end
260 end).
261
262configure_line_editor() ->
263 _ = io:setopts([{encoding, unicode}, binary]),
264 try
265 io:setopts([{line_history, true}])
266 catch
267 _:_ ->
268 ok
269 end,
270 ok.
271
272enable_shell_history() ->
273 case application:get_env(kernel, shell_history_path) of
274 {ok, _} ->
275 ok;
276 undefined ->
277 Path = filename:basedir(user_cache, "gleshell-history"),
278 _ = application:set_env(
279 kernel, shell_history_path, Path, [{persistent, true}]
280 ),
281 ok
282 end,
283 case application:get_env(kernel, shell_history) of
284 {ok, _} ->
285 ok;
286 undefined ->
287 _ = application:set_env(
288 kernel, shell_history, enabled, [{persistent, true}]
289 ),
290 ok
291 end.
292
293%% ---------------------------------------------------------------------------
294%% Raw-mode line editor with Nushell-style syntax highlighting
295%% ---------------------------------------------------------------------------
296%%
297%% Buffer model: Left is graphemes before the cursor (reversed),
298%% Right is graphemes after the cursor (normal order).
299%% History is a list of binaries (newest first).
300
301raw_get_line(Prompt) when is_binary(Prompt) ->
302 PromptList = unicode:characters_to_list(Prompt),
303 History = case get(gleshell_history) of
304 L when is_list(L) -> L;
305 _ -> []
306 end,
307 redraw(PromptList, [], []),
308 raw_loop(PromptList, [], [], History, 0, <<>>).
309
310%% HistPos: 0 = editing current buffer; N>0 = viewing Nth history entry.
311%% Saved: buffer saved when first entering history navigation.
312raw_loop(Prompt, Left, Right, History, HistPos, Saved) ->
313 case read_key() of
314 eof ->
315 io:put_chars("\r\n"),
316 {error, <<"eof">>};
317 {error, _} ->
318 io:put_chars("\r\n"),
319 {error, <<"io_error">>};
320 enter ->
321 Line = buffer_to_bin(Left, Right),
322 io:put_chars("\r\n"),
323 push_history(Line),
324 {ok, Line};
325 {char, C} when is_integer(C), C >= 32, C =/= 127 ->
326 %% Printable Unicode codepoint
327 NewLeft = [C | Left],
328 redraw(Prompt, NewLeft, Right),
329 raw_loop(Prompt, NewLeft, Right, History, 0, <<>>);
330 backspace ->
331 case Left of
332 [] ->
333 raw_loop(Prompt, Left, Right, History, HistPos, Saved);
334 [_ | Rest] ->
335 redraw(Prompt, Rest, Right),
336 raw_loop(Prompt, Rest, Right, History, 0, <<>>)
337 end;
338 delete ->
339 case Right of
340 [] ->
341 raw_loop(Prompt, Left, Right, History, HistPos, Saved);
342 [_ | Rest] ->
343 redraw(Prompt, Left, Rest),
344 raw_loop(Prompt, Left, Rest, History, 0, <<>>)
345 end;
346 left ->
347 case Left of
348 [] ->
349 raw_loop(Prompt, Left, Right, History, HistPos, Saved);
350 [C | Rest] ->
351 redraw(Prompt, Rest, [C | Right]),
352 raw_loop(Prompt, Rest, [C | Right], History, HistPos, Saved)
353 end;
354 right ->
355 case Right of
356 [] ->
357 raw_loop(Prompt, Left, Right, History, HistPos, Saved);
358 [C | Rest] ->
359 redraw(Prompt, [C | Left], Rest),
360 raw_loop(Prompt, [C | Left], Rest, History, HistPos, Saved)
361 end;
362 home ->
363 NewRight = lists:reverse(Left) ++ Right,
364 redraw(Prompt, [], NewRight),
365 raw_loop(Prompt, [], NewRight, History, HistPos, Saved);
366 'end' ->
367 NewLeft = lists:reverse(Right) ++ Left,
368 redraw(Prompt, NewLeft, []),
369 raw_loop(Prompt, NewLeft, [], History, HistPos, Saved);
370 up ->
371 hist_nav(Prompt, Left, Right, History, HistPos, Saved, 1);
372 down ->
373 hist_nav(Prompt, Left, Right, History, HistPos, Saved, -1);
374 ctrl_a ->
375 NewRight = lists:reverse(Left) ++ Right,
376 redraw(Prompt, [], NewRight),
377 raw_loop(Prompt, [], NewRight, History, HistPos, Saved);
378 ctrl_e ->
379 NewLeft = lists:reverse(Right) ++ Left,
380 redraw(Prompt, NewLeft, []),
381 raw_loop(Prompt, NewLeft, [], History, HistPos, Saved);
382 ctrl_u ->
383 redraw(Prompt, [], Right),
384 raw_loop(Prompt, [], Right, History, 0, <<>>);
385 ctrl_k ->
386 redraw(Prompt, Left, []),
387 raw_loop(Prompt, Left, [], History, 0, <<>>);
388 ctrl_w ->
389 {NewLeft, _} = kill_word(Left),
390 redraw(Prompt, NewLeft, Right),
391 raw_loop(Prompt, NewLeft, Right, History, 0, <<>>);
392 ctrl_d ->
393 case {Left, Right} of
394 {[], []} ->
395 io:put_chars("\r\n"),
396 {error, <<"eof">>};
397 {_, []} ->
398 raw_loop(Prompt, Left, Right, History, HistPos, Saved);
399 {_, [_ | Rest]} ->
400 redraw(Prompt, Left, Rest),
401 raw_loop(Prompt, Left, Rest, History, 0, <<>>)
402 end;
403 ctrl_c ->
404 %% Cancel current line (like bash) and return empty.
405 io:put_chars("^C\r\n"),
406 {ok, <<>>};
407 ctrl_l ->
408 io:put_chars("\e[H\e[2J"),
409 redraw(Prompt, Left, Right),
410 raw_loop(Prompt, Left, Right, History, HistPos, Saved);
411 ctrl_r ->
412 reverse_search(Prompt, History);
413 tab ->
414 tab_complete(Prompt, Left, Right, History, HistPos, Saved);
415 _Other ->
416 raw_loop(Prompt, Left, Right, History, HistPos, Saved)
417 end.
418
419%% ---------------------------------------------------------------------------
420%% Tab: filename completion (path under cursor)
421%% ---------------------------------------------------------------------------
422%%
423%% Completes the token before the cursor as a filesystem path.
424%% One match → insert it (directories get a trailing /).
425%% Several matches → extend the longest common prefix; if that does not
426%% advance the buffer, list candidates under the line and redraw.
427
428tab_complete(Prompt, Left, Right, History, HistPos, Saved) ->
429 {PrefixRev, Word} = word_before_cursor(Left),
430 case filename_completions(Word) of
431 [] ->
432 beep(),
433 raw_loop(Prompt, Left, Right, History, HistPos, Saved);
434 [Only] ->
435 NewLeft = apply_completed_word(PrefixRev, Only),
436 redraw(Prompt, NewLeft, Right),
437 raw_loop(Prompt, NewLeft, Right, History, 0, <<>>);
438 Matches ->
439 Common = longest_common_prefix(Matches),
440 case Common =/= Word andalso length(Common) >= length(Word) of
441 true ->
442 NewLeft = apply_completed_word(PrefixRev, Common),
443 redraw(Prompt, NewLeft, Right),
444 raw_loop(Prompt, NewLeft, Right, History, 0, <<>>);
445 false ->
446 show_completions(Matches),
447 redraw(Prompt, Left, Right),
448 raw_loop(Prompt, Left, Right, History, HistPos, Saved)
449 end
450 end.
451
452beep() ->
453 io:put_chars([7]).
454
455%% Left is graphemes before the cursor in reverse order.
456%% Returns {PrefixRev, WordForward} where Word is the path token.
457word_before_cursor(Left) ->
458 take_completion_word(Left, []).
459
460%% Acc: walking Left (reversed buffer) with [C|Acc] rebuilds the word forward.
461take_completion_word([], Acc) ->
462 {[], Acc};
463take_completion_word([C | Rest], Acc) ->
464 case is_completion_break(C) of
465 true ->
466 {[C | Rest], Acc};
467 false ->
468 take_completion_word(Rest, [C | Acc])
469 end.
470
471is_completion_break(C) when C =:= $\s; C =:= $\t ->
472 true;
473is_completion_break(C) when C =:= $|; C =:= $;; C =:= $& ->
474 true;
475is_completion_break(C) when C =:= $(; C =:= $); C =:= $[; C =:= $] ->
476 true;
477is_completion_break(C) when C =:= ${; C =:= $}; C =:= $<; C =:= $> ->
478 true;
479is_completion_break(C) when C =:= $'; C =:= $" ->
480 true;
481is_completion_break(_) ->
482 false.
483
484apply_completed_word(PrefixRev, Word) ->
485 lists:reverse(Word) ++ PrefixRev.
486
487%% Return sorted completion strings (as typed, with ~ preserved; dirs end in /).
488filename_completions(Word) ->
489 {ListDirTyped, Base, InsertPrefix} = split_completion_word(Word),
490 ListDir = expand_home_path(ListDirTyped),
491 case file:list_dir(ListDir) of
492 {ok, Names0} ->
493 Names = lists:sort(Names0),
494 [
495 InsertPrefix ++ maybe_dir_slash(ListDir, Name)
496 || Name <- Names,
497 lists:prefix(Base, Name),
498 show_dotfile(Base, Name)
499 ];
500 {error, _} ->
501 []
502 end.
503
504%% Hide dotfiles unless the partial name already starts with '.'.
505show_dotfile([$. | _], _) ->
506 true;
507show_dotfile(_, [$. | _]) ->
508 false;
509show_dotfile(_, _) ->
510 true.
511
512maybe_dir_slash(ListDir, Name) ->
513 case filelib:is_dir(filename:join(ListDir, Name)) of
514 true -> Name ++ "/";
515 false -> Name
516 end.
517
518%% Split a path word into {dir_to_list, basename_prefix, insert_prefix}.
519%% insert_prefix is the directory part as the user typed it (incl. trailing /).
520split_completion_word(Word) ->
521 case rsplit_path(Word) of
522 {none, Base} ->
523 {".", Base, ""};
524 {Dir, Base} ->
525 ListDir =
526 case Dir of
527 "" -> "/";
528 _ -> Dir
529 end,
530 InsertPrefix =
531 case Dir of
532 "" -> "/";
533 _ -> Dir ++ "/"
534 end,
535 {ListDir, Base, InsertPrefix}
536 end.
537
538%% Rightmost / splits directory from the partial basename.
539rsplit_path(Word) ->
540 rsplit_path(lists:reverse(Word), []).
541
542rsplit_path([], Acc) ->
543 {none, Acc};
544rsplit_path([$/ | Rest], Acc) ->
545 {lists:reverse(Rest), Acc};
546rsplit_path([C | Rest], Acc) ->
547 rsplit_path(Rest, [C | Acc]).
548
549expand_home_path(Path) ->
550 case Path of
551 "~" ->
552 home_path_string();
553 [$~, $/ | More] ->
554 home_path_string() ++ "/" ++ More;
555 _ ->
556 Path
557 end.
558
559home_path_string() ->
560 case os:getenv("HOME") of
561 false -> ".";
562 Home when is_list(Home) -> Home;
563 Home when is_binary(Home) -> unicode:characters_to_list(Home)
564 end.
565
566longest_common_prefix([]) ->
567 "";
568longest_common_prefix([H | T]) ->
569 lists:foldl(fun lcp2/2, H, T).
570
571lcp2(A, B) ->
572 lcp2(A, B, []).
573
574lcp2([X | As], [X | Bs], Acc) ->
575 lcp2(As, Bs, [X | Acc]);
576lcp2(_, _, Acc) ->
577 lists:reverse(Acc).
578
579show_completions(Matches) ->
580 io:put_chars("\r\n"),
581 case io:columns() of
582 {ok, Cols} when is_integer(Cols), Cols > 8 ->
583 print_completion_columns(Matches, Cols);
584 _ ->
585 io:put_chars(lists:join(" ", Matches)),
586 io:put_chars("\r\n")
587 end.
588
589print_completion_columns(Matches, Cols) ->
590 MaxLen = lists:max([0 | [length(M) || M <- Matches]]),
591 Width = MaxLen + 2,
592 PerRow = max(1, Cols div Width),
593 print_rows(Matches, PerRow, Width).
594
595print_rows([], _PerRow, _Width) ->
596 ok;
597print_rows(Matches, PerRow, Width) ->
598 {Row, Rest} = take_n(Matches, PerRow, []),
599 Line = [
600 pad_cell(M, Width)
601 || M <- Row
602 ],
603 io:put_chars([Line, "\r\n"]),
604 print_rows(Rest, PerRow, Width).
605
606take_n(List, 0, Acc) ->
607 {lists:reverse(Acc), List};
608take_n([], _N, Acc) ->
609 {lists:reverse(Acc), []};
610take_n([H | T], N, Acc) ->
611 take_n(T, N - 1, [H | Acc]).
612
613pad_cell(S, Width) ->
614 Pad = Width - length(S),
615 case Pad > 0 of
616 true -> S ++ lists:duplicate(Pad, $\s);
617 false -> S ++ " "
618 end.
619
620hist_nav(Prompt, Left, Right, History, HistPos, Saved, Delta) ->
621 NewPos = HistPos + Delta,
622 Len = length(History),
623 if
624 NewPos < 0 ->
625 raw_loop(Prompt, Left, Right, History, HistPos, Saved);
626 NewPos =:= 0 ->
627 %% Restore saved draft
628 {L, R} = bin_to_buffer(Saved),
629 redraw(Prompt, L, R),
630 raw_loop(Prompt, L, R, History, 0, <<>>);
631 NewPos > Len ->
632 raw_loop(Prompt, Left, Right, History, HistPos, Saved);
633 true ->
634 NewSaved = case HistPos of
635 0 -> buffer_to_bin(Left, Right);
636 _ -> Saved
637 end,
638 Entry = lists:nth(NewPos, History),
639 {L, R} = bin_to_buffer(Entry),
640 redraw(Prompt, L, R),
641 raw_loop(Prompt, L, R, History, NewPos, NewSaved)
642 end.
643
644%% Minimal Ctrl+R reverse-i-search over history.
645reverse_search(Prompt, History) ->
646 reverse_search_loop(Prompt, History, [], match_history(History, [])).
647
648reverse_search_loop(Prompt, History, Query, Match) ->
649 Hint = unicode:characters_to_list(
650 ["(reverse-i-search)`", Query, "': ", Match]
651 ),
652 io:put_chars([$\r, Hint, ?CSI_CLEAR_EOL]),
653 case read_key() of
654 eof ->
655 io:put_chars("\r\n"),
656 {error, <<"eof">>};
657 enter ->
658 %% Accept match onto the edit line; do not submit (edit first).
659 Line = iolist_to_binary(Match),
660 {L, R} = bin_to_buffer(Line),
661 redraw(Prompt, L, R),
662 raw_loop(Prompt, L, R, History, 0, <<>>);
663 ctrl_c ->
664 io:put_chars("\r\n"),
665 redraw(Prompt, [], []),
666 raw_loop(Prompt, [], [], History, 0, <<>>);
667 ctrl_g ->
668 redraw(Prompt, [], []),
669 raw_loop(Prompt, [], [], History, 0, <<>>);
670 ctrl_r ->
671 %% Find older match
672 NewMatch = match_history_after(History, Query, Match),
673 reverse_search_loop(Prompt, History, Query, NewMatch);
674 backspace ->
675 NewQuery = case Query of
676 [] -> [];
677 [_ | _] -> lists:droplast(Query)
678 end,
679 reverse_search_loop(
680 Prompt, History, NewQuery, match_history(History, NewQuery)
681 );
682 {char, C} when is_integer(C), C >= 32, C =/= 127 ->
683 NewQuery = Query ++ [C],
684 reverse_search_loop(
685 Prompt, History, NewQuery, match_history(History, NewQuery)
686 );
687 _ ->
688 reverse_search_loop(Prompt, History, Query, Match)
689 end.
690
691match_history(_History, []) ->
692 "";
693match_history(History, Query) ->
694 QBin = unicode:characters_to_binary(Query),
695 case first_match(History, QBin) of
696 undefined -> "";
697 Bin -> unicode:characters_to_list(Bin)
698 end.
699
700match_history_after(History, Query, CurrentMatch) ->
701 QBin = unicode:characters_to_binary(Query),
702 CurBin = unicode:characters_to_binary(CurrentMatch),
703 case skip_until_then_match(History, CurBin, QBin, false) of
704 undefined -> CurrentMatch;
705 Bin -> unicode:characters_to_list(Bin)
706 end.
707
708first_match([], _) ->
709 undefined;
710first_match([H | T], Q) ->
711 case binary:match(H, Q) of
712 nomatch -> first_match(T, Q);
713 _ -> H
714 end.
715
716skip_until_then_match([], _Cur, _Q, _Seen) ->
717 undefined;
718skip_until_then_match([H | T], Cur, Q, false) ->
719 case H =:= Cur of
720 true -> skip_until_then_match(T, Cur, Q, true);
721 false -> skip_until_then_match(T, Cur, Q, false)
722 end;
723skip_until_then_match([H | T], Cur, Q, true) ->
724 case binary:match(H, Q) of
725 nomatch -> skip_until_then_match(T, Cur, Q, true);
726 _ -> H
727 end.
728
729kill_word([]) ->
730 {[], []};
731kill_word(Left) ->
732 %% Left is reversed: strip trailing spaces then a word.
733 L1 = drop_while_space(Left),
734 drop_while_word(L1).
735
736drop_while_space([C | Rest]) when C =:= $\s; C =:= $\t ->
737 drop_while_space(Rest);
738drop_while_space(L) ->
739 L.
740
741drop_while_word([]) ->
742 {[], []};
743drop_while_word([C | Rest]) when C =:= $\s; C =:= $\t ->
744 {[C | Rest], []};
745drop_while_word([_ | Rest]) ->
746 drop_while_word(Rest).
747
748redraw(Prompt, Left, Right) ->
749 Full = lists:reverse(Left) ++ Right,
750 FullBin = unicode:characters_to_binary(Full),
751 Colored = highlight_line(FullBin),
752 io:put_chars([$\r, Prompt, Colored, ?CSI_CLEAR_EOL]),
753 case length(Right) of
754 0 ->
755 ok;
756 N ->
757 io:put_chars(["\e[", integer_to_list(N), $D])
758 end.
759
760highlight_line(Bin) when is_binary(Bin) ->
761 case get(gleshell_color) of
762 false ->
763 Bin;
764 _ ->
765 try
766 case 'gleshell@highlight':line(Bin) of
767 Out when is_binary(Out) -> Out;
768 Out when is_list(Out) -> unicode:characters_to_binary(Out);
769 _ -> Bin
770 end
771 catch
772 _:_ ->
773 Bin
774 end
775 end.
776
777buffer_to_bin(Left, Right) ->
778 unicode:characters_to_binary(lists:reverse(Left) ++ Right).
779
780bin_to_buffer(Bin) when is_binary(Bin) ->
781 Chars = unicode:characters_to_list(Bin),
782 {lists:reverse(Chars), []};
783bin_to_buffer(List) when is_list(List) ->
784 {lists:reverse(List), []}.
785
786%% ---------------------------------------------------------------------------
787%% Key reading (raw mode — keys arrive as soon as pressed)
788%% ---------------------------------------------------------------------------
789
790read_key() ->
791 case io:get_chars("", 1) of
792 eof ->
793 eof;
794 {error, Reason} ->
795 {error, Reason};
796 <<C/utf8>> ->
797 decode_key(C, <<>>);
798 [C] when is_integer(C) ->
799 decode_key(C, <<>>);
800 Bin when is_binary(Bin), byte_size(Bin) > 0 ->
801 case unicode:characters_to_list(Bin) of
802 [C | _] -> decode_key(C, <<>>);
803 _ -> read_key()
804 end;
805 List when is_list(List), List =/= [] ->
806 decode_key(hd(List), <<>>);
807 _ ->
808 read_key()
809 end.
810
811decode_key($\r, _) -> enter;
812decode_key($\n, _) -> enter;
813decode_key($\t, _) -> tab;
814decode_key(127, _) -> backspace;
815decode_key($\b, _) -> backspace;
816decode_key(1, _) -> ctrl_a;
817decode_key(5, _) -> ctrl_e;
818decode_key(4, _) -> ctrl_d;
819decode_key(3, _) -> ctrl_c;
820decode_key(11, _) -> ctrl_k;
821decode_key(21, _) -> ctrl_u;
822decode_key(23, _) -> ctrl_w;
823decode_key(12, _) -> ctrl_l;
824decode_key(18, _) -> ctrl_r;
825decode_key(?ESC, _) ->
826 read_escape();
827decode_key(C, _) when is_integer(C), C >= 32 ->
828 {char, C};
829decode_key(_, _) ->
830 other.
831
832read_escape() ->
833 case io:get_chars("", 1) of
834 eof ->
835 other;
836 <<"[">> ->
837 read_csi();
838 <<$O>> ->
839 %% SS3 sequences: OH = home, OF = end, OA/OB/OC/OD arrows
840 case io:get_chars("", 1) of
841 <<"A">> -> up;
842 <<"B">> -> down;
843 <<"C">> -> right;
844 <<"D">> -> left;
845 <<"H">> -> home;
846 <<"F">> -> 'end';
847 _ -> other
848 end;
849 _ ->
850 other
851 end.
852
853read_csi() ->
854 read_csi_params([]).
855
856read_csi_params(Acc) ->
857 case io:get_chars("", 1) of
858 eof ->
859 other;
860 <<C/utf8>> when C >= $0, C =< $9 ->
861 read_csi_params([C | Acc]);
862 <<$;>> ->
863 read_csi_params([$; | Acc]);
864 <<$~>> ->
865 Params = lists:reverse(Acc),
866 case Params of
867 "1" -> home;
868 "3" -> delete;
869 "4" -> 'end';
870 "7" -> home;
871 "8" -> 'end';
872 _ -> other
873 end;
874 <<"A">> ->
875 up;
876 <<"B">> ->
877 down;
878 <<"C">> ->
879 right;
880 <<"D">> ->
881 left;
882 <<"H">> ->
883 home;
884 <<"F">> ->
885 'end';
886 _ ->
887 other
888 end.
889
890%% ---------------------------------------------------------------------------
891%% History persistence
892%% ---------------------------------------------------------------------------
893
894history_file() ->
895 case application:get_env(kernel, shell_history_path) of
896 {ok, Path} when is_list(Path) ->
897 filename:join(Path, "lines");
898 {ok, Path} when is_binary(Path) ->
899 filename:join(unicode:characters_to_list(Path), "lines");
900 _ ->
901 filename:join(
902 filename:basedir(user_cache, "gleshell-history"), "lines"
903 )
904 end.
905
906load_line_history() ->
907 File = history_file(),
908 case file:read_file(File) of
909 {ok, Bin} ->
910 Lines = [
911 L
912 || L <- binary:split(Bin, <<"\n">>, [global]),
913 L =/= <<>>
914 ],
915 %% Newest first
916 put(gleshell_history, lists:reverse(Lines));
917 _ ->
918 put(gleshell_history, [])
919 end,
920 put(gleshell_color, true),
921 ok.
922
923save_line_history() ->
924 case get(gleshell_history) of
925 Hist when is_list(Hist) ->
926 File = history_file(),
927 _ = filelib:ensure_dir(File),
928 %% Store oldest-first for human readability
929 Body = [[L, $\n] || L <- lists:reverse(lists:sublist(Hist, ?HISTORY_MAX))],
930 _ = file:write_file(File, Body),
931 ok;
932 _ ->
933 ok
934 end.
935
936push_history(<<>>) ->
937 ok;
938push_history(Line) when is_binary(Line) ->
939 Hist = case get(gleshell_history) of
940 L when is_list(L) -> L;
941 _ -> []
942 end,
943 New = case Hist of
944 [Line | _] -> Hist;
945 _ -> [Line | Hist]
946 end,
947 put(gleshell_history, lists:sublist(New, ?HISTORY_MAX)),
948 ok.
949
950%% ---------------------------------------------------------------------------
951%% OS / process helpers
952%% ---------------------------------------------------------------------------
953
954-spec set_cwd(binary()) -> {ok, nil} | {error, binary()}.
955set_cwd(Path) when is_binary(Path) ->
956 case file:set_cwd(unicode:characters_to_list(Path)) of
957 ok ->
958 {ok, nil};
959 {error, Reason} ->
960 {error, reason_to_bin(Reason)}
961 end.
962
963-spec get_cwd() -> {ok, binary()} | {error, binary()}.
964get_cwd() ->
965 case file:get_cwd() of
966 {ok, Dir} ->
967 {ok, unicode:characters_to_binary(Dir)};
968 {error, Reason} ->
969 {error, reason_to_bin(Reason)}
970 end.
971
972-spec getenv(binary()) -> {ok, binary()} | {error, nil}.
973getenv(Name) when is_binary(Name) ->
974 case os:getenv(unicode:characters_to_list(Name)) of
975 false ->
976 {error, nil};
977 Value ->
978 {ok, unicode:characters_to_binary(Value)}
979 end.
980
981-spec setenv(binary(), binary()) -> {ok, nil}.
982setenv(Name, Value) when is_binary(Name), is_binary(Value) ->
983 os:putenv(unicode:characters_to_list(Name), unicode:characters_to_list(Value)),
984 {ok, nil}.
985
986%% All process environment variables as a list of {Name, Value} binaries.
987-spec list_env() -> list({binary(), binary()}).
988list_env() ->
989 lists:map(
990 fun(Entry) ->
991 case string:split(Entry, "=", leading) of
992 [K, V] ->
993 {unicode:characters_to_binary(K), unicode:characters_to_binary(V)};
994 [K] ->
995 {unicode:characters_to_binary(K), <<>>};
996 _ ->
997 {<<>>, <<>>}
998 end
999 end,
1000 os:getenv()
1001 ).
1002
1003-spec which(binary()) -> {ok, binary()} | {error, nil}.
1004which(Command) when is_binary(Command) ->
1005 case which_all(Command) of
1006 [Path | _] ->
1007 {ok, Path};
1008 [] ->
1009 {error, nil}
1010 end.
1011
1012%% All matching executables on PATH (or the path itself if absolute/relative).
1013%% Order matches PATH search; duplicates from the same resolved path are dropped.
1014-spec which_all(binary()) -> [binary()].
1015which_all(Command) when is_binary(Command) ->
1016 Cmd = unicode:characters_to_list(Command),
1017 case Cmd of
1018 [] ->
1019 [];
1020 _ ->
1021 case has_path_sep(Cmd) of
1022 true ->
1023 case is_executable_file(Cmd) of
1024 true ->
1025 [unicode:characters_to_binary(filename:absname(Cmd))];
1026 false ->
1027 []
1028 end;
1029 false ->
1030 case os:getenv("PATH") of
1031 false ->
1032 [];
1033 PathStr ->
1034 Dirs = string:tokens(PathStr, path_sep()),
1035 find_all_in_path(Cmd, Dirs, #{}, [])
1036 end
1037 end
1038 end.
1039
1040path_sep() ->
1041 case os:type() of
1042 {win32, _} -> ";";
1043 _ -> ":"
1044 end.
1045
1046has_path_sep(Cmd) ->
1047 lists:member($/, Cmd) orelse lists:member($\\, Cmd).
1048
1049find_all_in_path(_Cmd, [], _Seen, Acc) ->
1050 lists:reverse(Acc);
1051find_all_in_path(Cmd, [Dir | Rest], Seen, Acc) ->
1052 File = filename:join(Dir, Cmd),
1053 case is_executable_file(File) of
1054 true ->
1055 Abs = filename:absname(File),
1056 Bin = unicode:characters_to_binary(Abs),
1057 case maps:is_key(Abs, Seen) of
1058 true ->
1059 find_all_in_path(Cmd, Rest, Seen, Acc);
1060 false ->
1061 find_all_in_path(Cmd, Rest, Seen#{Abs => true}, [Bin | Acc])
1062 end;
1063 false ->
1064 find_all_in_path(Cmd, Rest, Seen, Acc)
1065 end.
1066
1067is_executable_file(Path) ->
1068 case file:read_file_info(Path) of
1069 {ok, #file_info{type = regular, mode = Mode}} ->
1070 %% Any execute bit (owner/group/other).
1071 (Mode band 8#111) =/= 0;
1072 _ ->
1073 false
1074 end.
1075
1076-spec home_dir() -> {ok, binary()} | {error, binary()}.
1077home_dir() ->
1078 case os:getenv("HOME") of
1079 false ->
1080 {error, <<"HOME not set">>};
1081 Home ->
1082 {ok, unicode:characters_to_binary(Home)}
1083 end.
1084
1085-spec stdout_isatty() -> boolean().
1086stdout_isatty() ->
1087 case io:columns() of
1088 {ok, _} ->
1089 true;
1090 _ ->
1091 try
1092 case prim_tty:isatty(stdout) of
1093 true -> true;
1094 _ -> false
1095 end
1096 catch
1097 _:_ ->
1098 false
1099 end
1100 end.
1101
1102%% ---------------------------------------------------------------------------
1103%% External commands
1104%%
1105%% Two modes:
1106%%
1107%% 1. `run_cmd/2` — capture stdout/stderr into a binary (pipelines, `let x =`,
1108%% non-TTY). Uses pipes; the child does NOT get a real terminal.
1109%%
1110%% 2. `run_cmd_tty/2` — foreground interactive. The child inherits the real
1111%% stdio FDs (`nouse_stdio`) so pagers (`less`), editors (`vim`), and most
1112%% TUI tools work. BEAM only waits on exit status; keys go straight to the
1113%% child (no broken PTY byte-relay).
1114%%
1115%% Auth tools (`sudo`, `run0`, …) need a *controlling* TTY; erl_child_setup
1116%% calls setsid, so plain inherit is not enough. For those we wrap with
1117%% util-linux `script` to allocate a PTY and relay keys via `io:get_chars`
1118%% (same path as the raw line editor — a competing file:read on /dev/pts
1119%% never sees keypresses while prim_tty owns the device).
1120%% ---------------------------------------------------------------------------
1121
1122-spec run_cmd(binary(), [binary()]) -> {ok, {integer(), binary()}} | {error, binary()}.
1123run_cmd(Command, Args) when is_binary(Command), is_list(Args) ->
1124 case resolve_cmd(Command, Args) of
1125 {error, _} = E ->
1126 E;
1127 {ok, Path, PortArgs} ->
1128 try
1129 run_cmd_capture(Path, PortArgs)
1130 catch
1131 _:Reason ->
1132 {error, reason_to_bin(Reason)}
1133 end
1134 end.
1135
1136%% Foreground interactive: inherit TTY when possible.
1137-spec run_cmd_tty(binary(), [binary()]) -> {ok, {integer(), binary()}} | {error, binary()}.
1138run_cmd_tty(Command, Args) when is_binary(Command), is_list(Args) ->
1139 case resolve_cmd(Command, Args) of
1140 {error, _} = E ->
1141 E;
1142 {ok, Path, PortArgs} ->
1143 try
1144 case stdout_isatty() of
1145 false ->
1146 run_cmd_capture(Path, PortArgs);
1147 true ->
1148 case {needs_controlling_tty(Path), os:find_executable("script"), find_tty_path()} of
1149 {true, Script, {ok, Tty}} when is_list(Script) ->
1150 run_cmd_pty(Script, Path, PortArgs, Tty);
1151 _ ->
1152 run_cmd_inherit(Path, PortArgs)
1153 end
1154 end
1155 catch
1156 _:Reason ->
1157 {error, reason_to_bin(Reason)}
1158 end
1159 end.
1160
1161resolve_cmd(Command, Args) ->
1162 case os:find_executable(unicode:characters_to_list(Command)) of
1163 false ->
1164 {error, <<"command not found: ", Command/binary>>};
1165 Path ->
1166 PortArgs = [unicode:characters_to_list(A) || A <- Args],
1167 {ok, Path, PortArgs}
1168 end.
1169
1170%% Basename check for tools that need a controlling TTY (not just isatty).
1171needs_controlling_tty(Path) when is_list(Path) ->
1172 Base = filename:basename(Path),
1173 lists:member(Base, ["sudo", "run0", "pkexec", "doas", "su"]).
1174
1175%% Capture mode: pipes, no TTY. `child_env` forces color when the shell wants
1176%% it so tools like `jj` still embed ANSI we can pass through on display.
1177%%
1178%% Stdin is redirected from /dev/null via `sh -c` so programs that read stdin
1179%% (bare `less`, `cat`, `wc`) get EOF immediately instead of hanging on an
1180%% open-but-never-written pipe. (Port option `out` alone breaks exit_status
1181%% delivery on current OTP.)
1182run_cmd_capture(Path, PortArgs) ->
1183 Sh =
1184 case os:find_executable("sh") of
1185 false ->
1186 "/bin/sh";
1187 S ->
1188 S
1189 end,
1190 %% sh -c 'exec "$0" "$@" < /dev/null' path arg1 arg2 ...
1191 %% $0 = Path; "$@" = remaining args — no shell-quoting of user args.
1192 Port = open_port(
1193 {spawn_executable, Sh},
1194 [
1195 binary,
1196 exit_status,
1197 stderr_to_stdout,
1198 use_stdio,
1199 stream,
1200 {env, child_env()},
1201 {args, ["-c", "exec \"$0\" \"$@\" < /dev/null", Path | PortArgs]}
1202 ]
1203 ),
1204 put(gleshell_output_shown, false),
1205 collect_output(Port, <<>>).
1206
1207%% Inherit real stdio — pagers/editors talk to the terminal directly.
1208%% LESS=FRX (via child_env) lets less pass ANSI colors from jj/git.
1209run_cmd_inherit(Path, PortArgs) ->
1210 Port = open_port(
1211 {spawn_executable, Path},
1212 [
1213 exit_status,
1214 nouse_stdio,
1215 {env, child_env()},
1216 {args, PortArgs}
1217 ]
1218 ),
1219 put(gleshell_output_shown, true),
1220 %% No timeout: less/vim/top may run for a long time.
1221 receive
1222 {Port, {exit_status, Status}} ->
1223 {ok, {Status, <<>>}}
1224 end.
1225
1226%% Controlling-TTY + key relay for sudo/run0/etc.
1227run_cmd_pty(Script, Path, PortArgs, TtyPath) ->
1228 Port = open_port(
1229 {spawn_executable, Script},
1230 [
1231 binary,
1232 exit_status,
1233 stderr_to_stdout,
1234 use_stdio,
1235 stream,
1236 {env, child_env()},
1237 {args, ["-q", "-e", "/dev/null", "--", Path | PortArgs]}
1238 ]
1239 ),
1240 case file:open(TtyPath, [write, raw, binary]) of
1241 {ok, TtyOut} ->
1242 GL = group_leader(),
1243 Reader = spawn(fun() ->
1244 group_leader(GL, self()),
1245 io_to_port(Port)
1246 end),
1247 put(gleshell_output_shown, true),
1248 try
1249 collect_output_relay(Port, TtyOut, <<>>)
1250 after
1251 exit(Reader, kill),
1252 catch file:close(TtyOut)
1253 end;
1254 {error, _} ->
1255 put(gleshell_output_shown, false),
1256 %% Fall back to inherit rather than a silent capture hang.
1257 run_cmd_inherit(Path, PortArgs)
1258 end.
1259
1260%% Relay keypresses from the group leader to the child's PTY (script stdin).
1261io_to_port(Port) ->
1262 case io:get_chars("", 1) of
1263 eof ->
1264 ok;
1265 {error, _} ->
1266 ok;
1267 Data ->
1268 case io_data_to_bin(Data) of
1269 <<>> ->
1270 io_to_port(Port);
1271 Bin ->
1272 catch port_command(Port, Bin),
1273 io_to_port(Port)
1274 end
1275 end.
1276
1277io_data_to_bin(Bin) when is_binary(Bin) ->
1278 Bin;
1279io_data_to_bin([C]) when is_integer(C), C >= 0, C =< 16#7F ->
1280 <<C>>;
1281io_data_to_bin(List) when is_list(List) ->
1282 case unicode:characters_to_binary(List) of
1283 Bin when is_binary(Bin) ->
1284 Bin;
1285 _ ->
1286 <<>>
1287 end;
1288io_data_to_bin(_) ->
1289 <<>>.
1290
1291collect_output(Port, Acc) ->
1292 receive
1293 {Port, {data, Data}} when is_binary(Data) ->
1294 collect_output(Port, <<Acc/binary, Data/binary>>);
1295 {Port, {data, Data}} when is_list(Data) ->
1296 Bin = unicode:characters_to_binary(Data),
1297 collect_output(Port, <<Acc/binary, Bin/binary>>);
1298 {Port, {exit_status, Status}} ->
1299 {ok, {Status, Acc}}
1300 after 120_000 ->
1301 catch port_close(Port),
1302 {error, <<"command timed out after 120s">>}
1303 end.
1304
1305%% PTY auth session: no timeout (password prompts, etc.).
1306collect_output_relay(Port, Tty, Acc) ->
1307 receive
1308 {Port, {data, Data}} when is_binary(Data) ->
1309 _ = file:write(Tty, Data),
1310 collect_output_relay(Port, Tty, <<Acc/binary, Data/binary>>);
1311 {Port, {data, Data}} when is_list(Data) ->
1312 Bin = unicode:characters_to_binary(Data),
1313 _ = file:write(Tty, Bin),
1314 collect_output_relay(Port, Tty, <<Acc/binary, Bin/binary>>);
1315 {Port, {exit_status, Status}} ->
1316 {ok, {Status, normalize_pty_output(Acc)}}
1317 end.
1318
1319%% PTY line discipline often emits CR-LF; normalize to LF for structured use.
1320normalize_pty_output(Bin) when is_binary(Bin) ->
1321 binary:replace(Bin, <<"\r\n">>, <<"\n">>, [global]).
1322
1323%% Extra env for external commands (merged into the process environment).
1324%%
1325%% - SHELL=/bin/sh: `script` invokes $SHELL; nu/fish break `script -c`.
1326%% - LESS=FRX when unset: pagers (jj/git → less) pass through ANSI colors (-R)
1327%% and exit on short output (-F) without clearing the screen (-X).
1328%% - FORCE_COLOR / CLICOLOR_FORCE when the shell itself wants color and the
1329%% child has no TTY (direct path): tools like jj/git/ripgrep emit ANSI so
1330%% we can show their colors when re-printing the captured string.
1331child_env() ->
1332 Env0 = [{"SHELL", "/bin/sh"}],
1333 Env1 =
1334 case os:getenv("LESS") of
1335 false ->
1336 [{"LESS", "FRX"} | Env0];
1337 "" ->
1338 [{"LESS", "FRX"} | Env0];
1339 _ ->
1340 Env0
1341 end,
1342 case want_child_color() of
1343 false ->
1344 Env1;
1345 true ->
1346 Env2 =
1347 case os:getenv("FORCE_COLOR") of
1348 false ->
1349 [{"FORCE_COLOR", "1"} | Env1];
1350 "0" ->
1351 Env1;
1352 _ ->
1353 Env1
1354 end,
1355 case os:getenv("CLICOLOR_FORCE") of
1356 false ->
1357 [{"CLICOLOR_FORCE", "1"} | Env2];
1358 "0" ->
1359 Env2;
1360 _ ->
1361 Env2
1362 end
1363 end.
1364
1365%% Match gleshell color policy: off under NO_COLOR; otherwise on for a TTY
1366%% or when the parent already forces color.
1367want_child_color() ->
1368 case os:getenv("NO_COLOR") of
1369 L when is_list(L), L =/= "" ->
1370 false;
1371 _ ->
1372 case stdout_isatty() of
1373 true ->
1374 true;
1375 false ->
1376 force_color_set()
1377 end
1378 end.
1379
1380force_color_set() ->
1381 case os:getenv("FORCE_COLOR") of
1382 L when is_list(L), L =/= "", L =/= "0" ->
1383 true;
1384 _ ->
1385 case os:getenv("CLICOLOR_FORCE") of
1386 L when is_list(L), L =/= "", L =/= "0" ->
1387 true;
1388 _ ->
1389 false
1390 end
1391 end.
1392
1393%% True when the last external command already streamed output to the TTY
1394%% (PTY relay). Cleared after being read so the REPL does not double-print.
1395-spec take_output_shown() -> boolean().
1396take_output_shown() ->
1397 case erase(gleshell_output_shown) of
1398 true -> true;
1399 _ -> false
1400 end.
1401
1402-spec clear_output_shown() -> nil.
1403clear_output_shown() ->
1404 erase(gleshell_output_shown),
1405 nil.
1406
1407%% Find a terminal device attached to this BEAM (or an ancestor).
1408%% Note: os:getpid() returns a string, not an integer.
1409find_tty_path() ->
1410 case catch list_to_integer(os:getpid()) of
1411 Pid when is_integer(Pid) ->
1412 case tty_path_for_pid(Pid) of
1413 {ok, _} = Ok ->
1414 Ok;
1415 error ->
1416 walk_parent_tty(Pid, 12)
1417 end;
1418 _ ->
1419 error
1420 end.
1421
1422walk_parent_tty(_Pid, 0) ->
1423 error;
1424walk_parent_tty(Pid, N) when is_integer(Pid), Pid > 1 ->
1425 case parent_pid(Pid) of
1426 {ok, Parent} when Parent > 1, Parent =/= Pid ->
1427 case tty_path_for_pid(Parent) of
1428 {ok, _} = Ok ->
1429 Ok;
1430 error ->
1431 walk_parent_tty(Parent, N - 1)
1432 end;
1433 _ ->
1434 error
1435 end;
1436walk_parent_tty(_, _) ->
1437 error.
1438
1439tty_path_for_pid(Pid) when is_integer(Pid) ->
1440 case read_tty_nr(Pid) of
1441 {ok, 0} ->
1442 error;
1443 {ok, TtyNr} ->
1444 tty_nr_to_path(TtyNr);
1445 error ->
1446 error
1447 end.
1448
1449read_tty_nr(Pid) when is_integer(Pid) ->
1450 case file:read_file("/proc/" ++ integer_to_list(Pid) ++ "/stat") of
1451 {ok, Bin} ->
1452 case parse_stat_tty_nr(binary_to_list(Bin)) of
1453 {ok, N} -> {ok, N};
1454 error -> error
1455 end;
1456 _ ->
1457 error
1458 end.
1459%% /proc/pid/stat: "pid (comm) state ppid pgrp session tty_nr ..."
1460parse_stat_tty_nr(List) ->
1461 case lists:splitwith(fun(C) -> C =/= $) end, List) of
1462 {_, [$) | Rest0]} ->
1463 Rest = string:trim(Rest0, leading),
1464 Fields = string:tokens(Rest, " "),
1465 %% After ')': state, ppid, pgrp, session, tty_nr → index 5
1466 case length(Fields) >= 5 of
1467 true ->
1468 try
1469 {ok, list_to_integer(lists:nth(5, Fields))}
1470 catch
1471 _:_ -> error
1472 end;
1473 false ->
1474 error
1475 end;
1476 _ ->
1477 error
1478 end.
1479
1480parent_pid(Pid) ->
1481 case file:read_file("/proc/" ++ integer_to_list(Pid) ++ "/stat") of
1482 {ok, Bin} ->
1483 case parse_stat_ppid(binary_to_list(Bin)) of
1484 {ok, P} -> {ok, P};
1485 error -> error
1486 end;
1487 _ ->
1488 error
1489 end.
1490
1491parse_stat_ppid(List) ->
1492 case lists:splitwith(fun(C) -> C =/= $) end, List) of
1493 {_, [$) | Rest0]} ->
1494 Rest = string:trim(Rest0, leading),
1495 Fields = string:tokens(Rest, " "),
1496 %% After ')': state, ppid → index 2
1497 case length(Fields) >= 2 of
1498 true ->
1499 try
1500 {ok, list_to_integer(lists:nth(2, Fields))}
1501 catch
1502 _:_ -> error
1503 end;
1504 false ->
1505 error
1506 end;
1507 _ ->
1508 error
1509 end.
1510
1511%% Decode Linux tty_nr (see drivers/tty/tty_io.c / procfs) to a device path.
1512tty_nr_to_path(0) ->
1513 error;
1514tty_nr_to_path(TtyNr) when is_integer(TtyNr) ->
1515 Major = (TtyNr bsr 8) band 16#ff,
1516 Minor = (TtyNr band 16#ff) bor (((TtyNr bsr 20) band 16#fff) bsl 8),
1517 Path =
1518 case Major of
1519 136 ->
1520 "/dev/pts/" ++ integer_to_list(Minor);
1521 4 when Minor >= 64 ->
1522 "/dev/ttyS" ++ integer_to_list(Minor - 64);
1523 4 ->
1524 "/dev/tty" ++ integer_to_list(Minor);
1525 _ ->
1526 undefined
1527 end,
1528 case Path of
1529 undefined ->
1530 error;
1531 _ ->
1532 case file:read_file_info(Path) of
1533 {ok, _} -> {ok, Path};
1534 _ -> error
1535 end
1536 end.
1537
1538reason_to_bin(Reason) when is_atom(Reason) ->
1539 atom_to_binary(Reason, utf8);
1540reason_to_bin(Reason) when is_binary(Reason) ->
1541 Reason;
1542reason_to_bin(Reason) ->
1543 iolist_to_binary(io_lib:format("~p", [Reason])).