1/* Part of LogicMOO Base Logicmoo Debug Tools
    2% ===================================================================
    3% File '$FILENAME.pl'
    4% Purpose: An Implementation in SWI-Prolog of certain debugging tools
    5% Maintainer: Douglas Miles
    6% Contact: $Author: dmiles $@users.sourceforge.net ;
    7% Version: '$FILENAME.pl' 1.0.0
    8% Revision: $Revision: 1.1 $
    9% Revised At:  $Date: 2002/07/11 21:57:28 $
   10% Licience: LGPL
   11% ===================================================================
   12*/
   13% File: /opt/PrologMUD/pack/logicmoo_base/prolog/logicmoo/util/logicmoo_util_filestreams.pl
   14:- module(logicmoo_util_filestreams,
   15          [ copy_stream/2,
   16            file_to_stream/2,
   17            file_to_stream_ssl_verify/5,
   18            ensure_loaded_with/2,
   19            when_file_output/1,
   20            l_open_input/2,
   21            l_open_input0/2,
   22            l_open_input1/2,
   23      %      make_socket/3,
   24         reread_vars/3,
   25         ensure_translated_with/3,
   26      %      negotiate_http_connect/2,
   27       %     ssl_failed/3,
   28       %     ssl_protocol_hook/4,
   29            text_to_stream/2,
   30            l_open_output/2,
   31            is_openable/1,
   32            with_stream_pos/2
   33          ]).   34
   35:- meta_predicate(ensure_loaded_with(:,3)).   36% % % OFF :- system:use_module(library(logicmoo_startup)).
   37% % % OFF :- system:use_module((filesystem)).
   38
   39:- multifile
   40        thread_httpd:accept_hook/2,
   41        thread_httpd:make_socket_hook/3,
   42        thread_httpd:open_client_hook/5,
   43        http:open_options/2,
   44        package_path/2.   45:- meta_predicate((
   46        with_stream_pos(+, 0),
   47        when_file_output(0),
   48        ensure_translated_with(:,0,?))).   49:- module_transparent
   50        copy_stream/2,
   51        file_to_stream/2,
   52        file_to_stream_ssl_verify/5,
   53        ensure_translated_with/3,
   54        l_open_input/2,
   55        l_open_input0/2,
   56        l_open_input1/2,
   57     %   make_socket/3,
   58     %   negotiate_http_connect/2,
   59        package_path/2,
   60     %   ssl_failed/3,
   61     %   ssl_protocol_hook/4,
   62        text_to_stream/2.   63
   64:- set_module(class(library)).   65
   66protected_op(_,',').
   67with_operators(Ops,Goal):- setup_call_cleanup(push_operators(Ops,Undo),Goal,pop_operators(Undo)).
   68with_no_operators(Goal):- setof(op(0,Y,Z),X^(current_op(X,Y,Z),\+ protected_op(Y,Z)),Zero), with_operators(Zero,Goal).
   69with_only_operators(Ops,Goal):-  with_no_operators(with_operators(Ops,Goal)).
   70
   71
   72% :- use_module(library(gui_tracer)).
   73:- use_module(library(system)).   74:- use_module(library(socket)).   75:- use_module(library(readutil)).   76:- abolish(system:time/1).   77:- use_module(library(statistics)).   78:- use_module(library(codesio)).   79:- use_module(library(charsio)).   80:- use_module(library(gensym)).   81:- use_module(library(when)).   82:- use_module(library(ssl)).   83:- use_module(library(prolog_codewalk)).   84:- use_module(library(prolog_source)).   85:- use_module(library(date)).   86%:- use_module(library(editline)).
   87:- use_module(library(listing)).   88
   89:- meta_predicate each_single(2,*).   90:- meta_predicate translate_file_stream(3,*,*,*,*).   91:- meta_predicate translate_file0(3,*,*,*,*),translate_file(3,*,*).   92:- meta_predicate reread_vars(*,2,*).   93
   94
   95l_open_output(File,Out):- \+ atom(File), absolute_file_name(File,Name),!,open(Name,write,Out,[alias(Name)]).
   96l_open_output(File,Out):- is_stream(File),!,Out=File.
   97l_open_output(File,Out):- stream_property(Out,alias(File)),!.
   98l_open_output(File,Out):- stream_property(Out,file_name(File)),!.
   99l_open_output(File,Out):- absolute_file_name(File,Name),!,open(Name,write,Out,[alias(Name)]).
  100
  101translate_file(With,Module:InF,OutF):-
  102  translate_file0(With,Module,InF,OutF,[]).
  103
  104translate_file0(With,Module,InF,OutF,Options):-
  105  setup_call_cleanup(l_open_input(InF,In),
  106  setup_call_cleanup(l_open_output(OutF,Out),
  107                     ((must_be(stream,In),must_be(stream,Out),
  108                     translate_file_stream(With,Module,In,Out,Options))),
  109  ( \+ is_stream(OutF)->close(Out);true)),
  110   ( \+ is_stream(InF)->close(In);true)).
  111
  112translate_file_stream(With,Module,In,Out,Options):-  
  113  Key = '$translate_file_steam',
  114  % Info = translate_file_stream(With,Module,In,Out,Expanded,Options),
  115  % b_setval(Key,Info),
  116  % nb_linkval(Key,Info),
  117  ignore((once(call(With,Key,Info,Out1)),once(write_translation(Out,Out1)))),  
  118  repeat,
  119   % trans_read_source_term(Module,In,Wff,Expanded,[variable_names(Vs)|Options]),
  120   trans_read_source_term(Module,In,Wff,_Expanded,[variable_names(Vs)|Options]),
  121   once(call(With,Wff-Vs,Info,WffO)),
  122   once(write_translation(Out,WffO)),
  123   (end_of_file == Wff; end_of_file == WffO),!.
  124
  125
  126trans_read_source_term(M, In, Term, Term, Options):- !,
  127   read_clause(In, Term, [ module(M)| Options ]).
  128
  129:- ensure_loaded(library(prolog_source)).  130trans_read_source_term(M, In, Term, Expanded, Options) :-
  131    prolog_source:maplist(prolog_source:read_clause_option, Options),
  132    !,
  133 prolog_source:(
  134    select_option(subterm_positions(TermPos), Options,
  135                  RestOptions, TermPos),
  136    read_clause(In, Term,
  137                [ subterm_positions(TermPos)
  138                | RestOptions
  139                ]),
  140    logicmoo_util_filestreams:expand_unlikely(Term, TermPos, In, Expanded),
  141    update_state(Term, Expanded, M)).
  142trans_read_source_term(M, In, Term, Expanded, Options) :-
  143 prolog_source:(
  144    select_option(syntax_errors(SE), Options, RestOptions0, dec10),
  145    select_option(subterm_positions(TermPos), RestOptions0,
  146                  RestOptions, TermPos),
  147    (   style_check(?(singleton))
  148    ->  FinalOptions = [ singletons(warning) | RestOptions ]
  149    ;   FinalOptions = RestOptions
  150    ),
  151    read_term(In, Term,
  152              [ module(M),
  153                syntax_errors(SE),
  154                subterm_positions(TermPos)
  155              | FinalOptions
  156              ]),
  157    logicmoo_util_filestreams:expand_unlikely(Term, TermPos, In, Expanded),
  158    update_state(Term, Expanded, M)).
  159
  160expand_unlikely(Term, TermPos, In, Expanded):-
  161  b_setval('$term', Term),
  162  prolog_source:expand(Term, TermPos, In, Expanded),
  163  b_setval('$term', []).
  164
  165write_translation(Out,Wff):- must_be(nonvar,Wff), is_list(Wff),!,maplist(write_translation(Out),Wff).
  166write_translation(Out,end_of_file):-!,flush_output(Out),!.
  167write_translation(Out,flush_output):-!,flush_output(Out),!.
  168write_translation(_Ut,call(Goal)):-!,call(Goal).
  169write_translation(Out,Wff-Vs):- !, must(is_list(Vs)), 
  170  wto(Out,Wff,[variable_names(Vs),portrayed(true),quoted(true),fullstop(true),ignore_ops(true),nl(true),singletons(false)]).
  171write_translation(Out,Wff):- nb_current('$variable_names',Vs),
  172  wto(Out,Wff,[variable_names(Vs),portrayed(true),quoted(true),fullstop(true),ignore_ops(true),nl(true),singletons(false)]).
  173
  174:-thread_initialization(nb_setval('$ra5_often',1)).  175
  176:- export(when_file_output/1).  177when_file_output(G):- (current_output(X),stream_property(X,file_name(_)))->call(G);true.
  178%when_file_output(G):- (current_output(X),stream_property(X,alias(user_output)))->true;call(G).
  179
  180wto(Out,Wff,Opts):- 
  181 write_term(Out,Wff,Opts),!,
  182   when_file_output(
  183   ignore((b_getval('$ra5_often',Often),
  184   once((((nb_current('$has_var',t);nb_current('$has_quote',t);Often=1;(flag('$ett',X,X+1),0 is X rem Often))))),
  185   write_term(user_output,Wff,Opts)))).
  186
  187file_newer(NamePl,Name):- exists_file(NamePl),exists_file(Name), 
  188  time_file(NamePl,T1),time_file(Name,T2),!,T1>T2.
  189
  190file_needs_rebuilt(NamePl,Name):- \+ file_newer(NamePl,Name).
  191file_needs_rebuilt(NamePl,Name):- size_file(NamePl,S1), (S1< 1000 ;
  192 (size_file(Name,S2), Thresh is S2 * 0.50,!,S1<Thresh)).
  193
  194ensure_loaded_with(ModuleFile,With):-   
  195   strip_module(ModuleFile,Module,File),
  196      absolute_file_name(File,Name),
  197      ensure_translated_with(ModuleFile,With,NamePl),
  198      locally(set_prolog_flag(do_renames,never),
  199      time(Module:load_files([NamePl],[derived_from(Name),if(not_loaded),redefine_module(false),qcompile(auto)]))).
  200
  201ensure_translated_with(ModuleFile,With,NamePl):-   
  202   strip_module(ModuleFile,Module,File),
  203      absolute_file_name(File,Name),
  204      ignore((var(NamePl),
  205      file_name_extension(Base,Ext,Name),atomic_list_concat([Base,'-trans.',Ext],NamePl))),
  206      (file_needs_rebuilt(NamePl,Name)->
  207        (dmsg(start(translate_file(With,Module:Name,NamePl))),
  208        translate_file(With,Module:Name,NamePl),
  209        dmsg(complete(translate_file(With,Module:Name,NamePl))));
  210        dmsg(unneeded(translate_file(With,Module:Name,NamePl)))).
  211
  212
  213:- export(with_stream_pos/2).  214:- meta_predicate(with_stream_pos(+,0)).  215
  216:- export(reread_vars/3).  217
  218reread_vars(P-VsIn,SVC,Wff-VsO):-
  219   wt(string(S),P,VsIn),
  220   catch(read_term_from_atom(S,Wff,[module(user),double_quotes(string),variable_names(Vs),singletons(Singles)]),
  221         E,trace_or_throw(error(E,P-VsIn))),
  222   must(\+ \+ Wff=P),
  223   maplist(each_single(SVC),Singles),
  224   subtract_eq(Vs,Singles,VsO).
  225
  226each_single(CB,N=V):-call(CB,N,V).
  227
  228%rt(string(In),WffO,VsO):-!,catch(read_term_from_atom(In,Wff,[module(user),double_quotes(string),variable_names(Vs),singletons(Singles)]),E,(dmsg(E),dtrace,fail)),correct_singletons(Wff,WffO,Vs,Singles,VsO).
  229%rt(In,WffO,VsO):- catch(read_term(In,Wff,[module(user),double_quotes(string),variable_names(Vs),singletons(Singles)]),E,(dmsg(E),dtrace,fail)),correct_singletons(Wff,WffO,Vs,Singles,VsO).
  230wt(string(O),P,Vs):- !, with_output_to(string(O), write_term(P,[variable_names(Vs),portrayed(true),quoted(true),fullstop(true),ignore_ops(true),nl(true),singletons(false)])).
  231wt(O,P,Vs):- write_term(O,P,[variable_names(Vs),portrayed(true),quoted(true),fullstop(true),ignore_ops(true),nl(true),singletons(false)]).
 with_stream_pos(+In, :Goal) is semidet
