1:- module(commands, [unzip/2, zip/2,
    2                     user/2, pid/2, pgid/2, sid/2, ppid/2, proc_c/2, stime/2, tty/2, proc_time/2, cmd/2, process_parent/2, processes/1,
    3                     remote_pwd/2, remote_absolute_path/3,
    4                     find_main_class/2, find_main_class/3,
    5                     java/2, java/3, java_cp/4, run_java/4]).    6
    7:- use_module(library(dcg/basics)).    8:- use_module(library(filesex)).    9
   10:- use_module(build_systems).   11:- use_module(utility).   12
   13lookup_process(Process, N, Val) :-
   14    var(Process),
   15    processes(Processes),
   16    member(Process, Processes),
   17    lookup_process(Process, N, Val).
   18lookup_process(Process, N, Val) :-
   19    nonvar(Process),
   20    functor(Process, process, _),
   21    arg(N, Process, Val).
   22
   23user(User, Process) :- lookup_process(Process, 1, User).
   24pid(PID, Process) :- lookup_process(Process, 2, PID).
   25ppid(PPID, Process) :- lookup_process(Process, 3, PPID).
   26pgid(PGID, Process) :- lookup_process(Process, 4, PGID).
   27sid(SID, Process) :- lookup_process(Process, 5, SID).
   28proc_c(C, Process) :- lookup_process(Process, 6, C).
   29stime(STime, Process) :- lookup_process(Process, 7, STime).
   30tty(TTY, Process) :- lookup_process(Process, 8, TTY).
   31proc_time(Time, Process) :- lookup_process(Process, 9, Time).
   32cmd(Cmd, Process) :- lookup_process(Process, 10, Cmd).
   33
   34process_parent(ProcessA, ProcessB) :-
   35    nonvar(ProcessA), nonvar(ProcessB),
   36    ppid(PID, ProcessA),
   37    pid(PID, ProcessB).
   38process_parent(ProcessA, ProcessB) :-
   39    var(ProcessA), nonvar(ProcessB),
   40    pid(PID, ProcessB),
   41    processes(Processes),
   42    member(ProcessA, Processes),
   43    ppid(PID, ProcessA).
   44process_parent(ProcessA, ProcessB) :-
   45    nonvar(ProcessA), var(ProcessB),
   46    ppid(PID, ProcessA),
   47    processes(Processes),
   48    member(ProcessB, Processes),
   49    pid(PID, ProcessB).
   50process_parent(ProcessA, ProcessB) :-
   51    var(ProcessA), var(ProcessB),
   52    processes(Processes),
   53    member(ProcessA, Processes),
   54    member(ProcessB, Processes),
   55    process_parent(ProcessA, ProcessB).
   56
   57processes(Processes) :-
   58    process(path(ps), ['-ejf'], [output(Output)]),
   59    atomic_list_concat(Lines, '\n', Output),
   60    findall(process(User, PID, PPID, PGID, SID, C, STime, TTY, Time, Cmd),
   61        (
   62            member(Line, Lines),
   63            atomic_list_concat(RawCols, ' ', Line),
   64            exclude(=(''), RawCols, [User, TempPID, TempPPID, TempPGID, TempSID, TempC, STime, TTY, Time|Cmd]),
   65            maplist(term_to_atom, [PID, PPID, PGID, SID, C], [TempPID, TempPPID, TempPGID, TempSID, TempC])
   66        ),
   67        [_|Processes]). % Exclude the first one, it's the header column
   68
   69uri_port_arg(Uri, PortFlag, Args) :-
   70    atomic_list_concat([UriNoPort, Port], ':', Uri) -> Args = [PortFlag, Port, UriNoPort];
   71    Args = [Uri].
   72
   73% Note that SSH/SCP commands assume that you have the connection set up
   74% so you don't need to enter your password manually.
   75remote_command(Uri, Command, Output) :-
   76    uri_port_arg(Uri, '-p', Args),
   77    append(Args, [Command], AllArgs),
   78    process(path(ssh), AllArgs, [output(Output)]).
   79
   80remote_pwd(Uri, Pwd) :-
   81    remote_command(Uri, 'pwd', Temp),
   82    atom_concat(Pwd, '\n', Temp). % pwd prints out a newline, so get rid of that
   83
   84remote_absolute_path(Uri, RelPath, AbsPath) :-
   85    var(RelPath),
   86    nonvar(AbsPath),
   87    remote_pwd(Uri, Pwd),
   88    directory_file_path(Pwd, RelPath, AbsPath).
   89
   90remote_absolute_path(Uri, RelPath, AbsPath) :-
   91    nonvar(RelPath),
   92
   93    (
   94        atom_concat('/', _, RelPath) -> AbsPath = RelPath;
   95
   96        % If it's not an absolute path, make it absolute by assuming it's relative to the pwd when you ssh in
   97        remote_pwd(Uri, Pwd),
   98        directory_file_path(Pwd, RelPath, AbsPath)
   99    ).
  100
  101% Can either pass in a list of files or just one
  102% If you don't specify the copy path, it will just be the directory you enter by default when you ssh in
  103scp(Paths, Uri) :- scp(Paths, Uri, _). % Note that this can take either a single file or a list of files.
  104scp(Path, Uri, CopyPath) :-
  105    not(is_list(Path)),
  106    scp([Path], Uri, CopyPath).
  107scp(Paths, Uri, CopyPath) :-
  108    is_list(Paths),
  109    var(CopyPath),
  110    remote_command(Uri, 'pwd', Temp),
  111    atom_concat(CopyPath, '\n', Temp), % pwd prints out a newline, so get rid of that
  112    scp(Paths, Uri, CopyPath).
  113scp(Paths, Uri, InPath) :-
  114    is_list(Paths),
  115    nonvar(InPath),
  116
  117    remote_absolute_path(Uri, InPath, CopyPath),
  118
  119    % If we're passed something like user@host:port
  120    % then TempUriArgs = ['-P', port, 'user@host']
  121    % Then we separate out the port arguments from the last argument, which the gets combined with the destination path
  122    uri_port_arg(Uri, '-P', TempUriArgs),
  123    last(TempUriArgs, ActualUri),
  124    append(PortArgs, [ActualUri], TempUriArgs),
  125    atomic_list_concat([ActualUri, CopyPath], ':', UriArg),
  126
  127    % Use -r because it doesn't affect regular files but it will automatically fully copy directories
  128    % which is probably what the user wants to do since they passed in a directory
  129    flatten([['-r'], PortArgs, Paths, [UriArg]], AllArgs),
  130    process(path(scp), AllArgs).
  131
  132zip(Dir, ZipName) :-
  133    file_base_name(Dir, DirName),
  134    file_name_extension(DirName, 'zip', ZipName),
  135    process(path(zip), ['-r', ZipName, Dir]).
  136
  137unzip(ZipFile, Destination) :-
  138    var(Destination),
  139    file_name_extension(Destination, 'zip', ZipFile),
  140    process(path(unzip), [ZipFile, '-d', Destination]),
  141
  142    (
  143        % Check to make sure we don't do something like extra a.zip into ./a/a
  144        file_base_name(Destination, Base),
  145        directory_file_path(Destination, Base, Inside),
  146        exists_directory(Inside),
  147
  148        % Instead convert the file structure to be just ./a
  149        copy_directory(Inside, Destination),
  150        delete_directory_and_contents(Inside);
  151
  152        true
  153    ).
  154
  155unzip(ZipFile, Destination) :-
  156    nonvar(Destination),
  157    process(path(unzip), [ZipFile, '-d', Destination]).
  158
  159java(MainClass, Args) :- java(MainClass, Args, []).
  160java(MainClass, Args, Options) :-
  161    process_options(Options, Path, _),
  162    quick_classpath(Path, Classpath),
  163    java_cp(Classpath, MainClass, Args, Options).
  164
  165java_cp(Classpath, MainClass, Args, Options) :-
  166    cache(MainClass,
  167        (
  168            find_main_class(Classpath, MainClass, Class),
  169
  170            atom_codes(MainClass, MainClassCodes),
  171            atom_codes(Class, ClassCodes),
  172            append(_, MainClassCodes, ClassCodes)
  173        ), Class), !,
  174
  175    % Clear out the temp jar files. We only create a temp file so we can get the temp directory
  176    tmp_file('basic', TmpFile),
  177    file_directory_name(TmpFile, Dir),
  178    foreach((walk(Dir, File), sub_atom(File, _, _, _, 'expandedjarfile')), delete_directory_and_contents(File)), !,
  179
  180    run_java(Classpath, Class, Args, Options).
  181
  182run_java(Classpath, MainClass, InArgs, Options) :-
  183    make_args(InArgs, Args),
  184
  185    process_options(Options, Path, JavaOpts),
  186
  187    append(JavaOpts, ['-cp', Classpath, MainClass], TempArgs),
  188    append(TempArgs, Args, AllArgs),
  189
  190    (
  191        % TODO: Figure out how to pass java options when using mvn exec plugin
  192        builds_with(maven, Path), JavaOpts = [] -> mvn_exec(MainClass, Args, Options);
  193
  194        process(path(java), AllArgs, Options)
  195    ).
  196
  197process_options(Options, Path, JavaOpts) :-
  198    (
  199        member(path(Path), Options);
  200        Path = '.'
  201    ),
  202
  203    findall(JavaOpt, member(java_opt(JavaOpt), Options), JavaOpts).
  204
  205make_args(Args, ActualArgs) :-
  206    maplist(make_arg, Args, Temp),
  207    flatten(Temp, ActualArgs).
  208make_arg(ArgName=ArgValue, [Result]) :-
  209    % If the arg name already starts with a '-', don't change it
  210    not(atom_concat('-', ArgName, _)) ->
  211        (
  212            atom_chars(ArgName, [_]) ->
  213                atomic_list_concat(['-', ArgName, '=', ArgValue], '', Result);
  214            atomic_list_concat(['--', ArgName, '=', ArgValue], '', Result)
  215        );
  216    atomic_list_concat([ArgName, '=', ArgValue], Result).
  217make_arg(ArgName-ArgValue, [ActualArgName, ArgValue]) :-
  218    atom_chars(ArgName, [_]) -> atom_concat('-', ArgName, ActualArgName);
  219
  220    atom_concat('--', ArgName, ActualArgName).
  221
  222mvn_exec(MainClass, Args, Options) :-
  223    atom_concat('-Dexec.mainClass=', MainClass, MainClassArg),
  224    maplist(surround_atom('\'', '\''), Args, QuotedArgs),
  225    atomic_list_concat(QuotedArgs, ' ', ArgStr),
  226    atom_concat('-Dexec.args=', ArgStr, MavenArgs),
  227
  228    process(path(mvn), ['package', '-DskipTests', 'exec:java', MainClassArg, MavenArgs], Options).
  229
  230find_main_class(Classpath, MainClass) :- find_main_class(Classpath, '', MainClass).
  231find_main_class(Classpath, SubStr, MainClass) :-
  232    % TODO: Make compatible across different OSes
  233    atomic_list_concat(Paths, ':', Classpath),
  234    member(Path, Paths),
  235    read_main_class(Path, SubStr, MainClass).
  236
  237read_main_class(Path, SubStr, MainClass) :-
  238    file_name_extension(_, 'jar', Path),
  239    read_main_class_jar(Path, SubStr, MainClass);
  240
  241    exists_directory(Path),
  242    read_main_class_dir(Path, SubStr, MainClass).
  243
  244read_main_class_jar(Path, SubStr, MainClass) :-
  245    tmp_file('expandedjarfile', Dir),
  246    make_directory(Dir),
  247
  248    unzip(Path, Dir),
  249    read_main_class_dir(Dir, SubStr, MainClass).
  250
  251read_main_class_dir(Path, SubStr, MainClass) :-
  252    walk(Path, File),
  253    file_name_extension(_, 'class', File),
  254    main_class(File, SubStr, MainClass).
  255
  256main_class(File, SubStr, Class) :-
  257    sub_atom(File, _, _, _, SubStr),
  258    process(path(javap), [File], [output(Output)]), !,
  259    class_name(Output, Class), !,
  260    sub_atom(Output, _, _, _, 'public static void main').
  261
  262class_name(Output, ClassName) :-
  263    atom_codes(Output, Codes),
  264    phrase(java_class(ClassNameCodes), Codes),
  265    atom_codes(ClassName, ClassNameCodes).
  266
  267java_class(ClassName) -->
  268    string(_),
  269    "public class ", string_without("\n{ ", ClassName),
  270    (" "; "{"), string(_)