/*
** Module   :REXXTEST.SCR
** Abstract :Sample authorization script for SafeFire PPP
**           Configuration parameter: log prefix
**           To use it change following entry in configuration file
**
**           [ppp]
**           auth.server.authbase=pla_rexx,rtest2.scr,auth_ppp
**
** Copyright (C) 1999, 2000  Link Guard Solutions Ltd.
**
** Log: Sun  01/10/2000 Updated
**
*/

logbeg = arg(1)
if logbeg<>'' then logbeg=logbeg||': '
sesvar = 'auth.session.'||arg(2)

call sf_syslog 'DEBUG',logbeg||arg(1)' 'arg(2)' 'arg(3)' 'arg(4)' 'arg(5)
/* All command has first 3 parameters:
 *  ARG(1) - Script's parameter from config
 *  ARG(2) - Library handle. Each load/unload has it's handle
 *  ARG(3) - Command name
 */

if arg(3)='LOAD' then
do
    /* LOAD's additional parameters are:
        arg(4) - Decimal number of protocol trying to load
        arg(5) - Subprotocol number. 0 for PAP, algorithm number for CHAP
       Returns if load was OK (1 - Yes, 0 - No)
     */

    /* Our File name is %ETC%\PAP.SCT for PAP and %ETC%\CHAP.SCT for all other */

    fname = value('ETC',,'OS2ENVIRONMENT')
    if right(fname,1)<>'\' then fname = fname || '\'

    if arg(4)=x2d('c023') then
        fname = fname || 'pap.sct'
    else
        fname = fname || 'chap.sct'

    if stream(fname, 'c', 'query exists')='' then
    do
        call sf_syslog 'INFO', logbeg|| 'Error locating 'fname' file'
        return 0
    end

    call sf_Set_Var sesvar||'.fname', fname
    call sf_Set_Var sesvar||'.users.0', 0

    call sf_syslog 'INFO', logbeg|| 'Connected using 'fname

    return 1
end

if arg(3)='UNLOAD' then
do
    /* No additional parameters, no return value*/
    do while  sf_Get_Var(sesvar||'.users.0')<>0
        call LogOutUser 1
    end

    call sf_Set_Var sesvar||'.fname'
    call sf_Set_Var sesvar||'.users.0'

    call sf_syslog 'INFO', logbeg|| 'DisConnected'
    return
end

if arg(3)='CHECKPASS' then
do
    /* Two additional parameters:
        arg(4) - User name
        arg(5) - User password
       Must return
        '<OK>\1<IPS>\1<UDATA>\1<RESPONSE>'
        Where
         <OK> is if username/password pair is good
         <IPS> is if script will do IP negotiation
         <UDATA> is any decimal number that will character the logged in user
         <RESPONSE> is the string - response that will be sent to peer
         \1 is '01'x symbol
    */
    dl = '01'x

    p=getpass(arg(2),arg(4))
    if p=arg(5) then
    do
        /* Let's find out user's number */
        udata = sf_Get_Var(sesvar||'.users.0') + 1
        call sf_Set_Var sesvar||'.users.0', udata

        /* And put in it's name name */
        call sf_Set_Var sesvar||'.users.'||udata||'.uname', arg(4)
        call sf_Set_Var "srvhook."||arg(1)||".name", arg(4)

        call sf_syslog 'INFO', logbeg|| "User "||arg(4)||" logged in OK using "udata
        return '1'||dl||'0'||dl||udata||dl||'Logged in OK'
    end

    call sf_syslog 'INFO', logbeg|| "Login of user "||arg(4)||" failed"
    return '0'||dl||'0'||dl||'0'||dl
end

if arg(3)='GETPASS' then
do
    /* Two additional parameters:
        arg(4) - User name
        arg(5) - User password
       Must return
        '<OK>\1<IPS>\1<UDATA>\1<PASS>\1<RESPONSE>'
        Where
         <PASS> is user's password
         For other see CHECKPASS
    */

    dl = '01'x

    p=getpass(arg(2),arg(4))
    if (p<>'') then
    do
        /* Let's find out user's number */
        udata = sf_Get_Var(sesvar||'.users.0') + 1
        call sf_Set_Var sesvar||'.users.0', udata

        /* And put in it's name name */
        call sf_Set_Var sesvar||'.users.'||udata||'.uname', arg(4)
        call sf_Set_Var "srvhook."||arg(1)||".name", arg(4)

        call sf_syslog 'INFO', logbeg|| "User "||arg(4)||" logged in OK using "udata
        return '1'||dl||'0'||dl||udata||dl||p||dl||'Logged in OK'
    end
    return '0'||dl||'0'||dl||'0'||dl||dl

end

if arg(3)='LOGIN' then
do
    /*
        1 additional param:
         arg(4) - udata

        no return value
     */

    /* The user is logged in at last */
    say 'User using 'arg(4)' logged in'

    return

end

if arg(3)='LOGOUT' then
do
    /*
        1 additional param:
         arg(4) - udata

        no return value
     */
     unum = sf_Get_Var(sesvar||'.users.0', 0)
     udata = arg(4)


     if udata>unum then
     do
        call sf_syslog 'INFO', logbeg|| "Invalid user "udata" tried to log out"
        call lineout testfile, logbeg||DATE('N')||" "||TIME()||"Invalid user "udata" tried to log out"
        return
     end


     call LogOutUser udata


end

if arg(3)='SELECTIP' then
do
    /*
        2 additional parameters:
            arg(4)  udata
            arg(5)  wantedip - ip the user wants
        returns:
            ip number for user. either arg(5), other ip or '0.0.0.0' if there is no IP for the user
     */
    return '0.0.0.0' /* We don't support this for now */
end

if arg(3)='CHECKUSER' then
do
    /* This function must check
        if user still can be online.
       It has 1 additional parameter:
            arg(4)  udata
       and must return 1 or 0
     */
    return 1
end


return

logoutuser:
    parse arg udata

    unums = sf_Get_Var(sesvar||'.users.0', 0)

    call sf_syslog 'INFO', logbeg|| 'User '||sf_Get_Var(sesvar||'.users.'||udata||'.uname')||' logged out using 'udata

    if (udata = unum) then
    do
        call sf_Set_Var sesvar||'.users.'||udata
    end
    else
    do
        call sf_Set_Var sesvar||'.users.'||udata, sf_Get_Var(sesvar||'.users.'||unums)
    end

    call sf_Set_Var sesvar||'.users.0', unums - 1

    return


getpass:
    parse arg session,uname

    fname = sf_Get_Var(sesvar||'.fname')
    if fname = '' then return ''
    call stream fname,'c','open read'
    do while stream(fname,'s')='READY'
     l = linein(fname)
     x = pos('#',l)
     if x<>0 then
     do
        if x = 1 then iterate /* Whole line is comment */
        l = left(l, x - 1)
     end
     if word(l,1) = uname then
     do
        call stream fname,'c','close'
        do zz=4 to words(l)
            parse value word(l,zz) with comnd':'params
            comnd=translate(comnd)
            if comnd='CALLBACK' & params<>'' then
            do
                parse value params with opt','phones
                opt=translate(opt)
                if opt
            end
        end
        return word(l,3)
     end
    end
    call stream fname,'c','close'
    return ''


