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

Subversion Repositories or1k_old

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
/*
2
 * tclWinChan.c
3
 *
4
 *      Channel drivers for Windows channels based on files, command
5
 *      pipes and TCP sockets.
6
 *
7
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
8
 *
9
 * See the file "license.terms" for information on usage and redistribution
10
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
11
 *
12
 * RCS: @(#) $Id: tclWinChan.c,v 1.1.1.1 2002-01-16 10:25:38 markom Exp $
13
 */
14
 
15
#include "tclWinInt.h"
16
 
17
/*
18
 * This is the size of the channel name for File based channels
19
 */
20
 
21
#define CHANNEL_NAME_SIZE       64
22
static char channelName[CHANNEL_NAME_SIZE+1];
23
 
24
/*
25
 * The following variable is used to tell whether this module has been
26
 * initialized.
27
 */
28
 
29
static int initialized = 0;
30
 
31
/*
32
 * State flags used in the info structures below.
33
 */
34
 
35
#define FILE_PENDING    (1<<0)  /* Message is pending in the queue. */
36
#define FILE_ASYNC      (1<<1)  /* Channel is non-blocking. */
37
#define FILE_APPEND     (1<<2)  /* File is in append mode. */
38
 
39
/*
40
 * The following structure contains per-instance data for a file based channel.
41
 */
42
 
43
typedef struct FileInfo {
44
    Tcl_Channel channel;        /* Pointer to channel structure. */
45
    int validMask;              /* OR'ed combination of TCL_READABLE,
46
                                 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
47
                                 * which operations are valid on the file. */
48
    int watchMask;              /* OR'ed combination of TCL_READABLE,
49
                                 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
50
                                 * which events should be reported. */
51
    int flags;                  /* State flags, see above for a list. */
52
    HANDLE handle;              /* Input/output file. */
53
    struct FileInfo *nextPtr;   /* Pointer to next registered file. */
54
} FileInfo;
55
 
56
/*
57
 * List of all file channels currently open.
58
 */
59
 
60
static FileInfo *firstFilePtr;
61
 
62
/*
63
 * The following structure is what is added to the Tcl event queue when
64
 * file events are generated.
65
 */
66
 
67
typedef struct FileEvent {
68
    Tcl_Event header;           /* Information that is standard for
69
                                 * all events. */
70
    FileInfo *infoPtr;          /* Pointer to file info structure.  Note
71
                                 * that we still have to verify that the
72
                                 * file exists before dereferencing this
73
                                 * pointer. */
74
} FileEvent;
75
 
76
/*
77
 * Static routines for this file:
78
 */
79
 
80
static int              ComGetOptionProc _ANSI_ARGS_((ClientData instanceData,
81
                            Tcl_Interp *interp, char *optionName,
82
                            Tcl_DString *dsPtr));
83
static int              ComInputProc _ANSI_ARGS_((ClientData instanceData,
84
                            char *buf, int toRead, int *errorCode));
85
static int              ComSetOptionProc _ANSI_ARGS_((ClientData instanceData,
86
                            Tcl_Interp *interp, char *optionName,
87
                            char *value));
88
static int              FileBlockProc _ANSI_ARGS_((ClientData instanceData,
89
                            int mode));
90
static void             FileChannelExitHandler _ANSI_ARGS_((
91
                            ClientData clientData));
92
static void             FileCheckProc _ANSI_ARGS_((ClientData clientData,
93
                            int flags));
94
static int              FileCloseProc _ANSI_ARGS_((ClientData instanceData,
95
                            Tcl_Interp *interp));
96
static int              FileEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
97
                            int flags));
98
static int              FileGetHandleProc _ANSI_ARGS_((ClientData instanceData,
99
                            int direction, ClientData *handlePtr));
100
static void             FileInit _ANSI_ARGS_((void));
101
static int              FileInputProc _ANSI_ARGS_((ClientData instanceData,
102
                            char *buf, int toRead, int *errorCode));
103
static int              FileOutputProc _ANSI_ARGS_((ClientData instanceData,
104
                            char *buf, int toWrite, int *errorCode));
105
static int              FileSeekProc _ANSI_ARGS_((ClientData instanceData,
106
                            long offset, int mode, int *errorCode));
107
static void             FileSetupProc _ANSI_ARGS_((ClientData clientData,
108
                            int flags));
109
static void             FileWatchProc _ANSI_ARGS_((ClientData instanceData,
110
                            int mask));
111
 
112
 
113
/*
114
 * This structure describes the channel type structure for file based IO.
115
 */
116
 
117
static Tcl_ChannelType fileChannelType = {
118
    "file",                     /* Type name. */
119
    FileBlockProc,              /* Set blocking or non-blocking mode.*/
120
    FileCloseProc,              /* Close proc. */
121
    FileInputProc,              /* Input proc. */
122
    FileOutputProc,             /* Output proc. */
123
    FileSeekProc,               /* Seek proc. */
124
    NULL,                       /* Set option proc. */
125
    NULL,                       /* Get option proc. */
126
    FileWatchProc,              /* Set up the notifier to watch the channel. */
127
    FileGetHandleProc,          /* Get an OS handle from channel. */
128
};
129
 
