kibi-swipl-linux-x64-gnu 1.0.0

package/lib/swipl/library/ext/http/http/http_log.pl

@@ -0,0 +1,738 @@
+/*  Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        J.Wielemaker@vu.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (c)  2008-2025, University of Amsterdam
+                              VU University Amsterdam
+                              CWI, Amsterdam
+                              SWI-Prolog Solutions b.v.
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in
+       the documentation and/or other materials provided with the
+       distribution.
+
+    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+*/
+
+:- module(http_log,
+          [ http_log_stream/1,          % -Stream
+            http_log/2,                 % +Format, +Args
+            http_log_close/1,           % +Reason
+            post_data_encoded/2,        % ?Bytes, ?Encoded
+            http_logrotate/1,           % +Options
+            http_schedule_logrotate/2   % +When, +Options
+          ]).
+:- use_module(library(http/http_header)).
+:- use_module(library(settings)).
+:- use_module(library(option)).
+:- use_module(library(error)).
+:- use_module(library(debug)).
+:- use_module(library(broadcast)).
+
+:- setting(http:logfile, callable, 'httpd.log',
+           'File in which to log HTTP requests').
+:- setting(http:log_post_data, integer, 0,
+           'Log POST data up to N bytes long').
+:- setting(http:on_log_error, any, retry,
+           'Action if logging fails').
+
+/** <module> HTTP Logging module
+
+Simple module for logging HTTP requests to a file. Logging is enabled by
+loading this file and ensure the setting   http:logfile is not the empty
+atom. The default  file  for  writing   the  log  is  =|httpd.log|=. See
+library(settings) for details.
+
+The  level of  logging  can be modified  using  the  multifile predicate
+http_log:nolog/1 to hide HTTP  request  fields   from  the  logfile  and
+http_log:password_field/1   to   hide   passwords   from   HTTP   search
+specifications (e.g. =|/topsecret?password=secret|=).
+*/
+
+:- multifile
+    nolog/1,
+    password_field/1,
+    nolog_post_content_type/1.
+
+% If the log settings change,  simply  close   the  log  and  it will be
+% reopened with the new settings.
+
+:- listen(settings(changed(http:logfile, _, New)),
+          http_log_close(changed(New))).
+:- listen(http(Message),
+          http_message(Message)).
+:- listen(logrotate,
+          http_log_close(logrotate)).
+
+http_message(Message) :-
+    log_message(Message),
+    http_log_stream(Stream),
+    E = error(_,_),
+    catch(http_message(Message, Stream), E,
+          log_error(E)).
+
+log_message(request_start(_Id, _Request)).
+log_message(request_finished(_Id, _Code, _Status, _CPU, _Bytes)).
+
+http_message(request_start(Id, Request), Stream) :-
+    log_started(Request, Id, Stream).
+http_message(request_finished(Id, Code, Status, CPU, Bytes), Stream) :-
+    log_completed(Code, Status, Bytes, Id, CPU, Stream).
+
+%!  log_error(+Error)
+%
+%   There was an error writing the  log   file.  The  message is printed
+%   using print_message/2 and  execution  continues   according  to  the
+%   setting `http:on_log_error`, which is one of:
+%
+%     - retry
+%       Close the log file. The system will try to reopen it on the
+%       next log event, recovering from the error. Note that the
+%       most common case for this is probably running out of disc space.
+%     - exit
+%     - exit(Code)
+%       Stop the server using halt(Code). The `exit` variant is
+%       equivalent to exit(1).
+%
+%   The best choice depends on  your   priorities.  Using  `retry` gives
+%   priority to keep the server running.  Using `exit` guarantees proper
+%   log files and  thus  the  ability   to  examine  these  for security
+%   reasons. An attacker may try to flood the disc, causing a successful
+%   DoS attack if `exit` is used  and   the  ability to interact without
+%   being logged if `retry` is used.
+
+log_error(E) :-
+    print_message(warning, E),
+    log_error_continue.
+
+log_error_continue :-
+    setting(http:on_log_error, Action),
+    log_error_continue(Action).
+
+log_error_continue(retry) :-
+    http_log_close(error).
+log_error_continue(exit) :-
+    log_error_continue(exit(1)).
+log_error_continue(exit(Code)) :-
+    halt(Code).
+
+
+
+                 /*******************************
+                 *         LOG ACTIVITY         *
+                 *******************************/
+
+:- dynamic
+    log_stream/2,                   % Stream, TimeTried
+    halt_registered/0.
+
+%!  http_log_stream(-Stream) is semidet.
+%
+%   True when Stream is a stream to the  opened HTTP log file. Opens the
+%   log file in `append` mode if the file  is not yet open. The log file
+%   is determined from the setting ``http:logfile``.  If this setting is
+%   set to the empty atom (''), this predicate fails.
+%
+%   If  a  file  error  is   encountered,    this   is   reported  using
+%   print_message/2, after which this predicate  silently fails. Opening
+%   is retried every minute when a new message arrives.
+%
+%   Before opening the log  file,   the  message  http_log_open(Term) is
+%   broadcasted.  This  message  allows  for   creating  the  directory,
+%   renaming, deleting or truncating an existing log file.
+
+http_log_stream(Stream) :-
+    log_stream(Stream, _Opened),
+    !,
+    Stream \== [].
+http_log_stream([]) :-
+    setting(http:logfile, ''),
+    !,
+    get_time(Now),
+    assert(log_stream([], Now)),
+    fail.
+http_log_stream(Stream) :-
+    setting(http:logfile, Term),
+    broadcast(http_log_open(Term)),
+    catch(absolute_file_name(Term, File,
+                             [ access(append)
+                             ]),
+          E, open_error(E)),
+    with_mutex(http_log, open_log(File, Stream0)),
+    Stream = Stream0.
+
+open_log(_File, Stream) :-
+    log_stream(Stream, Opened),
+    (   Stream == []
+    ->  (   get_time(Now),
+            Now - Opened > 60
+        ->  retractall(log_stream(_,_)),
+            fail
+        ;   !, fail
+        )
+    ;   true
+    ), !.
+open_log(File, Stream) :-
+    catch(open(File, append, Stream,
+               [ close_on_abort(false),
+                 encoding(utf8),
+                 buffer(line)
+               ]), E, open_error(E)),
+    get_time(Time),
+    register_close_log,
+    Error = error(_,_),
+    catch(format(Stream,
+                 'server(started, ~0f).~n',
+                 [ Time ]),
+          Error,
+          open_error(Stream, Error)),
+    assert(log_stream(Stream, Time)).
+
+open_error(Stream, E) :-
+    close(Stream, [force(true)]),
+    open_error(E).
+
+open_error(E) :-
+    print_message(error, E),
+    log_open_error_continue.
+
+log_open_error_continue :-
+    setting(http:on_log_error, Action),
+    log_open_error_continue(Action).
+
+log_open_error_continue(retry) :-
+    !,
+    get_time(Now),
+    assert(log_stream([], Now)),
+    fail.
+log_open_error_continue(Action) :-
+    log_error_continue(Action).
+
+register_close_log :-
+    halt_registered,
+    !.
+register_close_log :-
+    at_halt(close_log(stopped)),
+    asserta(halt_registered).
+
+%!  http_log_close(+Reason) is det.
+%
+%   If there is a currently open HTTP logfile, close it after adding
+%   a term server(Reason, Time).  to  the   logfile.  This  call  is
+%   intended for cooperation with the Unix logrotate facility
+%   using the following schema:
+%
+%       * Move logfile (the HTTP server keeps writing to the moved
+%       file)
+%       * Inform the server using an HTTP request that calls
+%       http_log_close/1
+%       * Compress the moved logfile
+%
+%   @author Suggested by Jacco van Ossenbruggen
+
+http_log_close(Reason) :-
+    with_mutex(http_log, close_log(Reason)).
+
+close_log(Reason) :-
+    retract(log_stream(Stream, _Opened)),
+    !,
+    (   is_stream(Stream)
+    ->  get_time(Time),
+        catch(( format(Stream, 'server(~q, ~0f).~n', [ Reason, Time ]),
+                close(Stream)
+              ), E, print_message(warning, E))
+    ;   true
+    ).
+close_log(_).
+
+%!  http_log(+Format, +Args) is det.
+%
+%   Write message from Format and Args   to log-stream. See format/2
+%   for details. Succeed without side  effects   if  logging  is not
+%   enabled.
+
+http_log(Format, Args) :-
+    (   http_log_stream(Stream)
+    ->  Error = error(_,_),
+        catch(system:format(Stream, Format, Args), % use operators from `system`
+              Error,
+              log_error(Error))
+    ;   true
+    ).
+
+
+%!  log_started(+Request, +Id, +Stream) is det.
+%
+%   Write log message that Request was started to Stream.
+%
+%   @arg  Filled with sequence identifier for the request
+
+log_started(Request, Id, Stream) :-
+    is_stream(Stream),
+    !,
+    get_time(Now),
+    add_post_data(Request, Request1),
+    log_request(Request1, LogRequest),
+    format_time(string(HDate), '%+', Now),
+    format(Stream,
+           '/*~s*/ request(~q, ~3f, ~q).~n',
+           [HDate, Id, Now, LogRequest]).
+log_started(_, _, _).
+
+%!  log_request(+Request, -Log)
+%
+%   Remove passwords from the request to avoid sending them to the
+%   logfiles.
+
+log_request([], []).
+log_request([search(Search0)|T0], [search(Search)|T]) :-
+    !,
+    mask_passwords(Search0, Search),
+    log_request(T0, T).
+log_request([H|T0], T) :-
+    nolog(H),
+    !,
+    log_request(T0, T).
+log_request([H|T0], [H|T]) :-
+    log_request(T0, T).
+
+mask_passwords([], []).
+mask_passwords([Name=_|T0], [Name=xxx|T]) :-
+    password_field(Name),
+    !,
+    mask_passwords(T0, T).
+mask_passwords([H|T0], [H|T]) :-
+    mask_passwords(T0, T).
+
+%!  password_field(+Field) is semidet.
+%
+%   Multifile predicate that can be defined to hide passwords from
+%   the logfile.
+
+password_field(password).
+password_field(pwd0).
+password_field(pwd1).
+password_field(pwd2).
+
+
+%!  nolog(+HTTPField)
+%
+%   Multifile  predicate  that  can  be   defined  to  hide  request
+%   parameters from the request logfile.
+
+nolog(input(_)).
+nolog(accept(_)).
+nolog(accept_language(_)).
+nolog(accept_encoding(_)).
+nolog(accept_charset(_)).
+nolog(pool(_)).
+nolog(protocol(_)).
+nolog(referer(R)) :-
+    sub_atom(R, _, _, _, password),
+    !.
+
+%!  nolog_post_content_type(+Type) is semidet.
+%
+%   Multifile hook called with the   =|Content-type|= header. If the
+%   hook succeeds, the POST data is not logged. For example, to stop
+%   logging  anything  but  application/json   messages:
+%
+%     ==
+%     :- multifile http_log:nolog_post_content_type/1.
+%
+%     http_log:nolog_post_content_type(Type) :-
+%        Type \= (application/json).
+%     ==
+%
+%   @arg Type is a term MainType/SubType
+
+%!  add_post_data(+Request0, -Request) is det.
+%
+%   Add   a   request   field   post_data(Data)   if   the   setting
+%   http:log_post_data is an integer > 0,  the content length < this
+%   setting and nolog_post_content_type/1 does not   succeed  on the
+%   provided content type.
+
+add_post_data(Request0, Request) :-
+    setting(http:log_post_data, MaxLen),
+    integer(MaxLen), MaxLen > 0,
+    memberchk(input(In), Request0),
+    memberchk(content_length(CLen), Request0),
+    CLen =< MaxLen,
+    memberchk(content_type(Type), Request0),
+    http_parse_header_value(content_type, Type, media(MType/MSubType, _)),
+    \+ nolog_post_content_type(MType/MSubType),
+    catch(peek_string(In, CLen, PostData), _, fail),
+    !,
+    post_data_encoded(PostData, Encoded),
+    Request = [post_data(Encoded)|Request0].
+add_post_data(Request, Request).
+
+%!  post_data_encoded(?Bytes:string, ?Encoded:string) is det.
+%
+%   Encode the POST body for inclusion into   the HTTP log file. The
+%   POST data is (in/de)flated  using   zopen/3  and  base64 encoded
+%   using base64//1. The encoding makes   long text messages shorter
+%   and keeps readable logfiles if binary data is posted.
+
+post_data_encoded(Bytes, Hex) :-
+    nonvar(Bytes),
+    !,
+    setup_call_cleanup(
+        new_memory_file(HMem),
+        ( setup_call_cleanup(
+              ( open_memory_file(HMem, write, Out, [encoding(octet)]),
+                zopen(Out, ZOut, [])
+              ),
+              format(ZOut, '~s', [Bytes]),
+              close(ZOut)),
+          memory_file_to_codes(HMem, Codes, octet)
+        ),
+        free_memory_file(HMem)),
+    phrase(base64(Codes), EncCodes),
+    string_codes(Hex, EncCodes).
+post_data_encoded(Bytes, Hex) :-
+    string_codes(Hex, EncCodes),
+    phrase(base64(Codes), EncCodes),
+    string_codes(ZBytes, Codes),
+    setup_call_cleanup(
+        open_string(ZBytes, In),
+        zopen(In, Zin, []),
+        read_string(Zin, _, Bytes)).
+
+%!  log_completed(+Code, +Status, +Bytes, +Id, +CPU, +Stream) is det.
+%
+%   Write log message to Stream from a call_cleanup/3 call.
+%
+%   @param Status   2nd argument of call_cleanup/3
+%   @param Id       Term identifying the completed request
+%   @param CPU0     CPU time at time of entrance
+%   @param Stream   Stream to write to (normally from http_log_stream/1).
+
+log_completed(Code, Status, Bytes, Id, CPU, Stream) :-
+    is_stream(Stream),
+    log_check_deleted(Stream),
+    !,
+    log(Code, Status, Bytes, Id, CPU, Stream).
+log_completed(Code, Status, Bytes, Id, CPU0, _) :-
+    http_log_stream(Stream),       % Logfile has changed!
+    !,
+    log_completed(Code, Status, Bytes, Id, CPU0, Stream).
+log_completed(_,_,_,_,_,_).
+
+
+log(Code, ok, Bytes, Id, CPU, Stream) :-
+    !,
+    format(Stream, 'completed(~q, ~q, ~q, ~q, ok).~n',
+           [ Id, CPU, Bytes, Code ]).
+log(Code, Status, Bytes, Id, CPU, Stream) :-
+    (   map_exception(Status, Term)
+    ->  true
+    ;   message_to_string(Status, String),
+        Term = error(String)
+    ),
+    format(Stream, 'completed(~q, ~q, ~q, ~q, ~W).~n',
+           [ Id, CPU, Bytes, Code,
+             Term, [ quoted(true),
+                     ignore_ops(true),
+                     blobs(portray),
+                     portray_goal(write_blob)
+                   ]
+           ]).
+
+:- public write_blob/2.
+write_blob(Blob, _Options) :-
+    format(string(S), '~q', [Blob]),
+    writeq(blob(S)).
+
+map_exception(http_reply(bytes(ContentType,Bytes),_), bytes(ContentType,L)) :-
+    string_length(Bytes, L).        % also does lists
+map_exception(http_reply(Reply), Reply).
+map_exception(http_reply(Reply, _), Reply).
+map_exception(error(existence_error(http_location, Location), _Stack),
+              error(404, Location)).
+
+
+                 /*******************************
+                 *      LOGROTATE SUPPORT       *
+                 *******************************/
+
+%!  log_check_deleted(+Stream) is semidet.
+%
+%   If the link-count of the stream has   dropped  to zero, the file
+%   has been deleted/moved. In this case the  log file is closed and
+%   log_check_deleted/6 will open a  new   one.  This  provides some
+%   support for cleaning up the logfile   without  shutting down the
+%   server.
+%
+%   @see logrotate(1) to manage logfiles on Unix systems.
+
+log_check_deleted(Stream) :-
+    stream_property(Stream, nlink(Links)),
+    Links == 0,
+    !,
+    http_log_close(log_file_deleted),
+    fail.
+log_check_deleted(_).
+
+%!  http_logrotate(+Options) is det.
+%
+%   Rotate the available log files. Note that  there are two ways to
+%   deal with the rotation of log files:
+%
+%     1. Use the OS log rotation facility. In that case the OS must
+%     (1) move the logfile and (2) have something calling
+%     http_log_close/1 to close the (moved) file and make this
+%     server create a new one on the next log message.  If
+%     library(http/http_unix_daemon) is used, closing is
+%     achieved by sending SIGHUP or SIGUSR1 to the process.
+%
+%     2. Call this predicate at scheduled intervals.  This can
+%     be achieved by calling http_schedule_logrotate/2 in the
+%     context of library(http/http_unix_daemon) which schedules
+%     the maintenance actions.
+%
+%   Options:
+%
+%     - min_size(+Bytes)
+%     Do not rotate if the log file is smaller than Bytes.
+%     The default is 1Mbytes.
+%     - keep_logs(+Count)
+%     Number of rotated log files to keep (default 10)
+%     - compress_logs(+Format)
+%     Compress the log files to the given format.
+%     - background(+Boolean)
+%     If `true`, rotate the log files in the background.
+
+http_logrotate(Options) :-
+    select_option(background(true), Options, Options1),
+    !,
+    thread_create(http_logrotate(Options1), _,
+                  [ alias('__logrotate'),
+                    detached(true)
+                  ]).
+http_logrotate(Options) :-
+    option(keep_logs(Keep), Options, 10),
+    option(compress_logs(Format), Options, gzip),
+    compress_extension(Format, ZExt),
+    log_file_and_ext(Base, Ext),
+    (   log_too_small(Base, Ext, Options)
+    ->  true
+    ;   rotate_logs(Base, Ext, ZExt, Keep)
+    ).
+
+rotate_logs(Base, Ext, ZExt, N1) :-
+    N1 > 0,
+    !,
+    N0 is N1 - 1,
+    old_log_file(Base, Ext, N0, ZO, Old),
+    (   exists_file(Old)
+    ->  new_log_file(Base, Ext, N1, ZO, ZExt, ZN, New),
+        rename_log_file(ZO, Old, ZN, New)
+    ;   true
+    ),
+    rotate_logs(Base, Ext, ZExt, N0).
+rotate_logs(_, _, _, _).
+
+rename_log_file(ZExt, Old, ZExt, New) :-
+    !,
+    debug(logrotate, 'Rename ~p --> ~p', [Old, New]),
+    rename_file(Old, New).
+rename_log_file('', Old, ZExt, New) :-
+    file_name_extension(NoExt, ZExt, New),
+    debug(logrotate, 'Rename ~p --> ~p', [Old, NoExt]),
+    rename_file(Old, NoExt),
+    debug(logrotate, 'Closing log file', []),
+    http_log_close(logrotate),
+    compress_extension(Format, ZExt),
+    debug(logrotate, 'Compressing (~w) ~p', [Format, NoExt]),
+    compress_file(NoExt, Format).
+
+old_log_file(Base, Ext, N, ZExt, File) :-
+    log_file(Base, Ext, N, File0),
+    (   compress_extension(_, ZExt),
+        file_name_extension(File0, ZExt, File1),
+        exists_file(File1)
+    ->  File = File1
+    ;   ZExt = '',
+        File = File0
+    ).
+
+new_log_file(Base, Ext, N, '', '', '', File) :-
+    !,
+    log_file(Base, Ext, N, File).
+new_log_file(Base, Ext, N, '', ZExt, ZExt, File) :-
+    !,
+    log_file(Base, Ext, N, File0),
+    file_name_extension(File0, ZExt, File).
+new_log_file(Base, Ext, N, ZExt, _, ZExt, File) :-
+    log_file(Base, Ext, N, File0),
+    file_name_extension(File0, ZExt, File).
+
+log_file(Base, Ext, 0, File) :-
+    !,
+    file_name_extension(Base, Ext, File).
+log_file(Base, Ext, N, File) :-
+    atomic_list_concat([Base, -, N], Base1),
+    file_name_extension(Base1, Ext, File).
+
+log_file_and_ext(Base, Ext) :-
+    setting(http:logfile, Term),
+    catch(absolute_file_name(Term, File,
+                             [ access(exist)
+                             ]), _, fail),
+    file_name_extension(Base, Ext, File).
+
+log_too_small(Base, Ext, Options) :-
+    DefMin is 1024*1024,
+    option(min_size(MinBytes), Options, DefMin),
+    file_name_extension(Base, Ext, File),
+    (   exists_file(File)
+    ->  size_file(File, Bytes),
+        Bytes < MinBytes,
+        debug(logrotate, '~w has ~D bytes; not rotating', [File, Bytes])
+    ;   debug(logrotate, '~w does not exist; not rotating', [File])
+    ).
+
+%!  compress_file(+File, +Format)
+%
+%   Compress a file according  to   Format.  Currently only supports
+%   gzip.
+
+compress_file(File, Format) :-
+    (   compress_extension(Format, Ext)
+    ->  true
+    ;   domain_error(compress_format, Format)
+    ),
+    file_name_extension(File, Ext, ZFile),
+    catch(setup_call_cleanup(
+              gzopen(ZFile, write, Out, [type(binary)]),
+              setup_call_cleanup(
+                  open(File, read, In, [type(binary)]),
+                  copy_stream_data(In, Out),
+                  close(In)),
+              close(Out)),
+          Error,
+          ( print_message(error, Error),
+            catch(delete_file(Out), _, true),
+            throw(Error)
+          )),
+    delete_file(File).
+
+compress_extension(gzip, gz).
+
+:- dynamic
+    scheduled_logrotate/2.  % Schedule, Options
+
+%!  http_schedule_logrotate(When, Options)
+%
+%   Schedule log rotation based on maintenance broadcasts.  When
+%   is one of:
+%
+%     - daily(Hour:Min)
+%     Run each day at Hour:Min.  Min is rounded to a multitude
+%     of 5.
+%     - weekly(Day, Hour:Min)
+%     Run at the given Day and Time each week.  Day is either a
+%     number 1..7 (1 is Monday) or a weekday name or abbreviation.
+%     - monthly(DayOfTheMonth, Hour:Min)
+%     Run each month at the given Day (1..31).  Note that not all
+%     months have all days.
+%
+%   This  must  be  used   with   a    timer   that   broadcasts   a
+%   maintenance(_,_) message (see broadcast/1). Such a timer is part
+%   of library(http/http_unix_daemon).
+
+http_schedule_logrotate(When, Options) :-
+    listen(maintenance(_,_), http_consider_logrotate),
+    compile_schedule(When, Schedule),
+    retractall(scheduled_logrotate(_,_)),
+    asserta(scheduled_logrotate(Schedule, Options)).
+
+compile_schedule(Var, _) :-
+    var(Var),
+    !,
+    instantiation_error(Var).
+compile_schedule(daily(Time0), daily(Time)) :-
+    compile_time(Time0, Time).
+compile_schedule(weekly(Day0, Time0), weekly(Day, Time)) :-
+    compile_weekday(Day0, Day),
+    compile_time(Time0, Time).
+compile_schedule(monthly(Day, Time0), monthly(Day, Time)) :-
+    must_be(between(0, 31), Day),
+    compile_time(Time0, Time).
+
+compile_time(HH:MM0, HH:MM) :-
+    must_be(between(0, 23), HH),
+    must_be(between(0, 59), MM0),
+    MM is ((MM0+4)//5)*5.
+
+compile_weekday(N, _) :-
+    var(N),
+    !,
+    instantiation_error(N).
+compile_weekday(N, N) :-
+    integer(N),
+    !,
+    must_be(between(1,7), N).
+compile_weekday(Day, N) :-
+    downcase_atom(Day, Lwr),
+    (   sub_atom(Lwr, 0, 3, _, Abbr),
+        day(N, Abbr)
+    ->  !
+    ;   domain_error(day, Day)
+    ).
+
+%!  http_consider_logrotate
+%
+%   Perform a log rotation if the schedule is met
+
+http_consider_logrotate :-
+    scheduled_logrotate(Schedule, Options),
+    get_time(NowF),
+    Now is round(NowF/60.0)*60,
+    scheduled(Schedule, Now),
+    !,
+    http_logrotate([background(true)|Options]).
+
+scheduled(daily(HH:MM), Now) :-
+    stamp_date_time(Now, DateTime, local),
+    date_time_value(time, DateTime, time(HH,MM,_)).
+scheduled(weekly(Day, Time), Now) :-
+    stamp_date_time(Now, DateTime, local),
+    date_time_value(date, DateTime, Date),
+    day_of_the_week(Date, Day),
+    scheduled(daily(Time), Now).
+scheduled(monthly(Day, Time), Now) :-
+    stamp_date_time(Now, DateTime, local),
+    date_time_value(day, DateTime, Day),
+    scheduled(daily(Time), Now).
+
+day(1, mon).
+day(2, tue).
+day(3, wed).
+day(4, thu).
+day(5, fri).
+day(6, sat).
+day(7, sun).