OpenCores
URL https://opencores.org/ocsvn/or1k_old/or1k_old/trunk

Subversion Repositories or1k_old

[/] [or1k_old/] [trunk/] [insight/] [tcl/] [win/] [tclWinFile.c] - Blame information for rev 1782

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
/*
2
 * tclWinFile.c --
3
 *
4
 *      This file contains temporary wrappers around UNIX file handling
5
 *      functions. These wrappers map the UNIX functions to Win32 HANDLE-style
6
 *      files, which can be manipulated through the Win32 console redirection
7
 *      interfaces.
8
 *
9
 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
10
 *
11
 * See the file "license.terms" for information on usage and redistribution
12
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13
 *
14
 * RCS: @(#) $Id: tclWinFile.c,v 1.1.1.1 2002-01-16 10:25:38 markom Exp $
15
 */
16
 
17
#include "tclWinInt.h"
18
#include <sys/stat.h>
19
#ifndef __WIN32__
20
#include <shlobj.h>
21
#endif
22
 
23
/*
24
 * The variable below caches the name of the current working directory
25
 * in order to avoid repeated calls to getcwd.  The string is malloc-ed.
26
 * NULL means the cache needs to be refreshed.
27
 */
28
 
29
static char *currentDir =  NULL;
30
 
31
 
32
/*
33
 *----------------------------------------------------------------------
34
 *
35
 * Tcl_FindExecutable --
36
 *
37
 *      This procedure computes the absolute path name of the current
38
 *      application, given its argv[0] value.
39
 *
40
 * Results:
41
 *      None.
42
 *
43
 * Side effects:
44
 *      The variable tclExecutableName gets filled in with the file
45
 *      name for the application, if we figured it out.  If we couldn't
46
 *      figure it out, Tcl_FindExecutable is set to NULL.
47
 *
48
 *----------------------------------------------------------------------
49
 */
50
 
51
void
52
Tcl_FindExecutable(argv0)
53
    char *argv0;                /* The value of the application's argv[0]. */
54
{
55
    Tcl_DString buffer;
56
    int length;
57
 
58
    Tcl_DStringInit(&buffer);
59
 
60
    if (tclExecutableName != NULL) {
61
        ckfree(tclExecutableName);
62
        tclExecutableName = NULL;
63
    }
64
 
65
    /*
66
     * Under Windows we ignore argv0, and return the path for the file used to
67
     * create this process.
68
     */
69
 
70
    Tcl_DStringSetLength(&buffer, MAX_PATH+1);
71
    length = GetModuleFileName(NULL, Tcl_DStringValue(&buffer), MAX_PATH+1);
72
    if (length > 0) {
73
        tclExecutableName = (char *) ckalloc((unsigned) (length + 1));
74
        strcpy(tclExecutableName, Tcl_DStringValue(&buffer));
75
    }
76
    Tcl_DStringFree(&buffer);
77
}
78
 
79
/*
80
 *----------------------------------------------------------------------
81
 *
82
 * TclMatchFiles --
83
 *
84
 *      This routine is used by the globbing code to search a
85
 *      directory for all files which match a given pattern.
86
 *
87
 * Results:
88
 *      If the tail argument is NULL, then the matching files are
89
 *      added to the interp->result.  Otherwise, TclDoGlob is called
90
 *      recursively for each matching subdirectory.  The return value
91
 *      is a standard Tcl result indicating whether an error occurred
92
 *      in globbing.
93
 *
94
 * Side effects:
95
 *      None.
96
 *
97
 *---------------------------------------------------------------------- */
98
 
99
int
100
TclMatchFiles(interp, separators, dirPtr, pattern, tail)
101
    Tcl_Interp *interp;         /* Interpreter to receive results. */
102
    char *separators;           /* Directory separators to pass to TclDoGlob. */
103
    Tcl_DString *dirPtr;        /* Contains path to directory to search. */
104
    char *pattern;              /* Pattern to match against. */
105
    char *tail;                 /* Pointer to end of pattern.  Tail must
106
                                 * point to a location in pattern. */