130
static Tcl_ChannelType comChannelType = {
131
    "com",                      /* Type name. */
132
    FileBlockProc,              /* Set blocking or non-blocking mode.*/
133
    FileCloseProc,              /* Close proc. */
134
    ComInputProc,               /* Input proc. */
135
    FileOutputProc,             /* Output proc. */
136
    NULL,                       /* Seek proc. */
137
    ComSetOptionProc,           /* Set option proc. */
138
    ComGetOptionProc,           /* Get option proc. */
139
    FileWatchProc,              /* Set up notifier to watch the channel. */
140
    FileGetHandleProc           /* Get an OS handle from channel. */
141
};
142
 
143
/*
144
 *----------------------------------------------------------------------
145
 *
146
 * FileInit --
147
 *
148
 *      This function creates the window used to simulate file events.
149
 *
150
 * Results:
151
 *      None.
152
 *
153
 * Side effects:
154
 *      Creates a new window and creates an exit handler.
155
 *
156
 *----------------------------------------------------------------------
157
 */
158
 
159
static void
160
FileInit()
161
{
162
    initialized = 1;
163
    firstFilePtr = NULL;
164
    Tcl_CreateEventSource(FileSetupProc, FileCheckProc, NULL);
165
    Tcl_CreateExitHandler(FileChannelExitHandler, NULL);
166
}
167
 
168
/*
169
 *----------------------------------------------------------------------
170
 *
171
 * FileChannelExitHandler --
172
 *
173
 *      This function is called to cleanup the channel driver before
174
 *      Tcl is unloaded.
175
 *
176
 * Results:
177
 *      None.
178
 *
179
 * Side effects:
180
 *      Destroys the communication window.
181
 *
182
 *----------------------------------------------------------------------
183
 */
184
 
185
static void
186
FileChannelExitHandler(clientData)
187
    ClientData clientData;      /* Old window proc */
188
{
189
    Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL);
190
    initialized = 0;
191
}
192
 
193
/*
194
 *----------------------------------------------------------------------
195
 *
196
 * FileSetupProc --
197
 *
198
 *      This procedure is invoked before Tcl_DoOneEvent blocks waiting
199
 *      for an event.
200
 *
201
 * Results:
202
 *      None.
203
 *
204
 * Side effects:
205
 *      Adjusts the block time if needed.
206
 *
207
 *----------------------------------------------------------------------
208
 */
209
 
210
void
211
FileSetupProc(data, flags)
212
    ClientData data;            /* Not used. */
213
    int flags;                  /* Event flags as passed to Tcl_DoOneEvent. */
214
{
215
    FileInfo *infoPtr;
216
    Tcl_Time blockTime = { 0, 0 };
217
 
218
    if (!(flags & TCL_FILE_EVENTS)) {
219
        return;
220
    }
221
 
222
    /*
223
     * Check to see if there is a ready file.  If so, poll.
224
     */
225
 
226
    for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
227
        if (infoPtr->watchMask) {
228
            Tcl_SetMaxBlockTime(&blockTime);
229
            break;
230
        }
231
    }
232
}
233
 
234
/*
235
 *----------------------------------------------------------------------
236
 *
237
 * FileCheckProc --
238
 *
239
 *      This procedure is called by Tcl_DoOneEvent to check the file
240
 *      event source for events.
241
 *
242
 * Results:
243
 *      None.
244
 *
245
 * Side effects:
246
 *      May queue an event.
247
 *
248
 *----------------------------------------------------------------------
249
 */
250
 
251
static void
252
FileCheckProc(data, flags)
253
    ClientData data;            /* Not used. */
254
    int flags;                  /* Event flags as passed to Tcl_DoOneEvent. */
255
{
256
    FileEvent *evPtr;
257
    FileInfo *infoPtr;
258
 
259
    if (!(flags & TCL_FILE_EVENTS)) {
260
        return;
261
    }
262
 
263
    /*
264
     * Queue events for any ready files that don't already have events
265
     * queued (caused by persistent states that won't generate WinSock
266
     * events).
267
     */
268
 
269
    for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
270
        if (infoPtr->watchMask && !(infoPtr->flags & FILE_PENDING)) {
271
            infoPtr->flags |= FILE_PENDING;
272
            evPtr = (FileEvent *) ckalloc(sizeof(FileEvent));
273
            evPtr->header.proc = FileEventProc;
274
            evPtr->infoPtr = infoPtr;
275
            Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
276
        }
277
    }
278
}
279
 
280
/*----------------------------------------------------------------------
281
 *
282
 * FileEventProc --
283
 *
284
 *      This function is invoked by Tcl_ServiceEvent when a file event
285
 *      reaches the front of the event queue.  This procedure invokes
286
 *      Tcl_NotifyChannel on the file.
287
 *
288
 * Results:
289
 *      Returns 1 if the event was handled, meaning it should be removed
290
 *      from the queue.  Returns 0 if the event was not handled, meaning
291
 *      it should stay on the queue.  The only time the event isn't
292
 *      handled is if the TCL_FILE_EVENTS flag bit isn't set.
293
 *
294
 * Side effects:
295
 *      Whatever the notifier callback does.
296
 *
297
 *----------------------------------------------------------------------
298
 */
