View source with raw comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2007-2015, University of Amsterdam
    7                              VU University Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(authenticate,
   37          [ http_authenticate/3,        % +Check, +Header, -User
   38            http_authorization_data/2,  % +AuthorizationText, -Data
   39            http_current_user/3,        % +File, ?User, ?Fields
   40
   41            http_read_passwd_file/2,    % +File, -Data
   42            http_write_passwd_file/2    % +File, +Data
   43          ]).   44:- use_module(library(base64)).   45:- use_module(library(dcg/basics)).   46:- use_module(library(readutil)).   47:- use_module(library(lists)).   48:- use_module(library(crypt)).   49:- use_module(library(debug)).   50:- use_module(library(error)).   51:- use_module(library(apply)).

Authenticate HTTP connections using 401 headers

This module provides the basics to validate an HTTP Authorization header. User and password information are read from a Unix/Apache compatible password file.

This library provides, in addition to the HTTP authentication, predicates to read and write password files. */

 http_authenticate(+Type, +Request, -Fields)
True if Request contains the information to continue according to Type. Type identifies the required authentication technique:
basic(+PasswordFile)
Use HTTP Basic authetication and verify the password from PasswordFile. PasswordFile is a file holding usernames and passwords in a format compatible to Unix and Apache. Each line is record with : separated fields. The first field is the username and the second the password hash. Password hashes are validated using crypt/2.

Successful authorization is cached for 60 seconds to avoid overhead of decoding and lookup of the user and password data.

http_authenticate/3 just validates the header. If authorization is not provided the browser must be challenged, in response to which it normally opens a user-password dialogue. Example code realising this is below. The exception causes the HTTP wrapper code to generate an HTTP 401 reply.

(   http_authenticate(basic(passwd), Request, Fields)
->  true
;   throw(http_reply(authorise(basic, Realm)))
).
Arguments:
Fields- is a list of fields from the password-file entry. The first element is the user. The hash is skipped.
To be done
- Should we also cache failures to reduce the risc of DoS attacks?
   98http_authenticate(basic(File), Request, [User|Fields]) :-
   99    memberchk(authorization(Text), Request),
  100    debug(http_authenticate, 'Authorization: ~w', [Text]),
  101    (   cached_authenticated(Text, File, User, Fields)
  102    ->  true
  103    ;   http_authorization_data(Text, basic(User, Password)),
  104        debug(http_authenticate,
  105              'User: ~w, Password: ~s', [User, Password]),
  106        validate(File, User, Password, Fields),
  107        get_time(Now),
  108        assert(authenticated(Text, File, User, Now, Fields)),
  109        debug(http_authenticate, 'Authenticated ~w~n', [User])
  110    ).
 http_authorization_data(+AuthorizeText, ?Data) is semidet
Decode the HTTP Authorization header. Data is a term
Method(User, Password)

where Method is the (downcased) authorization method (typically basic), User is an atom holding the user name and Password is a list of codes holding the password

  122http_authorization_data(Text, Data) :-
  123    (   nonvar(Data)
  124    ->  functor(Data, Method, 2)    % make authorization//2 fail early
  125    ;   true
  126    ),
  127    atom_codes(Text, Codes),
  128    phrase(authorization(Method, Cookie), Codes),
  129    phrase(base64(UserPwd), Cookie),
  130    phrase(ident(UserCodes, Password), UserPwd),
  131    !,
  132    atom_codes(User, UserCodes),
  133    Data =.. [Method, User, Password].
  134
  135authorization(Method, Cookie) -->
  136    nonblanks(MethodChars),
  137    { atom_codes(Method0, MethodChars),
  138      downcase_atom(Method0, Method)
  139    },
  140    blanks,
  141    nonblanks(Cookie),
  142    blanks.
  143
  144ident(User, Password) -->
  145    string(User),
  146    ":",
  147    string(Password).
 cached_authenticated(+Authorization, +File, -User, -RestFields)
Validate using the cache. If the entry is not in the cache, we also remove all outdated entries from the cache.
  154:- dynamic
  155    authenticated/5.        % Authorization, File, User, Time, RestFields
  156
  157cached_authenticated(Authorization, File, User, Fields) :-
  158    authenticated(Authorization, File, User, Time, Fields),
  159    get_time(Now),
  160    Now-Time =< 60,
  161    !.              % 60-second timeout
  162cached_authenticated(_, _, _, _) :-
  163    get_time(Now),
  164    (   clause(authenticated(_, _, _, Time, _), true, Ref),
  165        Now-Time > 60,
  166        erase(Ref),
  167        fail
  168    ).
 validate(+File, +User, +Passwd, -Fields)
True if User and Passwd combination appears in File. File uses the same format as .htaccess files from Apache or Unix password files. I.e. it consists of one line per entry with fields separated by :. The first field is the User field, The second contains the Passwd in DES or MD5 encrypted format. See crypt/2 for details.
  180validate(File, User, Password, Fields) :-
  181    update_passwd(File, Path),
  182    passwd(User, Path, Hash, Fields),
  183    crypt(Password, Hash).
 http_current_user(+File, ?User, ?Fields) is nondet
True when User is present in the htpasswd file File and Fields provides the additional fields.
Arguments:
Fields- are the fields from the password file File, converted using name/2, which means that numeric values are passed as numbers and other fields as atoms. The password hash is the first element of Fields and is a string.
  196http_current_user(File, User, Fields) :-
  197    update_passwd(File, Path),
  198    passwd(User, Path, Hash, Fields0),
  199    Fields = [Hash|Fields0].
 update_passwd(+File, -Path) is det
