SECTION "Password"

GET "LIBHDR"
GET "RINGHDR"
GET "IOHDR"
GET "BCPL.ringhdr-noglobs"
GET "BCPL.ring"
GET "BCPL.ringssp"


MANIFEST
$(  hopeless = 411              // dr.result2 for service not working properly!
    aot.writing = #XA004        // USERAUTH & PRIVMAN rc for AOT writing to disc
$)

//
//                       Ring  Entry  Procedures
//

LET writeerror(entry, rc, service) BE dr.result2 := hopeless


GET "BCPL.pwchange"
GET "BCPL.check"


//
//                       Main  Body  Of  Code
//

LET start(c.pw, c.npw, c.check, c.set) = VALOF

//  First check whether we have been CALLSEGed or loaded as a command,
//by testing for zero in the first argument.  Then decode the arguments
//appropriately and, if OK, call the main procedure to do the work.

$(  LET uidsetlist = rootnode ! rtn.info ! rtninfo.ring ! ri.uidset
    LET callseged  = (c.pw ~= 0)
    LET arg        = VEC 80/bytesperword         // vector for RDARGS
    LET rc         = 16

    TEST callseged THEN
    $(  arg!0 := c.pw
        arg!1 := c.npw
        arg!2 := c.check
        arg!3 := c.set
    $)
    ELSE
    $(  LET argstr = "PW=PASSWORD,NP=NEWPW,CHECK/S,SET/S"

        IF rdargs(argstr, arg, 80/bytesperword) = 0 THEN
        $(  writef("Args unsuitable for string %S*N", argstr)
            GOTO exit
        $)
    $)

    IF (arg!2=0) = (arg!3=0) THEN
    $(  writes("Exactly ONE of the switches CHECK or SET must be given*N")
        GOTO exit
    $)

    IF uidsetlist = 0 THEN
    $(  writes("No uidset found for a logged on user*N")
        GOTO exit
    $)

    deal.with.user(uidsetlist+1+cap.puid, arg!0, arg!1, (arg!2=0))

    rc := 0   // success

exit:

    TEST callseged
    DO RESULTIS rc
    OR stop(rc)
$)




AND deal.with.user(user.puid, default.pw, default.npw, set) BE

$(  LET rc = ?
    LET savein = input()
    LET eof = FALSE
    LET error.count = 0
    LET break.made = FALSE
    LET pw      = VEC 16/bytesperword
    LET npw     = VEC 16/bytesperword
    LET checkpw = VEC 16/bytesperword
    LET pw.prompt = (set -> "*CCurrent password:", "*CPassword:")

    TEST default.pw=0 THEN
        pw%0 := 0
    ELSE
        FOR i=0 TO default.pw%0 DO
            pw%i := default.pw%i

    TEST default.npw=0 THEN
        npw%0 :=0
    ELSE
        FOR i=0 TO default.npw%0 DO
            npw%i := default.npw%i

    selectinput(findinput("**"))

    TEST 0~=dr.rctype(dr.initialise()) THEN
        writes("Ring handler not loaded*N")
    ELSE
    $(  IF pw%0=0 THEN
            eof := ~ask(pw.prompt, pw, 16/bytesperword)

        break.made := testflags(1)

        IF set & ~break.made & ~eof THEN
        $(  IF npw%0=0 THEN eof := ~ask("*CNew password:", npw, 16/bytesperword)
            break.made := testflags(1)
            UNLESS eof | break.made THEN
            eof := ~ask("*CVerify new password:", checkpw, 16/bytesperword)
        $)
        break.made := break.made | testflags(1)
        UNLESS eof | break.made THEN
        TEST set & 0~=compstring(npw, checkpw) THEN
        writes("Verification failed*N") ELSE
        $(  rc := call.userauth(user.puid, pw, npw, set)
            TEST rc=0 THEN
                TEST set THEN writes("New password set*N") ELSE
                writes("Password is correct*N")
            ELSE IF rc~=hopeless THEN dr.writeringerror(rc)
        $)
    $)
    endread()
    selectinput(savein)
    TEST break.made THEN
        writes("*C****** BREAK*N")
    ELSE TEST eof THEN
        writes("*C****** End of Input stream*N")
    ELSE IF rc=hopeless THEN
        writes("*C****** situation hopeless - PASSWORD abandoned*N")
$)




AND ask(question, ansvec, anssize) = VALOF
$(  LET i=?
    LET ch=?

    reflect.on(FALSE)    // switch off reflection

    $(rpt
        i:=1
        writes(question)
        writes(" *E")
        ch:=rdch()
        WHILE ch~='*N' & ch~='*E' & ch~=endstreamch DO
        $(  UNLESS ch='*S' THEN
            $(  IF i < bytesperword*anssize THEN ansvec%i := ch
                i:=i+1
            $)
            ch:=rdch()
        $)
        IF i >= bytesperword*anssize THEN writes("Answer too long!*N")
    $)rpt REPEATUNTIL i < bytesperword*anssize | ch=endstreamch
    ansvec%0 := i-1

    reflect.on(TRUE)

    RESULTIS ch~=endstreamch
$)



AND reflect.on(false.for.non.reflect) BE

$( sendpkt(notinuse, consoletask, act.non.reflect.mode, ?, ?,
                                                  NOT false.for.non.reflect)
$)




AND call.userauth(puid, pw, newpw, set) = VALOF
$(  LET rc = hopeless
    LET userauth = VEC sv.upb
    TEST 0\=dr.rctype(dr.lookup("USERAUTH",userauth)) THEN
    writef("*C****** PASSWORD: can't find *"USERAUTH*"! (rc = %X4 sysrc=%N)*N",
           dr.result2, result2) ELSE
    $(  LET retries = 0
//      writef("seting user %X4%X4%X4%X4's password '%S'*N",
//             get2bytes(puid,0), get2bytes(puid,1),
//             get2bytes(puid,2), get2bytes(puid,3), pw)
        $(rpt
            TEST set THEN
            rc := pwchange(userauth, puid, pw, newpw) ELSE
            rc := check   (userauth, puid, pw)
            IF rc=aot.writing THEN
            $(  delay(2*tickspersecond)   // AOTMANAGER writing to disc
                retries := retries+1
            $)
            IF (rc & #XE000) = #XE000 THEN rc:=hopeless
        $)rpt REPEATUNTIL rc~=aot.writing | retries>6
        TEST rc=aot.writing THEN
        writes("USERAUTH: AOTMANAGER writing to disc too long*N")
        ELSE IF rc=hopeless THEN
        $(  LET r2=result2
            writes("USERAUTH: ")
            dr.writeringerror(r2)
            result2 := r2
        $)
//      writef("rc=0: %C  rc=hopeless: %C  auth: %C  newcap=%X8*N",
//              (rc=0 -> 'T','F'), (rc=hopeless -> 'T', 'F'),
//              (auth -> 'T','F'), newcap)
    $)
    RESULTIS rc
$)