299
 
300
static int
301
FileEventProc(evPtr, flags)
302
    Tcl_Event *evPtr;           /* Event to service. */
303
    int flags;                  /* Flags that indicate what events to
304
                                 * handle, such as TCL_FILE_EVENTS. */
305
{
306
    FileEvent *fileEvPtr = (FileEvent *)evPtr;
307
    FileInfo *infoPtr;
308
 
309
    if (!(flags & TCL_FILE_EVENTS)) {
310
        return 0;
311
    }
312
 
313
    /*
314
     * Search through the list of watched files for the one whose handle
315
     * matches the event.  We do this rather than simply dereferencing
316
     * the handle in the event so that files can be deleted while the
317
     * event is in the queue.
318
     */
319
 
320
    for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
321
        if (fileEvPtr->infoPtr == infoPtr) {
322
            infoPtr->flags &= ~(FILE_PENDING);
323
            Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask);
324
            break;
325
        }
326
    }
327
    return 1;
328
}
329
 
330
/*
331
 *----------------------------------------------------------------------
332
 *
333
 * FileBlockProc --
334
 *
335
 *      Set blocking or non-blocking mode on channel.
336
 *
337
 * Results:
338
 *      0 if successful, errno when failed.
339
 *
340
 * Side effects:
341
 *      Sets the device into blocking or non-blocking mode.
342
 *
343
 *----------------------------------------------------------------------
344
 */
345
 
346
static int
347
FileBlockProc(instanceData, mode)
348
    ClientData instanceData;    /* Instance data for channel. */
349
    int mode;                   /* TCL_MODE_BLOCKING or
350
                                 * TCL_MODE_NONBLOCKING. */
351
{
352
    FileInfo *infoPtr = (FileInfo *) instanceData;
353
 
354
    /*
355
     * Files on Windows can not be switched between blocking and nonblocking,
356
     * hence we have to emulate the behavior. This is done in the input
357
     * function by checking against a bit in the state. We set or unset the
358
     * bit here to cause the input function to emulate the correct behavior.
359
     */
360
 
361
    if (mode == TCL_MODE_NONBLOCKING) {
362
        infoPtr->flags |= FILE_ASYNC;
363
    } else {
364
        infoPtr->flags &= ~(FILE_ASYNC);
365
    }
366
    return 0;
367
}
368
 
369
/*
370
 *----------------------------------------------------------------------
371
 *
372
 * FileCloseProc --
373
 *
374
 *      Closes the IO channel.
375
 *
376
 * Results:
377
 *      0 if successful, the value of errno if failed.
378
 *
379
 * Side effects:
380
 *      Closes the physical channel
381
 *
382
 *----------------------------------------------------------------------
383
 */
384
 
385
static int
386
FileCloseProc(instanceData, interp)
387
    ClientData instanceData;    /* Pointer to FileInfo structure. */
388
    Tcl_Interp *interp;         /* Not used. */
389
{
390
    FileInfo *fileInfoPtr = (FileInfo *) instanceData;
391
    FileInfo **nextPtrPtr;
392
    int errorCode = 0;
393
 
394
    /*
395
     * Remove the file from the watch list.
396
     */
397
 
398
    FileWatchProc(instanceData, 0);
399
 
400
    if (CloseHandle(fileInfoPtr->handle) == FALSE) {
401
        TclWinConvertError(GetLastError());
402
        errorCode = errno;
403
    }
404
    for (nextPtrPtr = &firstFilePtr; (*nextPtrPtr) != NULL;
405
         nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
406
        if ((*nextPtrPtr) == fileInfoPtr) {
407
            (*nextPtrPtr) = fileInfoPtr->nextPtr;
408
            break;
409
        }
410
    }
411
    ckfree((char *)fileInfoPtr);
412
    return errorCode;
413
}
414
 
415
/*
416
 *----------------------------------------------------------------------
417
 *
418
 * FileSeekProc --
419
 *
420
 *      Seeks on a file-based channel. Returns the new position.
421
 *
422
 * Results:
423
 *      -1 if failed, the new position if successful. If failed, it
424
 *      also sets *errorCodePtr to the error code.
425
 *
426
 * Side effects:
427
 *      Moves the location at which the channel will be accessed in
428
 *      future operations.
429
 *
430
 *----------------------------------------------------------------------
431
 */
432
 
433
static int
434
FileSeekProc(instanceData, offset, mode, errorCodePtr)
435
    ClientData instanceData;                    /* File state. */
436
    long offset;                                /* Offset to seek to. */
437
    int mode;                                   /* Relative to where
438
                                                 * should we seek? */
439
    int *errorCodePtr;                          /* To store error code. */