Update passwd/3 to reflect the correct passwords for File. Path is the absolute path for File.
  206:- dynamic
  207    passwd/4,                       % User, File, Encrypted, Fields
  208    last_modified/2.                % File, Stamp
  209
  210update_passwd(File, Path) :-
  211    absolute_file_name(File, Path, [access(read)]),
  212    time_file(Path, Stamp),
  213    (   last_modified(Path, Stamp)
  214    ->  true
  215    ;   with_mutex(http_passwd, reload_passwd_file(Path, Stamp))
  216    ).
  217
  218reload_passwd_file(Path, Stamp) :-
  219    last_modified(Path, Stamp),
  220    !.  % another thread did the work
  221reload_passwd_file(Path, Stamp) :-
  222    http_read_passwd_file(Path, Data),
  223    retractall(last_modified(Path, _)),
  224    retractall(passwd(_, Path, _, _)),
  225    forall(member(passwd(User, Hash, Fields), Data),
  226           assertz(passwd(User, Path, Hash, Fields))),
  227    assert(last_modified(Path, Stamp)).
 http_read_passwd_file(+Path, -Data) is det
Read a password file. Data is a list of terms of the format below, where User is an atom identifying the user, Hash is a string containing the salted password hash and Fields contain additional fields. The string value of each field is converted using name/2 to either a number or an atom.
passwd(User, Hash, Fields)
  241http_read_passwd_file(Path, Data) :-
  242    setup_call_cleanup(
  243        open(Path, read, Fd),
  244        ( read_line_to_codes(Fd, Line),
  245          read_passwd_file(Line, Fd, Path, Data)
  246        ),
  247        close(Fd)).
  248
  249read_passwd_file(end_of_file, _, _, []) :- !.
  250read_passwd_file(Line, Fd, Path, Data) :-
  251    (   phrase(password_line(User, Hash, Fields), Line, _)
  252    ->  Data = [passwd(User, Hash, Fields)|Tail]
  253    ;   Tail = Data                 % TBD: warning
  254    ),
  255    read_line_to_codes(Fd, Line2),
  256    read_passwd_file(Line2, Fd, Path, Tail).
  257
  258
  259password_line(User, Hash, Fields) -->
  260    string(UserCodes),
  261    ":",
  262    string(HashCodes),
  263    peek_eof,
  264    !,
  265    fields(Fields),
  266    { atom_codes(User, UserCodes),
  267      string_codes(Hash, HashCodes)
  268    }.
  269
  270fields([Field|Fields]) -->
  271    field(Field),
  272    !,
  273    fields(Fields).
  274fields([]) --> [].
  275
  276field(Value) -->
  277    ":",
  278    !,
  279    string(Codes),
  280    peek_eof,
  281    !,
  282    { name(Value, Codes)
  283    }.
  284
  285peek_eof, ":" --> ":".
  286peek_eof --> eos.
 http_write_passwd_file(+File, +Data:list) is det
Write password data Data to File. Data is a list of entries as below. See http_read_passwd_file/2 for details.
passwd(User, Hash, Fields)
To be done
- Write to a new file and atomically replace the old one.
  300http_write_passwd_file(File, Data) :-
  301    must_be(list, Data),
  302    maplist(valid_data, Data),
  303    setup_call_cleanup(
  304        open(File, write, Out, [encoding(utf8)]),
  305        maplist(write_data(Out), Data),
  306        close(Out)),
  307    retractall(last_modified(File, _)). % flush cache
  308
  309valid_data(passwd(User, Hash, Fields)) :-
  310    !,
  311    valid_field(User),
  312    valid_field(Hash),
  313    must_be(list, Fields),
  314    maplist(valid_field, Fields).
  315valid_data(Data) :-
  316    type_error(passwd_entry, Data).
  317
  318valid_field(Field) :-
  319    must_be(atomic, Field),
  320    (   number(Field)
  321    ->  true
  322    ;   sub_string(Field, _, _, _, ":")
  323    ->  representation_error(passwd_field)
  324    ;   true
  325    ).
  326
  327write_data(Out, passwd(User, Hash, Fields)) :-
  328    atomics_to_string([User, Hash|Fields], ":", String),
  329    format(Out, '~s~n', [String]).
  330
  331
  332                 /*******************************
  333                 *   PLUGIN FOR HTTP_DISPATCH   *
  334                 *******************************/
  335
  336:- multifile
  337    http:authenticate/3.
 http:authenticate(+AuthData, +Request, -Fields)
Plugin for library(http_dispatch) to perform basic HTTP authentication.

This predicate throws http_reply(authorise(basic, Realm)).

Arguments:
AuthData- must be a term basic(File, Realm)
Request- is the HTTP request
Fields- describes the authenticated user with the option user(User) and with the option user_details(Fields) if the password file contains additional fields after the user and password.
  353http:authenticate(basic(File, Realm), Request,
  354                  [ user(User)
  355                  | Details
  356                  ]) :-
  357    (   http_authenticate(basic(File), Request, [User|Fields])
  358    ->  (   Fields == []
  359        ->  Details = []
  360        ;   Details = [user_details(Fields)]
  361        )
  362    ;   throw(http_reply(authorise(basic, Realm)))
  363    )