If Goal fails or exceptions then the Stream Postion is reset.
  238with_stream_pos(In,Call):-
  239    must((stream_property(In, position(InitalPos)),
  240    PS = position(InitalPos))),
  241    (Call *-> 
  242       (stream_property(In,position(NewPos)),nb_setarg(1,PS,NewPos)) ; 
  243       ((arg(1,PS,Pos),set_stream_position_safe(In, Pos),!,fail))).
  244
  245set_stream_position_safe(In,Pos):- catch(set_stream_position(In,Pos),
  246   error(permission_error(reposition, stream, In),Cxt),dmsg(warn(error(permission_error(reposition, stream, In),Cxt)))).
  247
  248:- export(l_open_input/2).  249:- export(l_open_input0/2).  250:- export(l_open_input1/2).  251
  252%= 	 	 
 l_open_input(?InS, ?In) is semidet
(list Version) Open Input.
  258l_open_input(InS,In):-once(must(l_open_input0(InS,In))).
  259
  260
  261%= 	 	 
 l_open_input0(?In, ?InS) is semidet
(list Version) Open Input Primary Helper.
  267l_open_input0(In,InS):-l_open_input1(In,InS),!.
  268l_open_input0(InS,In):-string(InS),!,open_string(InS,In).
  269l_open_input0(Filename,In) :- \+ is_list(Filename),nonvar(Filename),filematch(Filename,File), file_open_read(File,In).
  270l_open_input0(InS,In):-!,open_string(InS,In).
  271
  272
  273
  274
  275is_openable(In):-ground(In),is_openable1(In),!.
  276is_openable1(In):-is_stream(In).
  277is_openable1(In):-string(In).
  278is_openable1(In):-exists_source(In).
  279is_openable1(In):-catch(text_to_string(In,Out),_,fail),!,In\==Out.
  280is_openable1(In):- compound(In),!,functor(In,F,1),arg(_,v(file,atom,string,alias,codes,chars),F).
  281
  282
  283%= 	 	 
 l_open_input1(:TermInS, ?In) is semidet