440
{
441
    FileInfo *infoPtr = (FileInfo *) instanceData;
442
    DWORD moveMethod;
443
    DWORD newPos;
444
 
445
    *errorCodePtr = 0;
446
    if (mode == SEEK_SET) {
447
        moveMethod = FILE_BEGIN;
448
    } else if (mode == SEEK_CUR) {
449
        moveMethod = FILE_CURRENT;
450
    } else {
451
        moveMethod = FILE_END;
452
    }
453
 
454
    newPos = SetFilePointer(infoPtr->handle, offset, NULL, moveMethod);
455
    if (newPos == 0xFFFFFFFF) {
456
        TclWinConvertError(GetLastError());
457
        return -1;
458
    }
459
    return newPos;
460
}
461
 
462
/*
463
 *----------------------------------------------------------------------
464
 *
465
 * FileInputProc --
466
 *
467
 *      Reads input from the IO channel into the buffer given. Returns
468
 *      count of how many bytes were actually read, and an error indication.
469
 *
470
 * Results:
471
 *      A count of how many bytes were read is returned and an error
472
 *      indication is returned in an output argument.
473
 *
474
 * Side effects:
475
 *      Reads input from the actual channel.
476
 *
477
 *----------------------------------------------------------------------
478
 */
479
 
480
static int
481
FileInputProc(instanceData, buf, bufSize, errorCode)
482
    ClientData instanceData;            /* File state. */
483
    char *buf;                          /* Where to store data read. */
484
    int bufSize;                        /* How much space is available
485
                                         * in the buffer? */
486
    int *errorCode;                     /* Where to store error code. */
487
{
488
    FileInfo *infoPtr;
489
    DWORD bytesRead;
490
 
491
    *errorCode = 0;
492
    infoPtr = (FileInfo *) instanceData;
493
 
494
    /*
495
     * Note that we will block on reads from a console buffer until a
496
     * full line has been entered.  The only way I know of to get
497
     * around this is to write a console driver.  We should probably
498
     * do this at some point, but for now, we just block.  The same
499
     * problem exists for files being read over the network.
500
     */
501
 
502
    if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
503
            (LPOVERLAPPED) NULL) != FALSE) {
504
        return bytesRead;
505
    }
506
 
507
    TclWinConvertError(GetLastError());
508
    *errorCode = errno;
509
    if (errno == EPIPE) {
510
        return 0;
511
    }
512
    return -1;
513
}
514
 
515
/*
516
 *----------------------------------------------------------------------
517
 *
518
 * FileOutputProc --
519
 *
520
 *      Writes the given output on the IO channel. Returns count of how
521
 *      many characters were actually written, and an error indication.
522
 *
523
 * Results:
524
 *      A count of how many characters were written is returned and an
525
 *      error indication is returned in an output argument.
526
 *
527
 * Side effects:
528
 *      Writes output on the actual channel.
529
 *
530
 *----------------------------------------------------------------------
531
 */
532
 
533
static int
534
FileOutputProc(instanceData, buf, toWrite, errorCode)
535
    ClientData instanceData;            /* File state. */
536
    char *buf;                          /* The data buffer. */
537
    int toWrite;                        /* How many bytes to write? */
538
    int *errorCode;                     /* Where to store error code. */
539
{
540
    FileInfo *infoPtr = (FileInfo *) instanceData;
541
    DWORD bytesWritten;
542
 
543
    *errorCode = 0;
544
 
545
    /*
546
     * If we are writing to a file that was opened with O_APPEND, we need to
547
     * seek to the end of the file before writing the current buffer.
548
     */
549
 
550
    if (infoPtr->flags & FILE_APPEND) {
551
        SetFilePointer(infoPtr->handle, 0, NULL, FILE_END);
552
    }
553
 
554
    if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite, &bytesWritten,
555
            (LPOVERLAPPED) NULL) == FALSE) {
556
        TclWinConvertError(GetLastError());
557
        *errorCode = errno;
558
        return -1;
559
    }
560
    FlushFileBuffers(infoPtr->handle);
561
    return bytesWritten;
562
}
563
 
564
/*
565
 *----------------------------------------------------------------------
566
 *
567
 * FileWatchProc --
568
 *
569
 *      Called by the notifier to set up to watch for events on this
570
 *      channel.
571
 *
572
 * Results:
573
 *      None.
574
 *
575
 * Side effects:
576
 *      None.
577
 *
578
 *----------------------------------------------------------------------
579
 */
580
 
581
static void
582
FileWatchProc(instanceData, mask)
583
    ClientData instanceData;            /* File state. */
584
    int mask;                           /* What events to watch for; OR-ed
585
                                         * combination of TCL_READABLE,
586
                                         * TCL_WRITABLE and TCL_EXCEPTION. */
587
{
588
    FileInfo *infoPtr = (FileInfo *) instanceData;
589
    Tcl_Time blockTime = { 0, 0 };
590
 
591
    /*
592
     * Since the file is always ready for events, we set the block time
593
     * to zero so we will poll.
594
     */
595
 
596
    infoPtr->watchMask = mask & infoPtr->validMask;
597
    if (infoPtr->watchMask) {
598
        Tcl_SetMaxBlockTime(&blockTime);
599
    }
600
}
601
 