107
{
108
    char drivePattern[4] = "?:\\";
109
    char *newPattern, *p, *dir, *root, c;
110
    char *src, *dest;
111
    int length, matchDotFiles;
112
    int result = TCL_OK;
113
    int baseLength = Tcl_DStringLength(dirPtr);
114
    Tcl_DString buffer;
115
    DWORD atts, volFlags;
116
    HANDLE handle;
117
    WIN32_FIND_DATA data;
118
    BOOL found;
119
 
120
    /*
121
     * Convert the path to normalized form since some interfaces only
122
     * accept backslashes.  Also, ensure that the directory ends with a
123
     * separator character.
124
     */
125
 
126
    Tcl_DStringInit(&buffer);
127
    if (baseLength == 0) {
128
        Tcl_DStringAppend(&buffer, ".", 1);
129
    } else {
130
        Tcl_DStringAppend(&buffer, Tcl_DStringValue(dirPtr),
131
                Tcl_DStringLength(dirPtr));
132
    }
133
    for (p = Tcl_DStringValue(&buffer); *p != '\0'; p++) {
134
        if (*p == '/') {
135
            *p = '\\';
136
        }
137
    }
138
    p--;
139
    if (*p != '\\' && *p != ':') {
140
        Tcl_DStringAppend(&buffer, "\\", 1);
141
    }
142
    dir = Tcl_DStringValue(&buffer);
143
 
144
    /*
145
     * First verify that the specified path is actually a directory.
146
     */
147
 
148
    atts = GetFileAttributes(dir);
149
    if ((atts == 0xFFFFFFFF) || ((atts & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
150
        Tcl_DStringFree(&buffer);
151
        return TCL_OK;
152
    }
153
 
154
    /*
155
     * Next check the volume information for the directory to see whether
156
     * comparisons should be case sensitive or not.  If the root is null, then
157
     * we use the root of the current directory.  If the root is just a drive
158
     * specifier, we use the root directory of the given drive.
159
     */
160
 
161
    switch (Tcl_GetPathType(dir)) {
162
        case TCL_PATH_RELATIVE:
163
            found = GetVolumeInformation(NULL, NULL, 0, NULL,
164
                    NULL, &volFlags, NULL, 0);
165
            break;
166
        case TCL_PATH_VOLUME_RELATIVE:
167
            if (*dir == '\\') {
168
                root = NULL;
169
            } else {
170
                root = drivePattern;
171
                *root = *dir;
172
            }
173
            found = GetVolumeInformation(root, NULL, 0, NULL,
174
                    NULL, &volFlags, NULL, 0);
175
            break;
176
        case TCL_PATH_ABSOLUTE:
177
            if (dir[1] == ':') {
178
                root = drivePattern;
179
                *root = *dir;
180
                found = GetVolumeInformation(root, NULL, 0, NULL,
181
                        NULL, &volFlags, NULL, 0);
182
            } else if (dir[1] == '\\') {
183
                p = strchr(dir+2, '\\');
184
                p = strchr(p+1, '\\');
185
                p++;
186
                c = *p;
187
                *p = 0;
188
                found = GetVolumeInformation(dir, NULL, 0, NULL,
189
                        NULL, &volFlags, NULL, 0);
190
                *p = c;
191
            }
192
            break;
193
    }
194
 
195
    if (!found) {
196
        Tcl_DStringFree(&buffer);
197
        TclWinConvertError(GetLastError());
198
        Tcl_ResetResult(interp);
199
        Tcl_AppendResult(interp, "couldn't read volume information for \"",
200
                dirPtr->string, "\": ", Tcl_PosixError(interp), (char *) NULL);
201
        return TCL_ERROR;
202
    }
203
 
204
    /*
205
     * In Windows, although some volumes may support case sensitivity, Windows
206
     * doesn't honor case.  So in globbing we need to ignore the case
207
     * of file names.
208
     */
209
 
210
    length = tail - pattern;
211
    newPattern = ckalloc(length+1);
212
    for (src = pattern, dest = newPattern; src < tail; src++, dest++) {
213
        *dest = (char) tolower(*src);
214
    }
215
    *dest = '\0';
216
 
217
    /*
218
     * We need to check all files in the directory, so append a *.*
219
     * to the path.
220
     */
221
 
222
 
223
    dir = Tcl_DStringAppend(&buffer, "*.*", 3);
224
 
225
    /*
226
     * Now open the directory for reading and iterate over the contents.
227
     */
228
 
229
    handle = FindFirstFile(dir, &data);
230
    Tcl_DStringFree(&buffer);
231
 
232
    if (handle == INVALID_HANDLE_VALUE) {
233
        TclWinConvertError(GetLastError());
234
        Tcl_ResetResult(interp);
235
        Tcl_AppendResult(interp, "couldn't read directory \"",
236
                dirPtr->string, "\": ", Tcl_PosixError(interp), (char *) NULL);
237
        ckfree(newPattern);
238
        return TCL_ERROR;
239
    }
240
 
241
    /*
242
     * Clean up the tail pointer.  Leave the tail pointing to the
243
     * first character after the path separator or NULL.
244
     */
245
 
246
    if (*tail == '\\') {
247
        tail++;
248
    }
249
    if (*tail == '\0') {
250
        tail = NULL;
251
    } else {
252
        tail++;
253
    }
254
 
255
    /*
256
     * Check to see if the pattern needs to compare with dot files.
257
     */
258
 
259
    if ((newPattern[0] == '.')
260
            || ((pattern[0] == '\\') && (pattern[1] == '.'))) {
261
        matchDotFiles = 1;
262
    } else {
263
        matchDotFiles = 0;
264
    }
265
 
266
    /*
267
     * Now iterate over all of the files in the directory.
268
     */
269
 
270
    Tcl_DStringInit(&buffer);
271
    for (found = 1; found; found = FindNextFile(handle, &data)) {
272
        char *matchResult;
273
 
274
        /*
275
         * Ignore hidden files.
276
         */
277
 
278
        if (!matchDotFiles && (data.cFileName[0] == '.')) {
279
            continue;
280
        }
281
 
282
        /*
283
         * Check to see if the file matches the pattern.  We need to convert
284
         * the file name to lower case for comparison purposes.  Note that we
285
         * are ignoring the case sensitivity flag because Windows doesn't honor
286
         * case even if the volume is case sensitive.  If the volume also
287
         * doesn't preserve case, then we return the lower case form of the
288
         * name, otherwise we return the system form.
289
         */
290
 
291
        matchResult = NULL;
292
        Tcl_DStringSetLength(&buffer, 0);
293
        Tcl_DStringAppend(&buffer, data.cFileName, -1);
294
        for (p = buffer.string; *p != '\0'; p++) {
295
            *p = (char) tolower(*p);
296
        }
297
        if (Tcl_StringMatch(buffer.string, newPattern)) {
298
            if (volFlags & FS_CASE_IS_PRESERVED) {
299
                matchResult = data.cFileName;
300
            } else {
301
                matchResult = buffer.string;
302
            }
303
        }
304
 
305
        if (matchResult == NULL) {
306
            continue;
307
        }
308
 
309
        /*
310
         * If the file matches, then we need to process the remainder of the
311
         * path.  If there are more characters to process, then ensure matching
312
         * files are directories and call TclDoGlob. Otherwise, just add the
313
         * file to the result.
314
         */
315
 
316
        Tcl_DStringSetLength(dirPtr, baseLength);
317
        Tcl_DStringAppend(dirPtr, matchResult, -1);
318
        if (tail == NULL) {
319
            Tcl_AppendElement(interp, dirPtr->string);
320
        } else {
321
            atts = GetFileAttributes(dirPtr->string);
322
            if (atts & FILE_ATTRIBUTE_DIRECTORY) {
323
                Tcl_DStringAppend(dirPtr, "/", 1);
324
                result = TclDoGlob(interp, separators, dirPtr, tail);
325
                if (result != TCL_OK) {
326
                    break;
327
                }
328
            }
329
        }
330
    }
331
 
332
    Tcl_DStringFree(&buffer);
333
    FindClose(handle);
334
    ckfree(newPattern);
335
    return result;
336
}
337
 
338
/*
339
 *----------------------------------------------------------------------
340
 *
341
 * TclChdir --
342
 *
343
 *      Change the current working directory.
344
 *
345
 * Results:
346
 *      The result is a standard Tcl result.  If an error occurs and
347
 *      interp isn't NULL, an error message is left in interp->result.
348
 *
349
 * Side effects:
350
 *      The working directory for this application is changed.  Also
351
 *      the cache maintained used by TclGetCwd is deallocated and
352
 *      set to NULL.
353
 *
354
 *----------------------------------------------------------------------
355
 */
356
 
357
int
358
TclChdir(interp, dirName)
359
    Tcl_Interp *interp;         /* If non NULL, used for error reporting. */
360
    char *dirName;              /* Path to new working directory. */
361
{
362
    if (currentDir != NULL) {
363
        ckfree(currentDir);
364
        currentDir = NULL;
365
    }
366
    /* CYGNUS LOCAL: On cygwin, we must use chdir.  Otherwise, the
367
       cygwin notion of the current directory will get messed up.  */
368
#ifdef __CYGWIN__
369
    if (chdir(dirName) < 0) {
370
#else
371
    if (!SetCurrentDirectory(dirName)) {
372
        TclWinConvertError(GetLastError());
373
#endif
374
        if (interp != NULL) {
375
            Tcl_AppendResult(interp, "couldn't change working directory to \"",
376
                    dirName, "\": ", Tcl_PosixError(interp), (char *) NULL);
377
        }
378
        return TCL_ERROR;
379
    }
380
    return TCL_OK;
381
}
382
 
383
/*
384
 *----------------------------------------------------------------------
385
 *
386
 * TclGetCwd --
387
 *
388
 *      Return the path name of the current working directory.
389
 *
390
 * Results:
391
 *      The result is the full path name of the current working
392
 *      directory, or NULL if an error occurred while figuring it
393
 *      out.  If an error occurs and interp isn't NULL, an error
394
 *      message is left in interp->result.
395
 *
396
 * Side effects:
397
 *      The path name is cached to avoid having to recompute it
398
 *      on future calls;  if it is already cached, the cached
399
 *      value is returned.
400
 *
401
 *----------------------------------------------------------------------
402
 */
403
 
404
char *
405
TclGetCwd(interp)
406
    Tcl_Interp *interp;         /* If non NULL, used for error reporting. */
407
{
408
    static char buffer[MAXPATHLEN+1];
409
    char *bufPtr, *p;
410
 
411
    if (currentDir == NULL) {
412
        if (GetCurrentDirectory(MAXPATHLEN+1, buffer) == 0) {
413
            TclWinConvertError(GetLastError());
414
            if (interp != NULL) {
415
                if (errno == ERANGE) {
416
                    Tcl_SetResult(interp,
417
                            "working directory name is too long",
418
                            TCL_STATIC);
419
                } else {
420
                    Tcl_AppendResult(interp,
421
                            "error getting working directory name: ",
422
                            Tcl_PosixError(interp), (char *) NULL);
423
                }
424
            }
425
            return NULL;
426
        }
427
        /*
428
         * Watch for the wierd Windows '95 c:\\UNC syntax.
429
         */
430
 
431
        if (buffer[0] != '\0' && buffer[1] == ':' && buffer[2] == '\\'
432
                && buffer[3] == '\\') {
433
            bufPtr = &buffer[2];
434
        } else {
435
            bufPtr = buffer;
436
        }
437
 
438
        /*
439
         * Convert to forward slashes for easier use in scripts.
440
         */
441
 
442
        for (p = bufPtr; *p != '\0'; p++) {
443
            if (*p == '\\') {
444
                *p = '/';
445
            }
446
        }
447
    }
448
    return bufPtr;
449
}
450
 
451
#if 0
452
/*
453
 *-------------------------------------------------------------------------
454
 *
455
 * TclWinResolveShortcut --
456
 *
457
 *      Resolve a potential Windows shortcut to get the actual file or
458
 *      directory in question.
459
 *
460
 * Results:
461
 *      Returns 1 if the shortcut could be resolved, or 0 if there was
462
 *      an error or if the filename was not a shortcut.
463
 *      If bufferPtr did hold the name of a shortcut, it is modified to
464
 *      hold the resolved target of the shortcut instead.
465
 *
466
 * Side effects:
467
 *      Loads and unloads OLE package to determine if filename refers to
468
 *      a shortcut.
469
 *
470
 *-------------------------------------------------------------------------
471
 */
472
 
473
int
474
TclWinResolveShortcut(bufferPtr)
475
    Tcl_DString *bufferPtr;     /* Holds name of file to resolve.  On
476
                                 * return, holds resolved file name. */
477
{
478
    HRESULT hres;
479
    IShellLink *psl;
480
    IPersistFile *ppf;
481
    WIN32_FIND_DATA wfd;
482
    WCHAR wpath[MAX_PATH];
483
    char *path, *ext;
484
    char realFileName[MAX_PATH];
485
 
486
    /*
487
     * Windows system calls do not automatically resolve
488
     * shortcuts like UNIX automatically will with symbolic links.
489
     */
490
 
491
    path = Tcl_DStringValue(bufferPtr);
492
    ext = strrchr(path, '.');
493
    if ((ext == NULL) || (stricmp(ext, ".lnk") != 0)) {
494
        return 0;
495
    }
496
 
497
    CoInitialize(NULL);
498
    path = Tcl_DStringValue(bufferPtr);
499
    realFileName[0] = '\0';
500
    hres = CoCreateInstance(&CLSID_ShellLink, NULL, CLSCTX_INPROC_SERVER,
501
            &IID_IShellLink, &psl);
502
    if (SUCCEEDED(hres)) {
503
        hres = psl->lpVtbl->QueryInterface(psl, &IID_IPersistFile, &ppf);
504
        if (SUCCEEDED(hres)) {
505
            MultiByteToWideChar(CP_ACP, 0, path, -1, wpath, sizeof(wpath));
506
            hres = ppf->lpVtbl->Load(ppf, wpath, STGM_READ);
507
            if (SUCCEEDED(hres)) {
508
                hres = psl->lpVtbl->Resolve(psl, NULL,
509
                        SLR_ANY_MATCH | SLR_NO_UI);
510
                if (SUCCEEDED(hres)) {
511
                    hres = psl->lpVtbl->GetPath(psl, realFileName, MAX_PATH,
512
                            &wfd, 0);
513
                }
514
            }
515
            ppf->lpVtbl->Release(ppf);
516
        }
517
        psl->lpVtbl->Release(psl);
518
    }
519
    CoUninitialize();
520
 
521
    if (realFileName[0] != '\0') {
522
        Tcl_DStringSetLength(bufferPtr, 0);
523
        Tcl_DStringAppend(bufferPtr, realFileName, -1);
524
        return 1;
525
    }
526
    return 0;
527
}
528
#endif
529
 
530
/*
531
 *----------------------------------------------------------------------
532
 *
533
 * TclpStat, TclpLstat --
534
 *
535
 *      These functions replace the library versions of stat and lstat.
536
 *
537
 *      The stat and lstat functions provided by some Windows compilers
538
 *      are incomplete.  Ideally, a complete rewrite of stat would go
539
 *      here; now, the only fix is that stat("c:") used to return an
540
 *      error instead infor for current dir on specified drive.
541
 *
542
 * Results:
543
 *      See stat documentation.
544
 *
545
 * Side effects:
546
 *      See stat documentation.
547
 *
548
 *----------------------------------------------------------------------
549
 */
550
 
551
int
552
TclpStat(path, buf)
553
    CONST char *path;           /* Path of file to stat (in current CP). */
554
    struct stat *buf;           /* Filled with results of stat call. */
555
{
556
    char name[4];
557
    int result;
558
 
559
    if ((strlen(path) == 2) && (path[1] == ':')) {
560
        strcpy(name, path);
561
        name[2] = '.';
562
        name[3] = '\0';
563
        path = name;
564
    }
565
 
566
#undef stat
567
 
568
    result = stat(path, buf);
569
 
570
#if ! defined (_MSC_VER) && ! defined (__CYGWIN__)
571
 
572
    /*
573
     * Borland's stat doesn't take into account localtime.
574
     */
575
 
576
    if ((result == 0) && (buf->st_mtime != 0)) {
577
        TIME_ZONE_INFORMATION tz;
578
        int time, bias;
579
 
580
        time = GetTimeZoneInformation(&tz);
581
        bias = tz.Bias;
582
        if (time == TIME_ZONE_ID_DAYLIGHT) {
583
            bias += tz.DaylightBias;
584
        }
585
        bias *= 60;
586
        buf->st_atime -= bias;
587
        buf->st_ctime -= bias;
588
        buf->st_mtime -= bias;
589
    }
590
 
591
#endif
592
 
593
    return result;
594
}
595
 
596
/*
597
 *---------------------------------------------------------------------------
598
 *
599
 * TclpAccess --
600
 *
601
 *      This function replaces the library version of access.
602
 *
603
 *      The library version of access returns that all files have execute
604
 *      permission.
605
 *
606
 * Results:
607
 *      See access documentation.
608
 *
609
 * Side effects:
610
 *      See access documentation.
611
 *
612
 *---------------------------------------------------------------------------
613
 */
614
 
615
int
616
TclpAccess(
617
    CONST char *path,           /* Path of file to access (in current CP). */
618
    int mode)                   /* Permission setting. */
619
{
620
    int result;
621
    CONST char *p;
622
 
623
#undef access
624
 
625
    result = access(path, mode);
626
 
627
    if (result == 0) {
628
        if (mode & 1) {
629
            if (GetFileAttributes(path) & FILE_ATTRIBUTE_DIRECTORY) {
630
                /*
631
                 * Directories are always executable.
632
                 */
633
 
634
                return 0;
635
            }
636
            p = strrchr(path, '.');
637
            if (p != NULL) {
638
                p++;
639
                if ((stricmp(p, "exe") == 0)
640
                        || (stricmp(p, "com") == 0)
641
                        || (stricmp(p, "bat") == 0)) {
642
                    /*
643
                     * File that ends with .exe, .com, or .bat is executable.
644
                     */
645
 
646
                    return 0;
647
                }
648
            }
649
            errno = EACCES;
650
            return -1;
651
        }
652
    }
653
    return result;
654
}
655
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.