(list Version) Open Input Secondary Helper.
  289l_open_input1([V|_],_):-var(V),V=zzzzzzzzzzzzz,!,throw(error(l_open_input/2,'Arguments are not sufficiently instantiated (l_open_input)')).
  290l_open_input1(InS,In):-is_stream(InS),!,In=InS.
  291l_open_input1(file(Filename),In) :- filematch(Filename,File), file_open_read(File,In).
  292l_open_input1(alias(Name),In) :- stream_property(In,alias(Name)),!.
  293l_open_input1(alias(Filename),In) :-  catch(see(Filename),_,fail),current_input(In).
  294l_open_input1(string(string(InS)),In):-!,dmsg_text_to_string_safe(InS,Str),string_codes(Str,Codes),open_chars_stream(Codes,In).
  295l_open_input1(string(InS),In):-!,open_string(InS,In).
  296l_open_input1(atom(InS),In):-!,open_string(InS,In).
  297l_open_input1(codes(InS),In):-!,open_string(InS,In).
  298l_open_input1(chars(InS),In):-!,open_string(InS,In).
  299
  300
  301file_open_read(File,In):-catch(see(File),_,fail),current_input(In).
  302file_open_read(File,In):-catch(open(File,read,In,[]),_,fail),!,see(In),current_input(In).
  303file_open_read(File,In):-open(File,read,In,[]),!,see(In),current_input(In).
  304
  305% % % OFF :- system:use_module(library(url)).
  306
  307/*
  308% % % OFF :- system:use_module(library(http/http_ssl_plugin)).
  309*/
  310
  311% :- module(http_ssl_plugin, []).
  312% % % OFF 
  313:- if(exists_source(library(ssl))).  314% % TODO :- system:use_module(library(ssl),[]).
  315:- endif.  316
  317% % % OFF :- system:use_module(library(socket),[]).
  318% % % OFF :- system:use_module(library(debug),[]).
  319% % % OFF :- system:use_module(library(option),[]).
  320% % TODO  :- system:use_module(library(http/thread_httpd),[]).
  321% % % OFF 
  322% % TODO  :- system:use_module(library(http/http_header)).
  323
  324/* Part of LogicMOO Base SSL plugin for HTTP libraries
  325
  326This  module  can  be   loaded    next   to   library(thread_httpd)  and
  327library(http_open) to provide secure HTTP   (HTTPS)  services and client
  328access.
  329
  330An example secure server using self-signed  certificates can be found in
  331the <plbase>/doc/packages/examples/ssl/https.pl, where <plbase>   is the
  332SWI-Prolog installation directory.
  333*/
  334
  335:- multifile
  336	thread_httpd:make_socket_hook/3,
  337	thread_httpd:accept_hook/2,
  338	thread_httpd:open_client_hook/5,
  339        http:http_protocol_hook/5,
  340	http:open_options/2,
  341	http:http_connection_over_proxy/6.  342
  343
  344		 /*******************************
  345		 *	    SERVER HOOKS	*
  346		 *******************************/
  347/*
  348%%	thread_httpd:make_socket_hook(?Port, :OptionsIn, -OptionsOut)
  349%%								is semidet.
  350%
  351%	Hook into http_server/2 to create an   SSL  server if the option
  352%	ssl(SSLOptions) is provided.
  353%
  354%	@see thread_httpd:accept_hook/2 handles the corresponding accept
  355%
  356%
  357% Hook To [thread_httpd:make_socket_hook/3] For Module Logicmoo_util_filestreams.
  358% Make Socket Hook.
  359%
  360thread_httpd:make_socket_hook(Port, Options0, Options) :- thread_httpd_make_socket_hook(Port, Options0, Options).
  361
  362thread_httpd_make_socket_hook(Port, M:Options0, Options) :-
  363	memberchk(ssl(SSLOptions), Options0), !,
  364	make_socket(Port, Socket, Options0),
  365	ssl_context(server,
  366                    SSL,
  367                    M:[ port(Port),
  368                        close_parent(true)
  369                      | SSLOptions
  370                      ]),
  371	atom_concat('httpsd', Port, Queue),
  372	Options = [ queue(Queue),
  373                    tcp_socket(Socket),
  374		    ssl_instance(SSL)
  375		  | Options0
  376		  ].
  377
  378
  379%= 	 	 
  380
  381%% make_socket( ?Port, ?Socket, ?Options) is semidet.
  382%
  383% Hook To [thread_httpd:make_socket/3] For Module Logicmoo_util_filestreams.
  384% Make Socket.
  385%
  386make_socket(_Port, Socket, Options) :-
  387	option(tcp_socket(Socket), Options), !.
  388make_socket(Port, Socket, _Options) :-
  389	tcp_socket(Socket),
  390	tcp_setopt(Socket, reuseaddr),
  391	tcp_bind(Socket, Port),
  392	tcp_listen(Socket, 5).
  393
  394
  395%%	thread_httpd:accept_hook(:Goal, +Options) is semidet.
  396%
  397%	Implement the accept for HTTPS connections.
  398% 
  399% Hook To [thread_httpd:accept_hook/2] For Module Logicmoo_util_filestreams.
  400% Accept Hook.
  401%
  402thread_httpd:accept_hook(Goal, Options) :-
  403	memberchk(ssl_instance(SSL), Options), !,
  404	memberchk(queue(Queue), Options),
  405        memberchk(tcp_socket(Socket), Options),
  406        tcp_accept(Socket, Client, Peer),
  407	debug(http(connection), 'New HTTPS connection from ~p', [Peer]),
  408	thread_httpd:http_enough_workers(Queue, accept, Peer),
  409	thread_send_message(Queue, ssl_client(SSL, Client, Goal, Peer)).
  410
  411
  412%= 	 	 
  413
  414%% thread_httpd:open_client_hook( :TermSSL, ?Goal, ?In, ?Out, ?Peer) is semidet.
  415%
  416% Hook To [thread_httpd:open_client_hook/5] For Module Logicmoo_util_filestreams.
  417% Open Client Hook.
  418%
  419thread_httpd:open_client_hook(ssl_client(SSL, Client, Goal, Peer),
  420			      Goal, In, Out,
  421			      [peer(Peer), protocol(https)]) :-
  422        tcp_open_socket(Client, Read, Write),
  423	catch(ssl_negotiate(SSL, Read, Write, In, Out),
  424	      E,
  425	      ssl_failed(Read, Write, E)).
  426
  427
  428%= 	 	 
  429
  430%% ssl_failed( ?Read, ?Write, ?E) is semidet.
  431%
  432% Ssl Failed.
  433%
  434ssl_failed(Read, Write, E) :-
  435	close(Write, [force(true)]),
  436	close(Read,  [force(true)]),
  437	throw(E).
  438
  439*/
  440  /*
  441		 /*******************************
  442		 *	   CLIENT HOOKS		*
  443		 *******************************/
  444
  445%	http:http_protocol_hook(+Scheme, +Parts, +PlainStreamPair,
  446%				-StreamPair, +Options) is semidet.
  447%
  448%	Hook for http_open/3 to connect  to   an  HTTPS (SSL-based HTTP)
  449%	server.   This   plugin   also   passes   the   default   option
  450%	`cacert_file(system(root_certificates))` to ssl_context/3.
  451%
  452% Hook To [http:http_protocol_hook/5] For Module Logicmoo_util_filestreams.
  453%
  454http:http_protocol_hook(https, Parts, PlainStreamPair, StreamPair, Options):-
  455	ssl_protocol_hook(Parts, PlainStreamPair, StreamPair, Options).
  456
  457
  458%= 	 	 
  459
  460%% ssl_protocol_hook( ?Parts, ?PlainStreamPair, ?StreamPair, ?Options) is semidet.
  461%
  462% Ssl Protocol Hook.
  463%
  464ssl_protocol_hook(Parts, PlainStreamPair, StreamPair, Options) :-
  465        memberchk(host(Host), Parts),
  466        option(port(Port), Parts, 443),
  467	ssl_context(client, SSL, [ host(Host),
  468                                   port(Port),
  469                                   close_parent(true)
  470				 | Options
  471				 ]),
  472        stream_pair(PlainStreamPair, PlainIn, PlainOut),
  473        catch(ssl_negotiate(SSL, PlainIn, PlainOut, In, Out),
  474              Exception,
  475              ( ssl_exit(SSL, PlainIn, PlainOut, In, Out), throw(Exception)) ),
  476        stream_pair(StreamPair, In, Out).
  477
  478ssl_exit(SSL, _PlainIn, _PlainOut, In, Out):- safely_try_close(Out),safely_try_close(In),safely_try_close(SSL).
  479*/
  480safely_try_close(Out):- ignore(catch(close(Out),_,true)).
  481/*
  482%	http:open_options(Parts, Options) is nondet.
  483%  
  484%  Hook To [http:open_options/2] For Module Logicmoo_util_filestreams.
  485%
  486%	Implementation of the multifile hook http:open_options/2 used by
  487%	library(http/http_open). By default, we use   the system trusted
  488%	root certificate database for validating an SSL certificate.
  489http:open_options(Parts, Options) :-
  490	memberchk(scheme(https), Parts),
  491	Options = [cacert_file(system(root_certificates))].
  492
  493%	http:http_connection_over_proxy(+Proxy, +Parts, +HostPort, -StreamPair, +OptionsIn, -OptionsOut)
  494%
  495%	Facilitate an HTTPS connection via a   proxy using HTTP CONNECT.
  496%	Note that most proxies will only  support this for connecting on
  497%	port 443
  498%
  499%  Hook To [http:http_connection_over_proxy/6] For Module Logicmoo_util_filestreams.
  500http:http_connection_over_proxy(proxy(ProxyHost, ProxyPort), Parts,
  501				Host:Port, StreamPair, Options, Options) :-
  502        memberchk(scheme(https), Parts), !,
  503        tcp_connect(ProxyHost:ProxyPort, StreamPair, [bypass_proxy(true)]),
  504        catch(negotiate_http_connect(StreamPair, Host:Port),
  505              Error,
  506              ( close(StreamPair, [force(true)]),
  507                throw(Error)
  508              )).
  509
  510% % % OFF :- system:use_module(library(http/http_open),[]).
  511
  512
  513%= 	 	 
  514
  515%% negotiate_http_connect( ?StreamPair, ?Address) is semidet.
  516%
  517% Negotiate Http Connect.
  518%
  519negotiate_http_connect(StreamPair, Address):-
  520        format(StreamPair, 'CONNECT ~w HTTP/1.1\r\n\r\n', [Address]),
  521        flush_output(StreamPair),
  522        http_read_reply_header(StreamPair, Header),
  523        memberchk(status(_, Status, Message), Header),
  524        (   Status == ok
  525	->  true
  526        ;   throw(error(proxy_rejection(Message), _))
  527        ).
  528*/
  529
  530:- multifile(package_path/2).  531
  532%= 	 	 
 package_path(?Pkg, ?PkgPath) is semidet