602
/*
603
 *----------------------------------------------------------------------
604
 *
605
 * FileGetHandleProc --
606
 *
607
 *      Called from Tcl_GetChannelFile to retrieve OS handles from
608
 *      a file based channel.
609
 *
610
 * Results:
611
 *      Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if
612
 *      there is no handle for the specified direction.
613
 *
614
 * Side effects:
615
 *      None.
616
 *
617
 *----------------------------------------------------------------------
618
 */
619
 
620
static int
621
FileGetHandleProc(instanceData, direction, handlePtr)
622
    ClientData instanceData;    /* The file state. */
623
    int direction;              /* TCL_READABLE or TCL_WRITABLE */
624
    ClientData *handlePtr;      /* Where to store the handle.  */
625
{
626
    FileInfo *infoPtr = (FileInfo *) instanceData;
627
 
628
    if (direction & infoPtr->validMask) {
629
        *handlePtr = (ClientData) infoPtr->handle;
630
        return TCL_OK;
631
    } else {
632
        return TCL_ERROR;
633
    }
634
}
635
 
636
/*
637
 *----------------------------------------------------------------------
638
 *
639
 * ComInputProc --
640
 *
641
 *      Reads input from the IO channel into the buffer given. Returns
642
 *      count of how many bytes were actually read, and an error indication.
643
 *
644
 * Results:
645
 *      A count of how many bytes were read is returned and an error
646
 *      indication is returned in an output argument.
647
 *
648
 * Side effects:
649
 *      Reads input from the actual channel.
650
 *
651
 *----------------------------------------------------------------------
652
 */
653
 
654
static int
655
ComInputProc(instanceData, buf, bufSize, errorCode)
656
    ClientData instanceData;    /* File state. */
657
    char *buf;                  /* Where to store data read. */
658
    int bufSize;                /* How much space is available
659
                                 * in the buffer? */
660
    int *errorCode;             /* Where to store error code. */
661
{
662
    FileInfo *infoPtr;
663
    DWORD bytesRead;
664
    DWORD dw;
665
    COMSTAT cs;
666
 
667
    *errorCode = 0;
668
    infoPtr = (FileInfo *) instanceData;
669
 
670
    if (ClearCommError(infoPtr->handle, &dw, &cs)) {
671
        if (dw != 0) {
672
            *errorCode = EIO;
673
            return -1;
674
        }
675
        if (cs.cbInQue != 0) {
676
            if ((DWORD) bufSize > cs.cbInQue) {
677
                bufSize = cs.cbInQue;
678
            }
679
        } else {
680
            if (infoPtr->flags & FILE_ASYNC) {
681
                errno = *errorCode = EAGAIN;
682
                return -1;
683
            } else {
684
                bufSize = 1;
685
            }
686
        }
687
    }
688
 
689
    if (ReadFile(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
690
            (LPOVERLAPPED) NULL) == FALSE) {
691
        TclWinConvertError(GetLastError());
692
        *errorCode = errno;
693
        return -1;
694
    }
695
 
696
    return bytesRead;
697
}
698
 
699
/*
700
 *----------------------------------------------------------------------
701
 *
702
 * ComSetOptionProc --
703
 *
704
 *      Sets an option on a channel.
705
 *
706
 * Results:
707
 *      A standard Tcl result. Also sets interp->result on error if
708
 *      interp is not NULL.
709
 *
710
 * Side effects:
711
 *      May modify an option on a device.
712
 *
713
 *----------------------------------------------------------------------
714
 */
715
 
716
static int
717
ComSetOptionProc(instanceData, interp, optionName, value)
718
    ClientData instanceData;    /* File state. */
719
    Tcl_Interp *interp;         /* For error reporting - can be NULL. */
720
    char *optionName;           /* Which option to set? */
721
    char *value;                /* New value for option. */
722
{
723
    FileInfo *infoPtr;
724
    DCB dcb;
725
    int len;
726
 
727
    infoPtr = (FileInfo *) instanceData;
728
 
729
    len = strlen(optionName);
730
    if ((len > 1) && (strncmp(optionName, "-mode", len) == 0)) {
731
        if (GetCommState(infoPtr->handle, &dcb)) {
732
            if ((BuildCommDCB(value, &dcb) == FALSE) ||
733
                    (SetCommState(infoPtr->handle, &dcb) == FALSE)) {
734
                /*
735
                 * one should separate the 2 errors...
736
                 */
737
                if (interp) {
738
                    Tcl_AppendResult(interp, "bad value for -mode: should be ",
739
                            "baud,parity,data,stop", NULL);
740
                }
741
                return TCL_ERROR;
742
            } else {
743
                return TCL_OK;
744
            }
745
        } else {
746
            if (interp) {
747
                Tcl_AppendResult(interp, "can't get comm state", NULL);
748
            }
749
            return TCL_ERROR;
750
        }
751
    } else {
752
        return Tcl_BadChannelOption(interp, optionName, "mode");
753
    }
754
}
755
 
