Changeset 6376 in project for chicken/trunk/posixunix.scm
- Timestamp:
- 10/11/07 20:47:10 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
chicken/trunk/posixunix.scm
r6175 r6376 1060 1060 _uname-machine) ) ) 1061 1061 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 1062 1102 (define-foreign-variable _user-name nonnull-c-string "C_user->pw_name") 1063 1103 (define-foreign-variable _user-passwd nonnull-c-string "C_user->pw_passwd") … … 1068 1108 (define-foreign-variable _user-shell c-string "C_user->pw_shell") 1069 1109 1070 (define (user-information user )1110 (define (user-information user #!optional as-vector) 1071 1111 (let ([r (if (fixnum? user) 1072 (##core#inline "C_getpwuid" user)1073 (begin1074 (##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)) ) ) ] ) 1076 1116 (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) ) 1084 1131 1085 1132 (define-foreign-variable _group-name nonnull-c-string "C_group->gr_name") … … 1091 1138 "return(C_group->gr_mem[ i ]);") ) 1092 1139 1093 (define (group-information group )1140 (define (group-information group #!optional as-vector) 1094 1141 (let ([r (if (fixnum? group) 1095 1142 (##core#inline "C_getgrgid" group) … … 1098 1145 (##core#inline "C_getgrnam" (##sys#make-c-string group)) ) ) ] ) 1099 1146 (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 '() ) ) ) ) ) ) ) 1108 1156 1109 1157 (define _get-groups … … 1248 1296 (when (fx< (##core#inline "C_chown" (##sys#make-c-string (##sys#expand-home-path fn)) uid gid) 0) 1249 1297 (posix-error #:file-error 'change-file-owner "cannot change file owner" fn uid gid) ) ) ) 1250 1251 (define current-effective-user-id1252 (getter-with-setter1253 (foreign-lambda int "C_geteuid")1254 (lambda (id)1255 (when (fx< (##core#inline "C_seteuid" id) 0)1256 (##sys#update-errno)1257 (##sys#error1258 'effective-user-id!-setter "cannot set effective user ID" id) ) ) ) )1259 1260 (define current-effective-group-id1261 (getter-with-setter1262 (foreign-lambda int "C_getegid")1263 (lambda (id)1264 (when (fx< (##core#inline "C_setegid" id) 0)1265 (##sys#update-errno)1266 (##sys#error1267 'effective-group-id!-setter "cannot set effective group ID" id) ) ) ) )1268 1269 (define set-user-id! ; DEPRECATED1270 (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-id1276 (getter-with-setter1277 (foreign-lambda int "C_getuid")1278 set-user-id!) )1279 1280 (define set-group-id! ; DEPRECATED1281 (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-id1287 (getter-with-setter1288 (foreign-lambda int "C_getgid")1289 set-group-id!) )1290 1298 1291 1299 (define-foreign-variable _r_ok int "R_OK")
Note: See TracChangeset
for help on using the changeset viewer.