1:- module( by_unix, [    
    2					(@)/1,
    3					(&)/1,
    4					(@@)/2,
    5					(@@)/3,
    6					which/2,
    7					cd/2,
    8					by_unix_retract/0,
    9					by_unix_assert/0,
   10					by_unix_version/2,
   11					by_unix_term_to_serial/2,
   12					op( 200, fy, @ ),
   13					op( 200, fy, & ),
   14					op( 200, yfx, @@ ),
   15					op( 200, fy, -- ),
   16					op( 400, fx, / ),
   17					op( 400, fx, './' ),
   18   					op( 400, fx, '../' ),
   19					op( 600, yfx, '/../' )
   20				] ).   21
   22:- ensure_loaded( library(process) ).   23:- ensure_loaded( library(debug) ).

by_unix

An elegance layer to calling unix commands.

This library provides primitives that allow programmers and users to embed calls to process_create/3. The aim is to keep application code clear and succinct. This is achieved by (a) reducing the call to process_create/3 to its essential constituents and (b) allowing for term structures in the arguments of the call.

The library uses two local flags if they are defined.

    current_prolog_flag( by_unix_shell, Shell ).
    current_prolog_flag( by_unix_shell_com_arg, CmA ).

Shell should be a Unix shell such as tcsh and CmA argument should be the shell's way of saying that what ever follows is for shell to execute. When Shell is present it is used to start the commands; this allows for including user personalisations via their usual shell. When CmA is missing, -c is used (set it to '' for none at all).

On loading, the file ~/.pl/by_unix.pl will be consulted if it exists. You can add user preferences there, such as

:- set_prolog_flag( by_unix_shell, tcsh ).

The simplest example of how to use the library is:

  ?- @ ls.

This lists all files by translating ls to process_create( path(ls), [], [] ).

To list all details (long list):

        ?- @ ls(-l).

which demonstrates translation of terms in arguments.

By_unix looks at the arguments of the terms right of an @ to decide which ones are options (3rd argument of process_create/3) assuming the rest to be arguments to the call (2nd argument of process_create/3). Command arguments can be terms which will be serialised, so that a/b becomes 'a/b'. The argument * is special and it is expanded fed into expand_file_name/2.

With SWI 7 you can now have '.' in atoms, making interactions with the OS even smoother.

?- @ mkdir( -p, /tmp/test_by_unix ).
?- @ cd( /tmp/test_by_unix ).
?- @ touch( empty.pl ).
?- @ rm( -f, empty.pl ).

?- @ cd( pack(by_unix) ).
?- Wc @@ wc( -l, pack.pl ).

Wc = ['10 pack.pl'].

?- @ cd( @ '$HOME' ).
?- [Pwd] @@ pwd.
Pwd = '/home/nicos'.


?- Pass @@ bash( -c, 'read -s -p password: pass; echo $pass' ), nl.
% Sending, name: bash, args: [-c,read -s -p password: pass; echo $pass], opts:[stdout(pipe(_G1360))].
password:
Pass = [word].

The main objective of by_unix is achieved by what has been described so far. We have found that more than 90 percent of the its uses are to produce elegant Goals that are clear to read and construct their arguments within Prolog. We provide some more features, which are described in what follows, but they should be seen as marginal.

Changing directory is not supported via cd in process_create as which cd fails to return an executable in bash. That is,