756
/*
757
 *----------------------------------------------------------------------
758
 *
759
 * ComGetOptionProc --
760
 *
761
 *      Gets a mode associated with an IO channel. If the optionName arg
762
 *      is non NULL, retrieves the value of that option. If the optionName
763
 *      arg is NULL, retrieves a list of alternating option names and
764
 *      values for the given channel.
765
 *
766
 * Results:
767
 *      A standard Tcl result. Also sets the supplied DString to the
768
 *      string value of the option(s) returned.
769
 *
770
 * Side effects:
771
 *      The string returned by this function is in static storage and
772
 *      may be reused at any time subsequent to the call.
773
 *
774
 *----------------------------------------------------------------------
775
 */
776
 
777
static int
778
ComGetOptionProc(instanceData, interp, optionName, dsPtr)
779
    ClientData instanceData;    /* File state. */
780
    Tcl_Interp *interp;          /* For error reporting - can be NULL. */
781
    char *optionName;           /* Option to get. */
782
    Tcl_DString *dsPtr;         /* Where to store value(s). */
783
{
784
    FileInfo *infoPtr;
785
    DCB dcb;
786
    int len;
787
 
788
    infoPtr = (FileInfo *) instanceData;
789
 
790
    if (optionName == NULL) {
791
        Tcl_DStringAppendElement(dsPtr, "-mode");
792
        len = 0;
793
    } else {
794
        len = strlen(optionName);
795
    }
796
    if ((len == 0) ||
797
            ((len > 1) && (strncmp(optionName, "-mode", len) == 0))) {
798
        if (GetCommState(infoPtr->handle, &dcb) == 0) {
799
            /*
800
             * shouldn't we flag an error instead ?
801
             */
802
            Tcl_DStringAppendElement(dsPtr, "");
803
        } else {
804
            char parity;
805
            char *stop;
806
            char buf[32];
807
 
808
            parity = 'n';
809
            if (dcb.Parity < 4) {
810
                parity = "noems"[dcb.Parity];
811
            }
812
 
813
            stop = (dcb.StopBits == ONESTOPBIT) ? "1" :
814
                    (dcb.StopBits == ONE5STOPBITS) ? "1.5" : "2";
815
 
816
            wsprintf(buf, "%d,%c,%d,%s", dcb.BaudRate, parity, dcb.ByteSize,
817
                    stop);
818
            Tcl_DStringAppendElement(dsPtr, buf);
819
        }
820
        return TCL_OK;
821
    } else {
822
        return Tcl_BadChannelOption(interp, optionName, "mode");
823
    }
824
}
825
 
826
/*
827
 *----------------------------------------------------------------------
828
 *
829
 * TclpOpenFileChannel --
830
 *
831
 *      Open an File based channel on Unix systems.
832
 *
833
 * Results:
834
 *      The new channel or NULL. If NULL, the output argument
835
 *      errorCodePtr is set to a POSIX error.
836
 *
837
 * Side effects:
838
 *      May open the channel and may cause creation of a file on the
839
 *      file system.
840
 *
841
 *----------------------------------------------------------------------
842
 */
843
 
844
Tcl_Channel
845
TclpOpenFileChannel(interp, fileName, modeString, permissions)
846
    Tcl_Interp *interp;                 /* Interpreter for error reporting;
847
                                         * can be NULL. */
848
    char *fileName;                     /* Name of file to open. */
849
    char *modeString;                   /* A list of POSIX open modes or
850
                                         * a string such as "rw". */
851
    int permissions;                    /* If the open involves creating a
852
                                         * file, with what modes to create
853
                                         * it? */
854
{
855
    FileInfo *infoPtr;
856
    int seekFlag, mode, channelPermissions;
857
    DWORD accessMode, createMode, shareMode, flags;
858
    char *nativeName;
859
    Tcl_DString buffer;
860
    DCB dcb;
861
    Tcl_ChannelType *channelTypePtr;
862
    HANDLE handle;
863
 
864
    if (!initialized) {
865
        FileInit();
866
    }
867
 
868
    mode = TclGetOpenMode(interp, modeString, &seekFlag);
869
    if (mode == -1) {
870
        return NULL;
871
    }
872
 
873
    nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
874
    if (nativeName == NULL) {
875
        return NULL;
876
    }
877
 
878
    switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
879
        case O_RDONLY:
880
            accessMode = GENERIC_READ;
881
            channelPermissions = TCL_READABLE;
882
            break;
883
        case O_WRONLY:
884
            accessMode = GENERIC_WRITE;
885
            channelPermissions = TCL_WRITABLE;
886
            break;
887
        case O_RDWR:
888
            accessMode = (GENERIC_READ | GENERIC_WRITE);
889
            channelPermissions = (TCL_READABLE | TCL_WRITABLE);
890
            break;
891
        default:
892
            panic("TclpOpenFileChannel: invalid mode value");
893
            break;
894
    }
895
 
896
    /*
897
     * Map the creation flags to the NT create mode.
898
     */
