=== removed file 'escape.pl' --- escape.pl 2011-11-26 16:18:19 +0000 +++ escape.pl 1970-01-01 00:00:00 +0000 @@ -1,100 +0,0 @@ -% vim: ft=prolog textwidth=80 tabstop=4 softtabstop=4 shiftwidth=4 expandtab - -:- module(escape, [str/2, quoting/4, escape/3]). - -:- use_module(library(apply)). -:- use_module(library(lists)). - -:- use_module(generic). - - -% -% Strip characters from left or right side -% - -l_strip([ ], _ , [ ]). -l_strip([Head|Tail], Strip, Out) :- - ( member(Head, Strip) - -> l_strip(Strip, Tail, Out) - ; Out = [Head|Tail] - ). - -r_strip([ ], _ , []). -r_strip([Head|Tail], Strip, Out) :- - r_strip(Strip, Tail, Out0), - ( Out0 = [], - member(Head, Strip) - -> Out = [ ] - ; Out = [Head|Out0] - ). - - -% -% Merge tree into string list -% - -str_dlist(X, Joined, End) :- - ( is_list(X) -> append(X, End, Joined) - ; atom(X) -> name(X, String), - append(String, End, Joined) - ; X = variable(Name) -> Joined = [variable(Name)|End] - ; X = A + B -> str_dlist(B, L, End), - str_dlist(A, Joined, L) - ; X = A +/+ B -> str(A, AString), - str(B, BString), - r_strip(AString, "/", AStripped), - l_strip(BString, "/", BStripped), - concat([AStripped, "/", BStripped, End], Joined) - ). - -str(X, S) :- str_dlist(X, S, []). - -%%%%%%%%%%%%%%%%%% -% Shell escaping % -%%%%%%%%%%%%%%%%%% - -% can escape anything but newline or variable -sh_escaped(Char, String) :- - integer(Char), - [Char] \= "\n", - ( member(Char, "\\ \t()[]{}&;$#!?*=<>'\"`") - -> ( [Bksl] = "\\", String = [Bksl, Char] ) - ; String = [Char] - ). - -% can escape anything single quote or variable -sh_single_quoted(Char, [Char]) :- - integer(Char), - [Char] \= "'". - -% can escape anything -sh_double_quoted(Char, String) :- - ( Char = variable(Name) - -> concat(["${", Name, "}"], String) - ; member(Char, "$\\\"`") - -> ( [Bksl] = "\\", String = [Bksl, Char] ) - ; String = [Char] - ). - -quoting(sh, sh_escaped, "", ""). -quoting(sh, sh_single_quoted, "'", "'"). -quoting(sh, sh_double_quoted, "\"", "\""). - - -escape_whole(String, Name, Escaped) :- - maplist(Name, String, Parts), - concat(Parts, Joined), - quoting(_, Name, Pre, Post), - concat([Pre, Joined, Post], Escaped). - -escape_kv(String, Name, Length-Escaped) :- - escape_whole(String, Name, Escaped), - length(Escaped, Length). - -escape(Shell, In, Out) :- - str(In, String), - findall(Escaped, (quoting(Shell, Name, _, _), - escape_kv(String, Name, Escaped) - ), KV), - keysort(KV, Sorted), - Sorted = [_ - Out|_]. === modified file 'generate_targets' --- generate_targets 2011-11-26 16:18:19 +0000 +++ generate_targets 2011-11-25 17:27:50 +0000 @@ -1,8 +1,7 @@ #!/bin/zsh set -x -mkdir -p ${0:h}/targets -for target in $( ${0:h}/stagebuilder.pl ) +for target in $( ${0:h}/stagebuilder.prolog ) do - ${0:h}/stagebuilder.pl $target $(realpath ${0:h})/build/$target >${0:h}/targets/${target} + ${0:h}/stagebuilder.prolog $target $(realpath ${0:h})/build/$target >${0:h}/targets/${target} chmod +x ${0:h}/targets/${target} done === removed file 'generic.pl' --- generic.pl 2011-11-26 16:18:19 +0000 +++ generic.pl 1970-01-01 00:00:00 +0000 @@ -1,35 +0,0 @@ -% vim: ft=prolog textwidth=80 tabstop=4 softtabstop=4 shiftwidth=4 expandtab - -:- module(generic, [op(400, yfx, +/+) ,join/3, prepend/3, str_join/3, concat/2]). - -% operator definition -%:- op(400, yfx, +/+). - -% -% String tree manipulation -% - -join(_ , [ ], [ ]). -join(_ , [X ], X ). -join(Sep, [A, B|Rest], A + Sep + Result) :- - join(Sep, [B|Rest], Result). -% -% list manipulation -% - -prepend(List, List0, List1) :- append(List, List1, List0). - -str_join(_ , [ ], [ ]). -str_join(_ , [X ], X ). -str_join(Sep, [A, B|Rest], Result) :- - concat([A, Sep, B], Start), - str_join(Sep, [Start|Rest], Result). - -concat([ ],[ ]). -concat([Head|Tail],List) :- concat_cons(Head,Tail,List). -concat_cons(Head ,[ ],Head). -concat_cons(Head0,[Head1|Tail],List) :- - append(Head0,Rest,List), - concat_cons(Head1,Tail,Rest). - - === renamed file 'stagebuilder.pl' => 'stagebuilder.prolog' --- stagebuilder.pl 2011-11-26 16:18:19 +0000 +++ stagebuilder.prolog 2011-11-26 08:33:57 +0000 @@ -4,17 +4,15 @@ :- use_module(library(lists)). :- use_module(library(ordsets)). :- use_module(library(assoc)). -:- use_module(library(apply)). %:- use_module(library(pairs)). %:- use_module(library(error)). -:- use_module(generic). -:- use_module(escape). - - -%%%%%%%%%%%% -% Settings % -%%%%%%%%%%%% +% operator definition +:- op(400, yfx, +/+). + +% +% Settings +% gentoo_mirror('ftp://ftp.linux.cz/pub/linux/gentoo/'). work_dir('/var/prosys'). @@ -23,11 +21,145 @@ stages_dir(Work +/+ stages ) :- work_dir(Work). script_dir(Work +/+ scripts ) :- work_dir(Work). -%%%%%%%%%%%%%%%%%%%%%%%%% -% Shell code generation % -%%%%%%%%%%%%%%%%%%%%%%%%% - -escape(In, Out) :- escape(sh, In, Out). +% +% Generic predicates and shell stuff +% + +maplist(_Pred,[ ]). +maplist( Pred,[A|As]) :- + call(Pred,A), + maplist(Pred,As). + +maplist(_Pred,[ ],[ ]). +maplist( Pred,[A|As],[B|Bs]) :- + call(Pred,A,B), + maplist(Pred,As,Bs). + +maplist(_Pred,[ ],[ ],[ ]). +maplist( Pred,[A|As],[B|Bs],[C|Cs]) :- + call(Pred,A,B,C), + maplist(Pred,As,Bs,Cs). + +prepend(List, List0, List1) :- append(List, List1, List0). + +concat([ ], [ ]). +concat([Head|Tail], String) :- + ( atom(Head) -> name(Head, HString) ; HString = Head ), + append(HString, Rest, String), + concat(Tail, Rest). + +concat_n(List, Name) :- concat(List, String), name(Name, String). + +str_join(_ , [ ], [ ]). +str_join(_ , [X ], X ). +str_join(Sep, [A, B|Rest], Result) :- + concat([A, Sep, B], Start), + str_join(Sep, [Start|Rest], Result). + +join(_ , [ ], [ ]). +join(_ , [X ], X ). +join(Sep, [A, B|Rest], A + Sep + Result) :- + join(Sep, [B|Rest], Result). + +l_strip(_ , [ ], [ ]). +l_strip(Strip, [Head|Tail], Out) :- + ( member(Head, Strip) + -> l_strip(Strip, Tail, Out) + ; Out = [Head|Tail] + ). + +r_strip(_, [ ], []). +r_strip(Strip, [Head|Tail], Out) :- + r_strip(Strip, Tail, Out0), + ( Out0 = [], + member(Head, Strip) + -> Out = [ ] + ; Out = [Head|Out0] + ). + + +sh_escaped(Char, String) :- + integer(Char), + [Char] \= "\n", + ( member(Char, "\\ \t()[]{}&;$#!?*=<>'\"`") + -> ( [Bksl] = "\\", String = [Bksl, Char] ) + ; String = [Char] + ). + +sh_single_quoted(Char, [Char]) :- + integer(Char), + [Char] \= "'". + +sh_double_quoted(Char, String) :- + ( Char = variable(Name) + -> concat(["${", Name, "}"], String) + ; member(Char, "$\\\"`") + -> ( [Bksl] = "\\", String = [Bksl, Char] ) + ; String = [Char] + ). + + + +escape_backslashes([ ], [ ]). +escape_backslashes([UnescapedChar|UnescapedChars], Escaped) :- + ( member(UnescapedChar, "\n") + -> append("'\n'", Escaped0, Escaped) + ; member(UnescapedChar, " \t()[]{}&;$#!?*=<>'\"`") + -> concat(["\\", [UnescapedChar], Escaped0], Escaped) + ; Escaped = [UnescapedChar|Escaped0] + ), + escape_backslashes(UnescapedChars, Escaped0). + +% not_in(_, [ ]). +% not_in(A, [B|Bs]) :- A =\= B, not_in(A, Bs). + +% not_in(A, Bs) :- \+ member(A, Bs). + +str(X, String) :- + ( is_list(X) -> X = String + ; atom(X) -> name(X, String) + ; str_aux(X, String) + ). +str_aux(A + B, String) :- + str(A, AString), + append(AString, BString, String), + str(B, BString). +str_aux(A +/+ B, String) :- + str(A, AString), + str(B, BString), + r_strip("/", AString, AStripped), + l_strip("/", BString, BStripped), + concat([AStripped, "/", BStripped], String). + +escape(Unescaped, Escaped) :- + ( str(Unescaped, UnescapedString) + -> ( member(UnescapedChar, UnescapedString), + member(UnescapedChar, " \n\t()[]{}&;$#!?*=<>\"`"), + [Quote] = "'", \+ member(Quote, UnescapedString) + -> concat(["'", UnescapedString, "'"], Escaped) + ; escape_backslashes(UnescapedString, Escaped) + ) + ; escape_aux(Unescaped, Escaped) + ). +escape_aux(variable(Name), Escaped) :- + concat(["${", Name, "}"], Escaped). +escape_aux(A + B , Escaped) :- + escape(A, AEscaped), + append(AEscaped, BEscaped, Escaped), + escape(B, BEscaped). +escape_aux(A +/+ B , Escaped) :- + escape(A, AEscaped), + escape(B, BEscaped), % (can't make this into a tail-call + % because the l_strinp/3 call needs to + % run afterwards) + r_strip("/", AEscaped, AStripped), + l_strip("/", BEscaped, BStripped), + concat([AStripped, "/", BStripped], Escaped). + +escape_n(X, Name) :- escape(X, String), name(Name, String). + +% list_escape(Unescapeds,Escapeds) :- +% maplist(escape,Unescapeds,Escapeds) check_returncode(Tokens, TokensChecked) :- append(Tokens, ["||", "exit", "$?"], TokensChecked). @@ -122,9 +254,9 @@ ) ). -%%%%%%%%%%%%%%%%%%%%%% -% Gentoo stuff below % -%%%%%%%%%%%%%%%%%%%%%% +% +% Gentoo stuff below +% site_conf_file(Name, Dir +/+ Name) :- site_conf_dir(Dir). @@ -431,9 +563,9 @@ [chroot(Dir, ['/root/prosys/build_stage4.sh'])], create_stage(Name + '_stage4-p' + PortageVer, Dir). -%%%%%%%%%%% -% targets % -%%%%%%%%%%% +% +% targets +% target(Commands, Name, Dir) :- phrase(target(Name, Dir), Commands).