?- process_create( path(cd), ['/'], [] ).
ERROR: source_sink `path(cd)' does not exist

As oppose to:

?- [library(by_unix)].

?- @ cd( / ).
true.

?- @ ls.
bin   dev  home        initrd.img.old  lib64	   media  opt	root  sbin     srv  tmp  var
boot  etc  initrd.img  lib	       lost+found  mnt	  proc	run   selinux  sys  usr  vmlinuz
true.

?- @ cd( /home/nicos ).
?- @ cd( pack(by_unix) ).

which/2 provides a locator for executables. by_unix_term_to_serial/2 serialises Prolog terms to process_create/3 atoms, and by_unix_assert/0 allows for doing away with the @.

As process_create/3 quotes special characters, for instance

?- process_create( path(ls), ['*'], [] ).
/bin/ls: cannot access *: No such file or directory
ERROR: Process "/bin/ls": exit status: 2

By_unix allows for in-argument file name expansions via expand_file_name/2.

?- @ ls( -l, @('*.pl') ).

@@/2 provides dual functionality: either picking up output lines from the calling command or for maplist/2 applications. See @@/2 and @@/3.

A lines example

?- @ cd( @ '$HOME' ).
?- Pwd @@ pwd.
Pwd = ['/home/nicos'].

A maplist example

?- @ cd( pack(by_unix) ).
?- Files = ['prolog/by_unix.pl'], maplist( @@(wc(-l)), Files, Wcs ).

As of version 0.1.7 (a) failure to locate a suitable executable results to an informational message, (b) non-zero exit on the process_create/3 does no longer produce an error, but an informational message followed by failure.

?- @what(else).
% No 'what' executable could be found.
false.

?- @ ls(who).
/bin/ls: cannot access 'who': No such file or directory
% Failed shell call: ls with args: [who].
false.
author
- Nicos Angelopoulos
version
- 0.1.7 2014/06/09
- 0.2 2020/09/18
See also
- http://stoics.org.uk/~nicos/sware/by_unix
To be done
- error handling via message/3.
- aliases in .pl/by_unix.pl
- pick process_create options from the library declarations
- ?- Files = ['by_unix.pl'], maplist( @@ wc(-l) , Files, Wcs ). ie. fix syntax error on this

*/

 @@(-Lines, +Comm)
@@(+Comm, -Arg)
If first argument is a variable or list, it is interpretted to be the Lines invocation, Output from Comm instantiated in Lines. Attach Arg to Comm before processing as a Unix command.
  192@@(Lines,Goal) :-
  193	once( var(Lines); is_list(Lines) ),
  194	!,
  195	by_unix_separate( Goal, Name, TArgs, Opts ),
  196	\+ memberchk( stdout(_), Opts  ),
  197	unix_process( Name, Goal, TArgs, [stdout(pipe(Out))|Opts] ),
  198	read_lines(Out, Lines),
  199	close( Out ).
  200@@(Goal,Arg) :-
  201	by_unix_separate( Goal, Name, Args, Opts ),
  202	by_unix_term_to_serial( Arg, Serial ),
  203	to_list( Serial, Serials ),
  204	append( Args, Serials, All ),
  205	% process_create( path(Name), All, Opts ).
  206	unix_process( Name, Goal, All, Opts ).
  207% this is suitable for meta calls, with output
  208%% @@( +Comm, +Arg, -Lines ).
  209%
  210% Attach Arg to Comm before processing as a Unix command and provide output to Lines.
  211% Works with maplist/3 but Lines will be triply nested.
  212%
  213@@(Goal,Arg,Lines) :-
  214	by_unix_separate( Goal, Name, Args, Opts ),
  215	by_unix_term_to_serial( Arg, Serial ),
  216	to_list( Serial, Serials ),
  217	append( Args, Serials, All ),
  218	Aug = [stdout(pipe(Out))|Opts],
  219	unix_process( Name, Goal, All, Aug ),
  220	% process_create( path(Name), All, [stdout(pipe(Out))|Opts] ),
  221	read_lines(Out, Lines ),
  222	close( Out ).
 @ +Goal
This is the main predicate of by_unix. See module documentation for examples.

For @cd( Arg ) see documentation of cd/2.

   ?- @ mkdir( -p, /tmp/test_by_unix ).
   ?- @ cd( /tmp/test_by_unix ).
   ?- @ touch( empty.pl ).
   ?- @ rm( -f, empty.pl ).
  237@(Goal) :-
  238	by_unix_separate( Goal, Name, TArgs, Opts ),
  239	unix_process( Name, Goal, TArgs, Opts ).
 &(+Goal)
As @(Goal) but runs process in the background. This should be achivable via detached(true) option of process_create/3 but this does not seem to work on linux (tested on Mint 16). Here we use an (experimental) implementation based on threads. == ==
  250&(Goal) :-
  251	by_unix_separate( Goal, Name, TArgs, Opts ),
  252	Gcreate = unix_process_thread( Name, Goal, TArgs, Opts ),
  253	thread_create( Gcreate, Id, [] ),
  254	sleep( 1 ), % is this an SWI bug ?
  255	thread_signal( Id, thread_exit(exited) ).
  256
  257by_unix_separate( Goal, Name, TArgs, Opts ) :-
  258	% Goal =.. [Name|GArgs],
  259	compound( Goal, Name, GArgs ),
  260	% which_cmd( Name ),
  261	( which(Name,_Wch) ->
  262        true
  263        ;
  264        by_unix_message( exec_miss(Name) ),
  265        fail
  266    ),
  267	partition( pc_option, GArgs, Opts, ArgsNest ),
  268    flatten( ArgsNest, Args ),
  269	maplist( by_unix_term_to_serial, Args, NesTArgs ),
  270	flatten( NesTArgs, TArgs ).
  271
  272which_cmd( _Name ) :-
  273	current_prolog_flag( by_unix_shell, _ ),
  274	% fixme: for now don't check, but we will probably have to
  275	% fix the general call for shelled executions anyway, so hook to that.
  276	!.
  277which_cmd( Name ) :-
  278	which( Name, _Wch ). %fixme add error
  279
  280unix_process( Cd, Goal, [_Arg], [] ) :-
  281	Cd == cd,
  282	!,
  283	arg( 1, Goal, Garg ),
  284	cd( Garg ).
  285unix_process( Name, _Goal, Args, Opts ) :-
  286	current_prolog_flag( by_unix_shell, ByShell ),
  287	!,
  288	abs_shell_location( ByShell, Shell ),
  289	shell_process( Shell, Name, Args, Opts ).
  290unix_process( Name, _Goal, Args, Opts ) :-
  291	debug( by_unix, 'Sending, name: ~w, args: ~w, opts:~w.', [Name,Args,Opts] ),
  292	catch( process_create( path(Name), Args, Opts ), _, fail),
  293    !.
  294unix_process( Name, _Goal, _Args, _Opts ) :-
  295    AbsOpts = [access(execute),file_errors(fail)],
  296    \+ absolute_file_name( path(Name), _AbsExec, AbsOpts ),
  297    by_unix_message( exec_miss(Name) ),
  298    !,
  299    fail.
  300unix_process( Name, _Goal, Args, _Opts ) :-
  301    by_unix_message( exec_fail(Name,Args) ),
  302    fail.
  303    
  304unix_process_thread( Name, Goal, TArgs, Opts ) :-
  305	unix_process( Name, Goal, TArgs, Opts ),
  306	uniprocess_thread_loop.
  307
  308uniprocess_thread_loop :-
  309	sleep( 1 ),
  310	uniprocess_thread_loop.
  311
  312
  313shell_process( Shell, Name, Args, Opts ) :-
  314	current_prolog_flag( by_unix_shell_com_arg, CmA ),
  315	!,
  316	shell_arged_process( CmA, Shell, Name, Args, Opts ).
  317shell_process( Shell, Name, Args, Opts ) :-
  318	shell_arged_process( '-c', Shell, Name, Args, Opts ).
  319
  320% untested- i don't know any shell that does this.
  321shell_arged_process( '', Shell, Name, Args, Opts ) :-
  322	!,
  323	shelled_name_args( Name, Args, Nargs ),
  324	% send_process( Shell, NArgs, Opts ).
  325	Process =.. [Shell|Nargs],
  326	send_process( Process, Opts ).
  327
  328shell_arged_process( CmA, Shell, Name, Args, Opts ) :-
  329	shelled_name_args( Name, Args, Nargs ),
  330	% send_process( Shell, [CmA|NArgs], Opts ). % see if we need ""
  331	Process =.. [Shell,CmA|Nargs],
  332	send_process( Process, Opts ).
  333
  334send_process( Process, Opts ) :-
  335	debug( by_unix, 'Sending process:process_create, 1: ~w, 2: ~w', [Process,Opts] ),
  336	process:process_create( Process, Opts ).
  337
  338% temporary?
  339shelled_name_args( Name, Args, [Narg] ) :-
  340	maplist( dquote, Args, DqArgs ),
  341	atomic_list_concat( [Name|DqArgs], ' ', Narg ).
  342
  343dquote( X, Dq ) :-
  344	atomic_list_concat( ['"',X,'"'], Dq ).
 which(+Which, -This)
Expand Which as a unix command in the path and return its absolute_file_name/3 in This. When Which is cd, variable This is also bound to cd. cd is handled separately as which cd fails in bash, as does process_create(path(cd), ['/'], [] ).

*/

  353which( Which, This ) :- 
  354	Which == cd,
  355	!, 
  356	This = cd.
  357% which( which, which ) :- !.
  358which( Which, This ) :-
  359	current_prolog_flag( by_unix_shell, ByShell ),
  360	!,
  361	abs_shell_location( ByShell, Shell ),
  362	by_unix_shell_com_args( Args ),
  363	shelled_name_args( which, [Which], WchWhich ),
  364	append( Args, WchWhich, WchArgs ),
  365	Proc =.. [Shell|WchArgs],
  366	process:process_create( Proc, [stdout(pipe(Out))] ),
  367	read_lines(Out, Lines),
  368	close( Out ),
  369	Lines = [This|_].
  370
  371which( Which, This ) :-
  372	by_which( Which, This ).
  373
  374by_which( Which, This ) :-
  375     absolute_file_name( path(Which), This,
  376			 [ extensions(['',exe]),
  377			   file_errors(fail),
  378			   access(exist) % shouldn't this be execute ?
  379			 ] ).  % does not succeed for built-ins !!!
  380
  381by_unix_shell_com_args( Args ) :-
  382	current_prolog_flag( by_unix_shell_com_arg, CmA ),
  383	!,
  384	by_unix_shell_com_arg_args( CmA, Args ).
  385by_unix_shell_com_args( ['-c'] ).
  386
  387by_unix_shell_com_arg_args( '', [] ) :- !.
  388by_unix_shell_com_arg_args( CmA, [CmA] ).
  389
  390pc_option( Term ) :-
  391    \+ is_list( Term ),
  392	compound( Term, Name, Args ),
  393	length( Args, 1 ),
  394	% functor( Term, Name, 1 ),
  395	known_pc_options( OptNames ), %fixme:
  396	memberchk( Name, OptNames ).
 by_unix_term_to_serial(Term, Serial)
Term is serialised into an atomic Serial. When Term is *, Serial is the list of current files, while when Term = @ Atom, Serial is the result of applying expand_file_name( Atom, Serial ).
  403by_unix_term_to_serial( *, Files ) :-
  404	!,
  405	expand_file_name('*',Files).
  406by_unix_term_to_serial( @(Inner), Files ) :-
  407	by_unix_term_to_serial( Inner, Atit ),
  408	!,
  409	expand_file_name(Atit,Files).
  410
  411by_unix_term_to_serial( Term, Serial ) :-
  412	with_output_to( atom(Serial), write_term(Term,[quoted(false)]) ).
 by_unix_version(-Version, -Date)
Provides version and date of current release.
 by_unix_version( 0:1:6, date(2013,12,26) ).
author
- nicos angelopoulos
version
- 0:2 2020/9/18
  425by_unix_version( 0:2:0, date(2014,6,9) ).
 by_unix_retract
Retract all user:goal_expansion(_,_).
  431by_unix_retract :-
  432	Head = user:goal_expansion(_,_),
  433	retractall( Head ).
 by_unix_assert
Allows for goal expansion of Com to @ Com, when Com is a which-able Unix command.
  ?- by_unix_asert.
  ?- mkdir( -p, /tmp/test_by_unix ).
  ?- cd( /tmp/test_by_unix ).
  ?- touch( empty.pl ).
  ?- ls( -l ).
  ?- rm( -f, empty.pl ).
  ?- ls( -a ).
  448by_unix_assert :-
  449	Head = user:goal_expansion(Term1,Term2),
  450	Body = (  (atomic(Term1) -> UnixCom = Term1
  451				; compound_name_arity(Term1,UnixCom,_Arity) ),
  452			which(UnixCom,_),
  453			Term2= @(Term1)
  454		  ),
  455	assert( (Head :- Body) ).
  456
  457known_pc_options( [stdin,stdout,stderr,cwd,env,process,detached,window] ).
 cd(+New)
 cd(-Old, +New)
Similar to working_directory/2, but in addition New can be a search path alias or the 1st argument of absolute_file_name/2. This is also the case when @ cd( New ) is called.
?- @ cd( pack ).
true.

?- @ pwd.
/usr/local/users/nicos/local/git/lib/swipl-7.1.4/pack
true.

?- @ cd( @ '$HOME' ).
true.

?- @ pwd.
/home/nicos
true.
  482cd( Old, New ) :-
  483	working_directory( Old, Old ),
  484	cd( New ).
  485
  486cd( Spec ) :-
  487	atomic( Spec ),
  488	expand_file_name( Spec, [Fst|_] ),
  489	catch(absolute_file_name(Fst,Dir),_,fail),
  490	exists_directory( Dir ),
  491	!,
  492	working_directory( _, Dir ).
  493cd( Dir ) :-
  494	ground( Dir ),
  495	cd_ground( Dir ),
  496	!.
  497cd( Atom ) :-
  498	atom( Atom ),
  499	!,
  500	working_directory( _, Atom ).
  501cd( Term ) :-
  502	compound( Term ),
  503	by_unix_term_to_serial( Term, Serial ),
  504	to_list( Serial, [Dir|_T] ), %fixme: warn if T \== [] 
  505	working_directory( _, Dir ).
  506
  507cd_ground( Dir ) :-
  508	user:file_search_path( Dir, TermLoc ),
  509	expand_file_search_path( TermLoc, Loc ),
  510	exists_directory( Loc ),
  511	working_directory( _, Loc ).
  512cd_ground( Dir ) :-
  513	Opts = [file_type(directory),file_error(fail),solutions(first),access(execute)],
  514	catch( absolute_file_name(Dir,Loc,Opts), _, fail ),
  515	working_directory( _, Loc ).
  516
  517abs_shell_location( ByShell, Shell ) :-
  518	exists_file( ByShell ),
  519	access_file( ByShell, execute ),
  520	!,
  521	debug( by_unix, 'Using shell given by absolute path, at:~w', ByShell ),
  522	Shell = ByShell.
  523abs_shell_location( ByShell, Shell ) :-
  524	by_which( ByShell, Shell ),
  525	debug( by_unix, 'Using shell given by relative:~w, locate by which , at:~w', [ByShell,Shell] ),
  526	!.
  527% fixme: add errors like Real
  528abs_shell_location( ByShell, _Shell ) :-
  529	debug( by_unix ),
  530	debug( by_unix, 'Cannot locate shell given by relative:~w', [ByShell] ),
  531	fail.
  532
  533read_lines(Out, Lines) :-
  534        read_line_to_codes(Out, Line1),
  535        read_lines(Line1, Out, Lines).
  536read_lines(end_of_file, _, []) :- !.
  537read_lines(Codes, Out, [Line|Lines]) :-
  538        atom_codes(Line, Codes),
  539        read_line_to_codes(Out, Line2),
  540        read_lines(Line2, Out, Lines).
  541
  542compound( Term, Name, Args ) :-
  543	current_predicate( compound_name_arguments/3 ),
  544	compound( Term ),  % in real this is after the cut, here we are less strict we allows ls = ls()
  545	!,
  546	compound_name_arguments( Term, Name, Args ).
  547compound( Term, Name, Args ) :-
  548	Term =.. [Name|Args].
  549
  550to_list( Serial, Serials ) :-
  551	is_list( Serial ),
  552	!,
  553	Serial = Serials.
  554to_list( Serial, [Serial] ).
  555
  556by_unix_load_user_file :-
  557	expand_file_name( '~/.pl/by_unix.pl', [ByUnix] ),
  558	exists_file( ByUnix ),
  559	ensure_loaded( ByUnix ),
  560	!.
  561by_unix_load_user_file.
  562
  563                 /*******************************
  564                 *            MESSAGES          *
  565                 *******************************/
  566% These print messages that are always on.
  567% Different colour to debugging is used by the system (when colour in terminal is enabled).
  568%
  569by_unix_message( Mess ) :-
  570    print_message( informational, by_unix(Mess) ).
  571    
  572:- multifile prolog:message//1.  573
  574prolog:message(by_unix(Message)) -->
  575    message(Message).
  576
  577:- discontiguous
  578    message//1.  579
  580message( exec_miss(Exec) ) -->
  581    ['No \'~w\' executable could be found.'-[Exec] ].
  582message( exec_fail(Exec,Args) ) -->
  583    ['Failed shell call: ~w with args: ~w.'-[Exec,Args] ].
  584
  585:- initialization( by_unix_load_user_file, now ).