899
 
900
    switch (mode & (O_CREAT | O_EXCL | O_TRUNC)) {
901
        case (O_CREAT | O_EXCL):
902
        case (O_CREAT | O_EXCL | O_TRUNC):
903
            createMode = CREATE_NEW;
904
            break;
905
        case (O_CREAT | O_TRUNC):
906
            createMode = CREATE_ALWAYS;
907
            break;
908
        case O_CREAT:
909
            createMode = OPEN_ALWAYS;
910
            break;
911
        case O_TRUNC:
912
        case (O_TRUNC | O_EXCL):
913
            createMode = TRUNCATE_EXISTING;
914
            break;
915
        default:
916
            createMode = OPEN_EXISTING;
917
            break;
918
    }
919
 
920
    /*
921
     * If the file is being created, get the file attributes from the
922
     * permissions argument, else use the existing file attributes.
923
     */
924
 
925
    if (mode & O_CREAT) {
926
        if (permissions & S_IWRITE) {
927
            flags = FILE_ATTRIBUTE_NORMAL;
928
        } else {
929
            flags = FILE_ATTRIBUTE_READONLY;
930
        }
931
    } else {
932
        flags = GetFileAttributes(nativeName);
933
        if (flags == 0xFFFFFFFF) {
934
            flags = 0;
935
        }
936
    }
937
 
938
    /*
939
     * Set up the file sharing mode.  We want to allow simultaneous access.
940
     */
941
 
942
    shareMode = FILE_SHARE_READ | FILE_SHARE_WRITE;
943
 
944
    /*
945
     * Now we get to create the file.
946
     */
947
 
948
    handle = CreateFile(nativeName, accessMode, shareMode, NULL, createMode,
949
            flags, (HANDLE) NULL);
950
 
951
    if (handle == INVALID_HANDLE_VALUE) {
952
        DWORD err;
953
 
954
        openerr:
955
        err = GetLastError();
956
        if ((err & 0xffffL) == ERROR_OPEN_FAILED) {
957
            err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;
958
        }
959
        TclWinConvertError(err);
960
        if (interp != (Tcl_Interp *) NULL) {
961
            Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ",
962
                    Tcl_PosixError(interp), (char *) NULL);
963
        }
964
        Tcl_DStringFree(&buffer);
965
        return NULL;
966
    }
967
 
968
    if (GetFileType(handle) == FILE_TYPE_CHAR) {
969
        dcb.DCBlength = sizeof( DCB ) ;
970
        if (GetCommState(handle, &dcb)) {
971
            /*
972
             * This is a com port.  Reopen it with the correct modes.
973
             */
974
 
975
            COMMTIMEOUTS cto;
976
 
977
            CloseHandle(handle);
978
            handle = CreateFile(nativeName, accessMode, 0, NULL, OPEN_EXISTING,
979
                    flags, NULL);
980
            if (handle == INVALID_HANDLE_VALUE) {
981
                goto openerr;
982
            }
983
 
984
            /*
985
             * FileInit the com port.
986
             */
987
 
988
            SetCommMask(handle, EV_RXCHAR);
989
            SetupComm(handle, 4096, 4096);
990
            PurgeComm(handle, PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR
991
                    | PURGE_RXCLEAR);
992
            cto.ReadIntervalTimeout = MAXDWORD;
993
            cto.ReadTotalTimeoutMultiplier = 0;
994
            cto.ReadTotalTimeoutConstant = 0;
995
            cto.WriteTotalTimeoutMultiplier = 0;
996
            cto.WriteTotalTimeoutConstant = 0;
997
            SetCommTimeouts(handle, &cto);
998
 
999
            GetCommState(handle, &dcb);
1000
            SetCommState(handle, &dcb);
1001
            channelTypePtr = &comChannelType;
1002
        } else {
1003
            channelTypePtr = &fileChannelType;
1004
        }
1005
    } else {
1006
        channelTypePtr = &fileChannelType;
1007
    }
1008
    Tcl_DStringFree(&buffer);
1009
 
1010
    infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo));
1011
    infoPtr->nextPtr = firstFilePtr;
1012
    firstFilePtr = infoPtr;
1013
    infoPtr->validMask = channelPermissions;
1014
    infoPtr->watchMask = 0;
1015
    infoPtr->flags = (mode & O_APPEND) ? FILE_APPEND : 0;
1016
    infoPtr->handle = handle;
1017
 
1018
    sprintf(channelName, "file%d", (int) handle);
1019
 
1020
    infoPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName,
1021
            (ClientData) infoPtr, channelPermissions);
1022
 
1023
    if (seekFlag) {
1024
        if (Tcl_Seek(infoPtr->channel, 0, SEEK_END) < 0) {
1025
            if (interp != (Tcl_Interp *) NULL) {
1026
                Tcl_AppendResult(interp, "could not seek to end of file on \"",
1027
                        channelName, "\": ", Tcl_PosixError(interp),
1028
                        (char *) NULL);
1029
            }
1030
            Tcl_Close(NULL, infoPtr->channel);
1031
            return NULL;
1032
        }
1033
    }