Package Path.
  538package_path(Pkg,PkgPath):-expand_file_search_path(pack(Pkg),PkgPathN),exists_directory(PkgPathN),normalize_path(PkgPathN,PkgPath).
  539package_path(Pkg,PkgPath):-atom(Pkg),T=..[Pkg,'.'],expand_file_search_path(T,PkgPathN),exists_directory(PkgPathN),normalize_path(PkgPathN,PkgPath).
  540
  541
  542%= 	 	 
 file_to_stream_ssl_verify(?SSL, ?ProblemCert, ?AllCerts, ?FirstCert, ?Error) is semidet
File Converted To Stream Ssl Verify.
  548file_to_stream_ssl_verify(_SSL, _ProblemCert, _AllCerts, _FirstCert, _Error) :- !.
  549
  550
  551:- export(text_to_stream/2).  552
  553%= 	 	 
 text_to_stream(?Text, ?Stream) is semidet
Text Converted To Stream.
  559text_to_stream(Text,Stream):-text_to_string(Text,String),string_codes(String,Codes),open_codes_stream(Codes,Stream).
  560:- export(file_to_stream/2).  561
  562%= 	 	 
 file_to_stream(:TermStreamIn, ?Stream) is semidet
File Converted To Stream.
  568file_to_stream((StreamIn),Stream):-is_stream(StreamIn),!,copy_stream(StreamIn,Stream).
  569file_to_stream(stream(StreamIn),Stream):-copy_stream(StreamIn,Stream).
  570file_to_stream('$socket'(Sock),Stream):-tcp_open_socket('$socket'(Sock),StreamIn),copy_stream(StreamIn,Stream).
  571file_to_stream(term(Text),Stream):-term_to_atom(Text,String),string_codes(String,Codes),open_codes_stream(Codes,Stream).
  572file_to_stream(text(Text),Stream):-text_to_stream(Text,Stream).
  573file_to_stream(codes(Text),Stream):-text_to_stream(Text,Stream).
  574file_to_stream(chars(Text),Stream):-text_to_stream(Text,Stream).
  575file_to_stream(atom(Text),Stream):-text_to_stream(Text,Stream).
  576file_to_stream(string(Text),Stream):-text_to_stream(Text,Stream).
  577file_to_stream(alias(Text),Stream):-stream_property(Stream,alias(Text)).
  578file_to_stream(file(Spec),Stream):-file_to_stream(match(Spec),Stream).
  579file_to_stream(exfile(File),Stream):- size_file(File,Size),Max is 2^20*64, 
  580 (Size<Max->
  581     (read_file_to_codes(File,Codes,[expand(true)]),open_codes_stream(Codes,Stream));
  582      open(File,read,Stream,[])).
  583
  584file_to_stream(match(Spec),Stream):-!,filematch(Spec,File),exists_file(File),!,file_to_stream(exfile(File),Stream).
  585file_to_stream(package(Pkg,LocalPath),Stream) :-!,
  586   package_path(Pkg,PkgPath),
  587   % build global path
  588   atomic_list_concat([PkgPath|LocalPath], '/',  GlobalPath),file_to_stream(GlobalPath,Stream).
  589file_to_stream(Spec,Stream):-compound(Spec),!,file_to_stream(match(Spec),Stream).
  590file_to_stream(URL,Stream):-sub_string(URL,_,_,_,":/"),sub_string(URL,0,4,_,'http'), !, if_defined(http_open:http_open(URL,HTTP_Stream,[ cert_verify_hook(file_to_stream_ssl_verify)]),fail),copy_stream(HTTP_Stream,Stream),!.
  591file_to_stream(URL,Stream):-atom_concat('file://', File, URL),!,file_to_stream(File,Stream).
  592file_to_stream(URL,Stream):-atom_concat('file:', File, URL),!,file_to_stream(File,Stream).
  593file_to_stream(URL,Stream):-on_x_fail(atomic_list_concat(['package://',Pkg,'/', Path], URL)),file_to_stream(package(Pkg,Path),Stream).
  594file_to_stream(URL,Stream):-on_x_fail(atomic_list_concat([Pkg,'://',Path],URL)),file_to_stream(package(Pkg,Path),Stream).
  595file_to_stream(Spec,Stream):-file_to_stream(match(Spec),Stream).
  596
  597:- export(copy_stream/2).  598
  599%= 	 	 
 copy_stream(?HTTP_Stream, ?Stream) is semidet
Copy Stream.
  605copy_stream(HTTP_Stream,Stream):-read_stream_to_codes(HTTP_Stream,Codes),catch(close(HTTP_Stream),_,true),open_codes_stream(Codes,Stream).
  606
  607:- fixup_exports.