Changeset 6376 in project for chicken/trunk/posixunix.scm


Ignore:
Timestamp:
10/11/07 20:47:10 (12 years ago)
Author:
Kon Lovett
Message:

Forgot new files must be in manifest. Added 'current-user-name' function to windows & unix posix.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/posixunix.scm

    r6175 r6376  
    10601060            _uname-machine) ) )
    10611061
     1062  (define set-user-id!                  ; DEPRECATED
     1063    (lambda (id)
     1064      (when (fx< (##core#inline "C_setuid" id) 0)
     1065        (##sys#update-errno)
     1066        (##sys#error 'set-user-id! "cannot set user ID" id) ) ) )
     1067
     1068  (define current-user-id
     1069    (getter-with-setter
     1070     (foreign-lambda int "C_getuid")
     1071     set-user-id!) )
     1072
     1073  (define current-effective-user-id
     1074    (getter-with-setter
     1075     (foreign-lambda int "C_geteuid")
     1076     (lambda (id)
     1077      (when (fx< (##core#inline "C_seteuid" id) 0)
     1078        (##sys#update-errno)
     1079        (##sys#error
     1080         'effective-user-id!-setter "cannot set effective user ID" id) ) ) ) )
     1081
     1082  (define set-group-id!                 ; DEPRECATED
     1083    (lambda (id)
     1084      (when (fx< (##core#inline "C_setgid" id) 0)
     1085        (##sys#update-errno)
     1086        (##sys#error 'set-user-id! "cannot set group ID" id) ) ) )
     1087
     1088  (define current-group-id
     1089    (getter-with-setter
     1090     (foreign-lambda int "C_getgid")
     1091     set-group-id!) )
     1092
     1093  (define current-effective-group-id
     1094    (getter-with-setter
     1095     (foreign-lambda int "C_getegid")
     1096     (lambda (id)
     1097      (when (fx< (##core#inline "C_setegid" id) 0)
     1098        (##sys#update-errno)
     1099        (##sys#error
     1100         'effective-group-id!-setter "cannot set effective group ID" id) ) ) ) )
     1101
    10621102  (define-foreign-variable _user-name nonnull-c-string "C_user->pw_name")
    10631103  (define-foreign-variable _user-passwd nonnull-c-string "C_user->pw_passwd")
     
    10681108  (define-foreign-variable _user-shell c-string "C_user->pw_shell")
    10691109
    1070   (define (user-information user)
     1110  (define (user-information user #!optional as-vector)
    10711111    (let ([r (if (fixnum? user)
    1072                (##core#inline "C_getpwuid" user)
    1073                (begin
    1074                  (##sys#check-string user 'user-information)
    1075                  (##core#inline "C_getpwnam" (##sys#make-c-string user)) ) ) ] )
     1112                 (##core#inline "C_getpwuid" user)
     1113                 (begin
     1114                   (##sys#check-string user 'user-information)
     1115                   (##core#inline "C_getpwnam" (##sys#make-c-string user)) ) ) ] )
    10761116      (and r
    1077          (list _user-name
    1078                _user-passwd
    1079                _user-uid
    1080                _user-gid
    1081                _user-gecos
    1082                _user-dir
    1083                _user-shell) ) ) )
     1117           ((if as-vector vector list)
     1118            _user-name
     1119            _user-passwd
     1120            _user-uid
     1121            _user-gid
     1122            _user-gecos
     1123            _user-dir
     1124            _user-shell) ) ) )
     1125
     1126  (define (current-user-name)
     1127    (list-ref (user-information (current-user-id)) 0) )
     1128
     1129  (define (current-effective-user-name)
     1130    (list-ref (user-information (current-effective-user-id)) 0) )
    10841131
    10851132  (define-foreign-variable _group-name nonnull-c-string "C_group->gr_name")
     
    10911138      "return(C_group->gr_mem[ i ]);") )
    10921139
    1093   (define (group-information group)
     1140  (define (group-information group #!optional as-vector)
    10941141    (let ([r (if (fixnum? group)
    10951142                 (##core#inline "C_getgrgid" group)
     
    10981145                   (##core#inline "C_getgrnam" (##sys#make-c-string group)) ) ) ] )
    10991146      (and r
    1100          (list _group-name
    1101                  _group-passwd
    1102                  _group-gid
    1103                  (let rec ([i 0])
    1104                    (let ([n (group-member i)])
    1105                      (if n
    1106                          (cons n (rec (fx+ i 1)))
    1107                          '() ) ) ) ) ) ) )
     1147           ((if as-vector vector list)
     1148            _group-name
     1149            _group-passwd
     1150            _group-gid
     1151            (let loop ([i 0])
     1152              (let ([n (group-member i)])
     1153                (if n
     1154                    (cons n (loop (fx+ i 1)))
     1155                    '() ) ) ) ) ) ) )
    11081156
    11091157  (define _get-groups
     
    12481296      (when (fx< (##core#inline "C_chown" (##sys#make-c-string (##sys#expand-home-path fn)) uid gid) 0)
    12491297        (posix-error #:file-error 'change-file-owner "cannot change file owner" fn uid gid) ) ) )
    1250 
    1251   (define current-effective-user-id
    1252     (getter-with-setter
    1253      (foreign-lambda int "C_geteuid")
    1254      (lambda (id)
    1255       (when (fx< (##core#inline "C_seteuid" id) 0)
    1256         (##sys#update-errno)
    1257         (##sys#error
    1258          'effective-user-id!-setter "cannot set effective user ID" id) ) ) ) )
    1259 
    1260   (define current-effective-group-id
    1261     (getter-with-setter
    1262      (foreign-lambda int "C_getegid")
    1263      (lambda (id)
    1264       (when (fx< (##core#inline "C_setegid" id) 0)
    1265         (##sys#update-errno)
    1266         (##sys#error
    1267          'effective-group-id!-setter "cannot set effective group ID" id) ) ) ) )
    1268 
    1269   (define set-user-id!                  ; DEPRECATED
    1270     (lambda (id)
    1271       (when (fx< (##core#inline "C_setuid" id) 0)
    1272         (##sys#update-errno)
    1273         (##sys#error 'set-user-id! "cannot set user ID" id) ) ) )
    1274 
    1275   (define current-user-id
    1276     (getter-with-setter
    1277      (foreign-lambda int "C_getuid")
    1278      set-user-id!) )
    1279 
    1280   (define set-group-id!                 ; DEPRECATED
    1281     (lambda (id)
    1282       (when (fx< (##core#inline "C_setgid" id) 0)
    1283         (##sys#update-errno)
    1284         (##sys#error 'set-user-id! "cannot set group ID" id) ) ) )
    1285 
    1286   (define current-group-id
    1287     (getter-with-setter
    1288      (foreign-lambda int "C_getgid")
    1289      set-group-id!) )
    12901298
    12911299  (define-foreign-variable _r_ok int "R_OK")
Note: See TracChangeset for help on using the changeset viewer.