/*
** 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)' 'arg(6)
/* 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 sesvar||'.users.'||udata||'.cbtype', cbt
        call sf_Set_Var sesvar||'.users.'||udata||'.cbnums', phones
        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 sesvar||'.users.'||udata||'.cbtype', cbt
        call sf_Set_Var sesvar||'.users.'||udata||'.cbnums', phones
        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

if arg(3)='CB_CHECK1' then
    /* This function must check if callback is enabled for
       user and give callback information
       It has 3 additional parameter:
            arg(4)  udata
            arg(5)  Callback operation. It is better to allow #6 only (cbcp)
            arg(6)  Callback LCP option data
       Must return:
        '<OK>\1<CBTYPE>\1<PHONES>'
        Where
         <OK> is if callback is enabled
         <CBTYPE> is callback type for the user. Possible values:
            1 - callback is disabled for user
            2 - user specifies callback number (pass empty phones in this case)
            3 - Single phone number is used (<PHONES> must contain single number)
            4 - User must select one of multiple numbers(pass in <PHONES>)
         <PHONES> is phone number list
            Each phone consists of '<PTYPE><PHONE>\0'. Last phone must be terminated by additional \0
                <PTYPE> is phone type (binary, currently only phone type '01'x is supported)
                <PHONE> is phone number

         \1 is '01'x symbol
         \0 is '00'x symbol
     */
do
    if arg(5) <> 6 then return '0'
    udata = arg(4)

    dl1 = '01'x
    pt  = dl1
    dl2 = '00'x

    cbt = sf_Get_Var(sesvar||'.users.'||udata||'.cbtype', 1)
    phones = sf_Get_Var(sesvar||'.users.'||udata||'.cbnums', "")
    if cbt=1 | cbt=2 then return '1'||dl1||cbt

    w = words(phones)
    if w = 0 then
    do
        call sf_syslog 'WARNING', logbeg|| 'Invalid callback setup string. Must specify at least one callback number. Callback for user is disabled'
        return '0'
    end

    if cbt=3 then
    do
        sw = word(phones, 1)
        if w<>1 then call sf_syslog 'WARNING', logbeg|| 'Invalid callback setup string. Must specify only one callback number for callback type 3. Fist phone '||sw||' will be used'
        return '1'||dl1||cbt||dl1||pt||sw||dl2||dl2
    end

    if cbt=4 then
    do
        ph = dl2
        do i = 1 to w
           ph = pt||word(phones, i)||dl2||ph
        end
        return '1'||dl1||cbt||dl1||ph
    end

    return '0'
end

if arg(3)='CB_CHECK2' then
    /* This function must check if user-returned phone number is acceptable
       It has 3 additional parameter:
            arg(4)  udata
            arg(5)  Phone number specified by user
            arg(6)  delay value requested by user
       Must return:
        '<OK>\1<PHONES>'
        Where
         <OK> is if phone number is OK
         <PHONES> (optional) is updated phone number list
            Each phone consists of '<PTYPE><PHONE>\0'. Last phone must be terminated by additional \0
                <PTYPE> is phone type (binary, currently only phone type '01'x is supported)
                <PHONE> is phone number

         \1 is '01'x symbol
         \0 is '00'x symbol
         Note: If OK is 1, first of passed (or updated) phone numbers will be used; if OK is 0, phone numbers are not used
     */
do
    udata = arg(4)

    dl1 = '01'x
    pt  = dl1
    dl2 = '00'x

    cbt = sf_Get_Var(sesvar||'.users.'||udata||'.cbtype', 1)
    phones = sf_Get_Var(sesvar||'.users.'||udata||'.cbnums', "")
    if cbt=1 then return '1'
    if cbt=2 then return '1'
    rphone = substr(arg(5), 2)

    if rphone='' & cbt=3 then
    do
        /* We must pass phone number */
        sw = word(phones, 1)
        if w<>1 then call sf_syslog 'WARNING', logbeg|| 'Invalid callback setup string. Must specify only one callback number for callback type 3. Fist phone '||sw||' will be used'
        return '1'||dl1||pt||sw||dl2||dl2
    end

    z0 = pos(dl2, rphone)
    if z0<>0 then
        rphone = left(rphone, z0 - 1)
    rphone = strip(rphone)
    if rphone = '' then return '0'

    if wordpos(rphone, phones)<>0 then
        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

    phones = ''
    cbt=1
    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','params
                cbt = opt
                if length(cbt)<>1 | cbt < 1 | cbt > 4 then
                do
                    call sf_syslog 'WARNING', logbeg|| 'Invalid callback setup string. Callback for user 'uname' is disabled'
                    cbt = 1
                end
                do while params<>''
                    parse value params with phone','params
                    phones = phones||phone||' '
                end
            end
        end
        phones = strip(phones)
        return word(l,3)
     end
    end
    call stream fname,'c','close'
    return ''


