1000 ! * LOGIN.BAC
1005 INTEGER : EXTEND 
1010 ; '** Login utility **'
1020 ; '   Ver 1.00  1985-07-05'
1030 ; '   Copyright 1984 Dataindustrier AB'
1040 ! 
1050 ! *  Written by Benny L|fgren
1060 ! ** ** ** ** ** ** ** ** ** ** **
1070 ! *
1080 ! * Ver date / Ver nb / Sign / Note
1090 ! * 84-06-03 /  X.00  /  BL  / Main
1100 ! * 84-06-07 /  X.01  /  BL  / Clear out entire field at logout
1110 ! * 84-06-14 /  X.02  /  BL  / Fix UFD/LFD/PFD pointer
1120 ! * 84-06-21 /  X.03  /  BL  / User code sent over in right register.
1130 ! * 84-08-22 /  X.04  /  BL  / Set TIME$ from central battery clock.
1140 ! * 84-08-30 /  X.05  /  BL  / No password question if user has none.
1150 ! * 84-08-30 /  X.06  /  BL  / Clear group name when login retry.
1160 ! * 84-08-30 /  X.07  /  BL  / Possible to enter password in login field.
1170 ! * 84-09-07 /  X.08  /  BL  / Nicer trap handling?
1180 ! * 84-09-07 /  X.09  /  BL  / Don't clear UFD/PFD/LFD-pointers.
1190 ! * 84-10-29 /  X.10  /  GN  / Move username and file privilegie
1200 ! * 84-10-30 /  X.11  /  GN  / Move group number as well
1210 ! * 84-12-04 /  X.12  /  GN  / Talknet call to 'NETCALL'
1220 ! * 85-02-15 /  X.13  /  BL  / Accesible from DOS, FNStartpar$ handling
1230 ! * 85-07-04 /  X.14  /  BL  / Proper error handling
1240 ! * 85-07-04 /  1.00  /  BL  / Release.
1250 ! *
1260 ! ** ** ** ** ** ** ** ** ** ** **
1270 ! *
1280 ! EJECT
1290 ! ********************************
1300 ! *
1310 ! *  Time to do login.
1320 ! *
1330 ! *  Login: USERID<,<newgroup>,password>
1340 ! *
1350 A$=FNStartpar$ : GOTO 1370 ! Get start parameters (if any)
1360 ; "Login: "; : INPUT LINE A$ : A$=LEFT$(A$,LEN(A$)-2) : B$=""
1370 ; : IF A$="" GOTO 1360 ! He must enter something.
1380 I=INSTR(1,A$,",") : IF I=0 GOTO 1420
1390 J=INSTR(I+1,A$,",") : IF J=0 B$=RIGHT$(A$,I+1) ELSE B$=MID$(A$,I+1,J-I-1)
1400 IF J C$=RIGHT$(A$,J+1)
1410 A$=LEFT$(A$,I-1) : IF J A$=FNForm$(A$)+FNForm$(C$)+FNForm$(B$) : GOTO 1570
1420 ! 
1430 ! ********************************
1440 ! *
1450 ! *  Try to login with blank password first.
1460 ! *
1470 A$=FNForm$(A$)+FNForm$('')+FNForm$(B$)
1480 FOR I=1 TO LEN(A$)
1490   POKE SWAP%(PEEK(64787))+I-1,ASCII(RIGHT$(A$,I))
1500 NEXT I : IF FNTalknet(14+64,1,0,0,0,0)=0 GOTO 1670
1510 ! 
1520 ! ********************************
1530 ! *
1540 ! *  If fail, ask for password.
1550 ! *
1560 A$=FNForm$(A$)+FNForm$(FNPasswd$)+FNForm$(B$)
1570 FOR I=1 TO LEN(A$)
1580   POKE SWAP%(PEEK(64787))+I-1,ASCII(RIGHT$(A$,I))
1590 NEXT I 
1600 Z=FNCenerr(FNTalknet(14+64,1,0,0,0,0))
1610 IF Z FOR Delay=0 TO 2000 : NEXT Delay : GOTO 1360
1620 ! 
1630 ! ********************************
1640 ! *
1650 ! *  Read device description to get UFD pointer.
1660 ! *
1670 IF FNTalknet(14,0,255,0,0,254) ; "Can't read devdes table" : GOTO 1360
1680 ! 
1690 ! *********************************
1700 ! *
1710 ! *  Move UFD/LFD/PFD pointers.
1720 ! *
1730 FOR I=0 TO 2
1740   POKE PEEK2(24685)+I,PEEK(62720+32+6+28+I)
1750   POKE PEEK2(24695)+I,PEEK(62720+32+6+36+I)
1760   POKE PEEK2(24697)+I,PEEK(62720+32+6+40+I)
1770 NEXT I 
1780 ! 
1790 ! *********************************
1800 ! *
1810 ! *  Move user group nunber, name and file privilege
1820 ! *
1830 Namepnt=PEEK2(24699)
1840 IF Namepnt<-3*256 OR Namepnt>-256 THEN 1900 ! Old DOS
1850 POKE Namepnt,PEEK(62720+47),PEEK(62720+48) ! Move group number
1860 FOR I=0 TO 7
1870   POKE Namepnt+2+I,PEEK(62720+39+I)
1880 NEXT I 
1890 POKE Namepnt+10,PEEK(62720+51) ! Move def file priv
1900 ! 
1910 ! ********************************
1920 ! *
1930 ! *  Set TIME$ from central battery clock.
1940 ! *
1950 FOR I=0 TO 5
1960   POKE -17+I,PEEK(62720+32+I)
1970 NEXT I : POKE -10,0
1980 ! 
1990 ; FNExit ! That's all, folks!
2000 ! 
2010 ! ********************************
2020 ! *
2030 ! *  Format string.
2040 ! *
2050 DEF FNForm$(A$)=FNCapstr$(LEFT$(A$+SPACE$(8),8)) 
2060 ! 
2070 ! ********************************
2080 ! *
2090 ! *  Convert a character to upper case.
2100 ! *
2110 DEF FNCaps$(A$)=CHR$(ASCII(A$)+(32*((ASCII(A$)>95) AND (ASCII(A$)<127)))) 
2120 ! 
2130 ! ********************************
2140 ! *
2150 ! *  Convert a string to caps.
2160 ! *
2170 DEF FNCapstr$(A$) LOCAL I,Outstr$=160
2180   WHILE I<LEN(A$) : I=I+1
2190     Outstr$=Outstr$+FNCaps$(RIGHT$(A$,I))
2200   WEND : RETURN Outstr$
2210 FNEND 
2220 ! 
2230 ! ********************************
2240 ! *
2250 ! *  Read a string and echo stars.
2260 ! *
2270 DEF FNPasswd$ LOCAL A$=1,Str$=8
2280   ; "Password: "; : GET A$
2290   WHILE A$<>CHR$(13)
2300     IF A$<>CHR$(8) GOTO 2320
2310     IF LEN(Str$) ; A$ " " A$; : Str$=LEFT$(Str$,LEN(Str$)-1)
2320     IF A$<>CHR$(24) GOTO 2350
2330     ; STRING$(LEN(Str$),8) SPACE$(LEN(Str$)) STRING$(LEN(Str$),8);
2340     Str$=""
2350     IF A$<" " OR A$>"" OR LEN(Str$)>7 GOTO 2370
2360     Str$=Str$+A$ : ; "*";
2370     GET A$
2380   WEND : ; : RETURN Str$
2390 FNEND 
2400 ! 
2410 ! ********************************
2420 ! *
2430 ! *  Do communication with net central.
2440 ! *
2450 DEF FNTalknet(Fc,Sfc,B,C,D,E) LOCAL Z
2460   POKE 64961,Fc ! FC -> MSG.FC (Function code).
2470   POKE 64962,Sfc ! SFC -> MSG.SFC (Subfunction code).
2480   POKE 64963,C,B ! MSG.PDN, MSG.ERRB (BC register to/from central).
2490   POKE 64965,E,D ! Register DE to/from central.
2500   POKE 64798,255 ! TFT fake => BSAVE.
2510   Z=CALL(24615) ! NETCALL. => Talk to the central.
2520   RETURN PEEK(64962)
2530 FNEND 
2540 ! 
2550 END 
2560 ! 
2570 ! ******************************
2580 ! *
2590 ! *  Check if entered from DOS or BASIC
2600 ! *
2610 DEF FNChkdos=(PEEK(PEEK2(65302)-160))=255 
2620 ! 
2630 ! ******************************
2640 ! *
2650 ! *  Get start parameters
2660 ! *
2670 DEF FNStartpar$ LOCAL Cmdsp,I,Cmd$=160
2680   Cmdsp=PEEK2(65302)-160
2690   WHILE I<160 : I=I+1 : IF PEEK(Cmdsp+I-1)=44 GOTO 2720
2700     IF PEEK(Cmdsp+I-1)=13 RETURN '' ! No startpar string
2710   WEND : RETURN '' ! No startpar string
2720   WHILE I<160 : IF PEEK(Cmdsp+I)=13 GOTO 2740
2730   Cmd$=Cmd$+CHR$(PEEK(Cmdsp+I)) : I=I+1 : WEND 
2740   RETURN Cmd$
2750 FNEND 
2760 ! 
2770 ! ******************************
2780 ! *
2790 ! *  Exit program the proper way (to DOS or BASIC)
2800 ! *
2810 DEF FNExit LOCAL A$=21,A
2820   IF FNChkdos=0 GOTO 2870 ELSE CLOSE ! We MUST close ALL files!!!
2830   A$='CMDINT  SYS'+CHR$(14,255,205,27,96,216,195,3,193)
2840   A=VARPTR(A$)
2850   IF CALL(A+11,A) ; "Can't load CMDINT.SYS, press any key for RESET!";
2860   GET A$ : IF CALL(0) REM Just a miracle would get through here...
2870   CHAIN 'NUL:' ! Kill program anyway
2880 FNEND 
2890 ! *********************************
2900 ! *
2910 ! *  Check if central error (and if so, tell user)
2920 ! *
2930 DEF FNCenerr(Ecode) LOCAL I,A$=80
2940   IF Ecode=255 ; 'File not found!' : RETURN -1
2950   IF (Ecode AND 128)=0 RETURN 0
2960   I=Ecode AND 127 : RESTORE 3010
2970   READ A$ : WHILE I : READ A$ : I=I-1 : WEND : ; A$ : RETURN -1
2980   ! 
2990   ! Usual DOS traps
3000   ! 
3010   DATA 'CRC or AM error during read.'
3020   DATA 'CRC or AM error during write.'
3030   DATA 'Record format error.'
3040   DATA 'Record number out of range.'
3050   DATA 'Write protect violation.'
3060   DATA 'Delete or read protect violation.'
3070   DATA 'File space full.'
3080   DATA 'Drive off line.'
3090   DATA 'Disc write protect.'
3100   DATA 'Logical file not open.'
3110   DATA 'Invalid logical file number.'
3120   DATA 'Invalid drive number.'
3130   DATA 'Invalid trap number.'
3140   DATA 'Failure in system data.'
3150   DATA 'Invalid physical file number.'
3160   DATA '*** INVALID ERROR CODE'
3170   ! 
3180   ! Here follows specific net error codes
3190   ! 
3200   DATA 'Login please.'
3210   DATA 'You must be a superuser.'
3220   DATA 'Illegal subfunction code.'
3230   DATA 'Central task already running.'
3240   DATA 'Task not found.'
3250   DATA 'Can''t change directory.'
3260   DATA 'Bad login.'
3270   DATA 'Illegal terminal number.'
3280   DATA 'Login is not allowed at the moment.'
3290   DATA 'Can''t unmount this device.'
3300   DATA 'Someone is already exclusive.'
3310 FNEND