source: project/macosx/macosx-env.scm @ 5402

Last change on this file since 5402 was 5402, checked in by Kon Lovett, 13 years ago

Chgd to unsigned-c-string* use, bumped verno.

File size: 9.3 KB
Line 
1;;;; macosx-env.scm
2;;;; Kon Lovett, Sep '06
3
4;; Issues
5;;
6;; - Assumes UTF8 encoding for SCDynamicStoreCopyComputerName
7;;
8;; - No SCDynamicStoreCopyProxies support
9
10(declare
11        (uses lolevel)
12  (no-procedure-checks)
13        (no-bound-checks)
14        (export
15          macosx:session-info
16                macosx:machine-name
17                macosx:short-user-name
18                macosx:long-user-name
19                macosx:machine-location
20                macosx:metric?
21                macosx:computer-name
22                macosx:console-user
23                macosx:local-host-name
24                macosx:location-name
25                macosx:main-bundle-path
26                macosx:tick-count
27                macosx:delay
28                macosx:gestalt
29                ;
30    macosx:get-bundle-path) )
31
32;;;
33
34#>
35#include <math.h>
36#include <unistd.h>
37
38#include <CoreFoundation/CoreFoundation.h>
39#include <CoreServices/CoreServices.h>
40#include <SystemConfiguration/SCDynamicStoreCopySpecific.h>
41#include <ApplicationServices/ApplicationServices.h>
42#include <Security/AuthSession.h>
43
44#ifdef HAVE_STDINT_H
45# include <stdint.h>
46#else
47# include <sys/types.h>
48  typedef u_int8_t  uint8_t;
49  typedef u_int16_t uint16_t;
50  typedef u_int32_t uint32_t;
51  typedef u_int64_t uint64_t;
52#endif
53
54#define VECLEN(v) (sizeof(v)/sizeof((v)[0]))
55
56static const unsigned char *
57cfsr_to_utf8buf (CFStringRef cfsr, CFIndex char_len, unsigned char **buf)
58{
59        CFIndex buflen = char_len + 1;
60        *buf = ((unsigned char *) C_malloc (buflen));
61        if (! CFStringGetCString (cfsr, (char *) *buf, buflen, kCFStringEncodingUTF8)) {
62                C_free (*buf);
63                *buf = NULL;
64        }
65        return ((const unsigned char *) *buf);
66}
67
68static const unsigned char *
69cfsr_to_utf8str (CFStringRef cfsr, unsigned char **buf)
70{
71        const char *str = CFStringGetCStringPtr (cfsr, kCFStringEncodingUTF8);
72        if (str) {
73                *buf = NULL;
74                return ((const unsigned char *) str);
75        } else {
76#               define LONG_CHARS_PER_UTF8 6
77                return cfsr_to_utf8buf (cfsr, LONG_CHARS_PER_UTF8 * CFStringGetLength (cfsr), buf);
78#               undef LONG_CHARS_PER_UTF8
79        }
80}
81
82static const unsigned char *
83machine_name (unsigned char **buf)
84{
85        return cfsr_to_utf8str (CSCopyMachineName(), buf);
86}
87
88static const unsigned char *
89short_user_name (unsigned char **buf)
90{
91        return cfsr_to_utf8str (CSCopyUserName (true), buf);
92}
93
94static const unsigned char *
95long_user_name (unsigned char **buf)
96{
97        return cfsr_to_utf8str (CSCopyUserName (false), buf);
98}
99
100static void
101machine_location (double *lat, double *lon, int *dls, long *gmt)
102{
103#       define ROUNDN(v,p) (round((v) * ((p) * 10.0)) / ((p) * 10.0))
104        MachineLocation machloc;
105        ReadLocation (&machloc);
106        *lat = ROUNDN (((double) FractToFloat (machloc.latitude)) * 90.0, 4);
107        *lon = ROUNDN (((double) FractToFloat (machloc.longitude)) * 90.0, 4);
108        *dls = 0 < machloc.u.dls.Delta ? 3600 : (0 > machloc.u.dls.Delta ? -3600 : 0);
109        *gmt = ((machloc.u.gmtDelta & 0x00FFFFFF) << 8) >> 8;
110#       undef ROUNDN
111}
112
113static const unsigned char *
114computer_name (unsigned char **buf, SCDynamicStoreRef store)
115{
116  /* Assumes UTF8 encoding! */
117        CFStringRef cfsr = SCDynamicStoreCopyComputerName (store, NULL);
118        const unsigned char *str = cfsr_to_utf8str (cfsr, buf);
119        CFRelease (cfsr);
120        return str;
121}
122
123static const unsigned char *
124console_user (unsigned char **buf, uint32_t *puid, uint32_t *pgid, SCDynamicStoreRef store)
125{
126        uid_t uid;
127        gid_t gid;
128        CFStringRef cfsr = SCDynamicStoreCopyConsoleUser (store, &uid, &gid);
129        const unsigned char *str = cfsr_to_utf8str (cfsr, buf);
130        CFRelease (cfsr);
131        *puid = uid;
132        *pgid = gid;
133        return str;
134}
135
136static const unsigned char *
137local_host_name (unsigned char **buf, SCDynamicStoreRef store)
138{
139        CFStringRef cfsr = SCDynamicStoreCopyLocalHostName (store);
140        const unsigned char *str = cfsr_to_utf8str (cfsr, buf);
141        CFRelease (cfsr);
142        return str;
143}
144
145static const unsigned char *
146location_name (unsigned char **buf, SCDynamicStoreRef store)
147{
148        CFStringRef cfsr = SCDynamicStoreCopyLocation (store);
149        const unsigned char *str = cfsr_to_utf8str (cfsr, buf);
150        CFRelease (cfsr);
151        return str;
152}
153
154static const unsigned char *
155main_bundle_path (unsigned char **buf)
156{
157  CFBundleRef bundle = CFBundleGetMainBundle();
158  if (NULL != bundle) {
159    CFURLRef url = CFBundleCopyExecutableURL (bundle);
160    if (NULL != url) {
161      long buflen = pathconf ("/", _PC_PATH_MAX); /* Any pathname will do */
162      *buf = ((unsigned char *) C_malloc (buflen));
163      if (NULL != buf) {
164          if (CFURLGetFileSystemRepresentation (url, true, *buf, buflen))
165            return *buf;
166          else
167            C_free (buf);
168      }
169    }
170  }
171  return NULL;
172}
173
174static uint32_t
175string_to_OSType (char *str)
176{
177  union {uint32_t v; uint8_t c[4];} ost;
178  int i;
179  for (i = 0; i < VECLEN(ost.c) && *str; ++i, ++str)
180    ost.c[i] = (uint8_t) *str;
181  for (; i < VECLEN(ost.c); ++i)
182    ost.c[i] = (uint8_t) ' ';
183  return ost.v;
184}
185
186static int
187this_session_info_1 (uint32_t *psid, uint32_t *psab)
188{
189  SecuritySessionId mySession;
190  SessionAttributeBits sessionInfo;
191  OSStatus error = SessionGetInfo (callerSecuritySession, &mySession, &sessionInfo);
192  if (errSessionSuccess == error) {
193    *psid = mySession;
194    *psab = sessionInfo;
195    return 0;
196  }
197  return error;
198}
199
200#define session_LoginCompleted  0x0001
201#define session_UserIsActive    0x0010
202
203static const unsigned char *
204this_session_info_2 (unsigned char **buf, uint32_t *puid, uint32_t *pcon, uint32_t *pbit)
205{
206  CFDictionaryRef sessionInfoDict = CGSessionCopyCurrentDictionary();
207  if (NULL != sessionInfoDict) {
208    CFStringRef shortUserName = CFDictionaryGetValue (sessionInfoDict, kCGSessionUserNameKey);
209    CFNumberRef userUID = CFDictionaryGetValue (sessionInfoDict, kCGSessionUserIDKey);
210    CFNumberRef consoleSet = CFDictionaryGetValue (sessionInfoDict, kCGSessionConsoleSetKey);
211    CFBooleanRef userIsActive = CFDictionaryGetValue (sessionInfoDict, kCGSessionOnConsoleKey);
212    CFBooleanRef loginCompleted = CFDictionaryGetValue (sessionInfoDict, kCGSessionLoginDoneKey);
213    CFNumberGetValue (userUID, kCFNumberSInt32Type, puid);
214    CFNumberGetValue (consoleSet, kCFNumberSInt32Type, pcon);
215    *pbit = (CFBooleanGetValue (loginCompleted) << 1) | CFBooleanGetValue (userIsActive);
216    return cfsr_to_utf8str (shortUserName, buf);
217  }
218  return NULL;
219}
220<#
221
222;;
223
224(define-macro (call/unsigned-string-result C-NAME . EXTRA)
225        `(let-location ([buf unsigned-c-string*])
226                 ($ unsigned-c-string* ,C-NAME #$buf ,@EXTRA) ) )
227
228(define-macro (foreign-mask-set? ?bits ?c-nam)
229  `(not (zero? (bitwise-and ,?bits (foreign-value ,?c-nam unsigned-integer32)))) )
230
231;;
232
233(define (macosx:session-info)
234  (let-location ([sid unsigned-integer32] [sab unsigned-integer32])
235    (let ([sta ($ int this_session_info_1 #$sid #$sab)])
236      (if (fx= 0 sta)
237        (let ([vec (vector sid
238                           (foreign-mask-set? sab "sessionIsRoot")
239                           (foreign-mask-set? sab "sessionHasGraphicAccess")
240                           (foreign-mask-set? sab "sessionHasTTY")
241                           (foreign-mask-set? sab "sessionIsRemote")
242                           (foreign-mask-set? sab "sessionWasInitialized")
243                           #f #f #f #f #f)])
244          (let-location ([uid unsigned-integer32] [con unsigned-integer32] [bits unsigned-integer32])
245                  (let ([nam (call/unsigned-string-result this_session_info_2 #$uid #$con #$bits)])
246              (when nam
247                (vector-set! vec 6 nam)
248                (vector-set! vec 7 uid)
249                (vector-set! vec 8 con)
250                (vector-set! vec 9 (foreign-mask-set? bits "session_LoginCompleted"))
251                (vector-set! vec 10 (foreign-mask-set? bits "session_UserIsActive")) )
252              vec ) ) )
253        (error 'macosx:session-info "OSStatus" sta) ) ) ) )
254
255;;
256
257(define (macosx:machine-name)
258        (call/unsigned-string-result machine_name) )
259
260(define (macosx:short-user-name)
261        (call/unsigned-string-result short_user_name) )
262
263(define (macosx:long-user-name)
264        (call/unsigned-string-result long_user_name) )
265
266(define (macosx:machine-location)
267        (let-location ([lat double] [lon double] [dls int] [gmt long])
268                ($ void machine_location #$lat #$lon #$dls #$gmt)
269                (vector lat lon dls gmt) ) )
270
271(define (macosx:metric?)
272        ($ bool IsMetric) )
273
274;;
275
276(define (macosx:computer-name #!optional (store #f))
277        (call/unsigned-string-result computer_name (c-pointer store)) )
278
279(define (macosx:console-user #!optional (store #f))
280        (let-location ([uid unsigned-integer32] [gid unsigned-integer32])
281          (let ([nam (call/unsigned-string-result console_user #$uid #$gid (c-pointer store))])
282            (and nam
283                      (vector nam uid gid) ) ) ) )
284
285(define (macosx:local-host-name #!optional (store #f))
286        (call/unsigned-string-result local_host_name (c-pointer store)) )
287
288(define (macosx:location-name #!optional (store #f))
289        (call/unsigned-string-result location_name (c-pointer store)) )
290
291;;
292
293(define (macosx:main-bundle-path)
294  (call/unsigned-string-result main_bundle_path) )
295(define macosx:get-bundle-path macosx:main-bundle-path)
296
297;;
298
299(define (macosx:tick-count)
300  ($ unsigned-integer32 TickCount) )
301
302(define (macosx:delay ticks)
303        (let-location ([fticks unsigned-long])
304    ($ void Delay (unsigned-long ticks) #$fticks)
305    fticks ) )
306
307;;
308
309(define (macosx:gestalt sel)
310  ; Symbolic selector -> numeric
311  (when (symbol? sel)
312    (set! sel (symbol->string sel)))
313  (when (string? sel)
314    (set! sel ($ unsigned-integer32 string_to_OSType (c-string sel))))
315  ; Must be numeric
316  (unless (and (integer? sel) (positive? sel))
317    (error 'macosx:gestalt "invalid selector" sel))
318  ;
319        (let-location ([resp long])
320    (let ([err ($ short Gestalt (unsigned-integer32 sel) #$resp)])
321      (if (fx= 0 err)
322        resp
323        (error 'macosx:gestalt "OSErr" err) ) ) ) )
Note: See TracBrowser for help on using the repository browser.