1034
 
1035
    /*
1036
     * Files have default translation of AUTO and ^Z eof char, which
1037
     * means that a ^Z will be appended to them at close.
1038
     */
1039
 
1040
    Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
1041
    Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
1042
    return infoPtr->channel;
1043
}
1044
 
1045
/*
1046
 *----------------------------------------------------------------------
1047
 *
1048
 * Tcl_MakeFileChannel --
1049
 *
1050
 *      Creates a Tcl_Channel from an existing platform specific file
1051
 *      handle.
1052
 *
1053
 * Results:
1054
 *      The Tcl_Channel created around the preexisting file.
1055
 *
1056
 * Side effects:
1057
 *      None.
1058
 *
1059
 *----------------------------------------------------------------------
1060
 */
1061
 
1062
Tcl_Channel
1063
Tcl_MakeFileChannel(handle, mode)
1064
    ClientData handle;          /* OS level handle */
1065
    int mode;                   /* ORed combination of TCL_READABLE and
1066
                                 * TCL_WRITABLE to indicate file mode. */
1067
{
1068
    char channelName[20];
1069
    FileInfo *infoPtr;
1070
 
1071
    if (!initialized) {
1072
        FileInit();
1073
    }
1074
 
1075
    if (mode == 0) {
1076
        return NULL;
1077
    }
1078
 
1079
    sprintf(channelName, "file%d", (int) handle);
1080
 
1081
    /*
1082
     * See if a channel with this handle already exists.
1083
     */
1084
 
1085
    for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
1086
        if (infoPtr->handle == (HANDLE) handle) {
1087
            return (mode == infoPtr->validMask) ? infoPtr->channel : NULL;
1088
        }
1089
    }
1090
 
1091
    infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo));
1092
    infoPtr->nextPtr = firstFilePtr;
1093
    firstFilePtr = infoPtr;
1094
    infoPtr->validMask = mode;
1095
    infoPtr->watchMask = 0;
1096
    infoPtr->flags = 0;
1097
    infoPtr->handle = (HANDLE) handle;
1098
    infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
1099
            (ClientData) infoPtr, mode);
1100
 
1101
    /*
1102
     * Windows files have AUTO translation mode and ^Z eof char on input.
1103
     */
1104
 
1105
    Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
1106
    Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
1107
    return infoPtr->channel;
1108
}
1109
 
1110
/*
1111
 *----------------------------------------------------------------------
1112
 *
1113
 * TclGetDefaultStdChannel --
1114
 *
1115
 *      Constructs a channel for the specified standard OS handle.
1116
 *
1117
 * Results:
1118
 *      Returns the specified default standard channel, or NULL.
1119
 *
1120
 * Side effects:
1121
 *      May cause the creation of a standard channel and the underlying
1122
 *      file.
1123
 *
1124
 *----------------------------------------------------------------------
1125
 */
1126
 
1127
Tcl_Channel
1128
TclGetDefaultStdChannel(type)
1129
    int type;                   /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
1130
{
1131
    Tcl_Channel channel;
1132
    HANDLE handle;
1133
    int mode;
1134
    char *bufMode;
1135
    DWORD handleId;             /* Standard handle to retrieve. */
1136
 
1137
    switch (type) {
1138
        case TCL_STDIN:
1139
            handleId = STD_INPUT_HANDLE;
1140
            mode = TCL_READABLE;
1141
            bufMode = "line";
1142
            break;
1143
        case TCL_STDOUT:
1144
            handleId = STD_OUTPUT_HANDLE;
1145
            mode = TCL_WRITABLE;
1146
            bufMode = "line";
1147
            break;
1148
        case TCL_STDERR:
1149
            handleId = STD_ERROR_HANDLE;
1150
            mode = TCL_WRITABLE;
1151
            bufMode = "none";
1152
            break;
1153
        default:
1154
            panic("TclGetDefaultStdChannel: Unexpected channel type");
1155
            break;
1156
    }
1157
    handle = GetStdHandle(handleId);
1158
 
1159
    /*
1160
     * Note that we need to check for 0 because Windows will return 0 if this
1161
     * is not a console mode application, even though this is not a valid
1162
     * handle.
1163
     */
1164
 
1165
    if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)) {
1166
        return NULL;
1167
    }
1168
 
1169
    channel = Tcl_MakeFileChannel(handle, mode);
1170
 
1171
    /*
1172
     * Set up the normal channel options for stdio handles.
1173
     */
1174
 
1175
    if ((Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-translation",
1176
            "auto") == TCL_ERROR)
1177
            || (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel, "-eofchar",
1178
                    "\032 {}") == TCL_ERROR)
1179
            || (Tcl_SetChannelOption((Tcl_Interp *) NULL, channel,
1180
                    "-buffering", bufMode) == TCL_ERROR)) {
1181
        Tcl_Close((Tcl_Interp *) NULL, channel);
1182
        return (Tcl_Channel) NULL;
1183
    }
1184
    return channel;
1185
}

powered by: WebSVN 2.1.0

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