ghc/lib/std/cbits/seekFile.lc

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1994
   3 %
   4 \subsection[seekFile.lc]{hSeek and hIsSeekable Runtime Support}
   5
   6 \begin{code}
   7
   8 #include "rtsdefs.h"
   9 #include "stgio.h"
  10
  11 #ifdef HAVE_SYS_TYPES_H
  12 #include <sys/types.h>
  13 #endif
  14
  15 #ifdef HAVE_SYS_STAT_H
  16 #include <sys/stat.h>
  17 #endif
  18
  19 /* Invoked by IO.hSeek only */
  20 StgInt
  21 seekFile(ptr, whence, size, d)
  22 StgForeignObj ptr;
  23 StgInt whence;
  24 StgInt size;
  25 StgByteArray d;
  26 {
  27     IOFileObject* fo = (IOFileObject*)ptr;
  28     struct stat sb;
  29     off_t offset;
  30     int posn_delta =0;
  31     int rc = 0;
  32
  33     switch (whence) {
  34      case 0: whence=SEEK_SET; break;
  35      case 1: whence=SEEK_CUR; break;
  36      case 2: whence=SEEK_END; break;
  37      default: whence=SEEK_SET; break; /* Should never happen, really */
  38     }
  39
  40     /*
  41      * We need to snatch the offset out of an MP_INT.  The bits are there sans sign,
  42      * which we pick up from our size parameter.  If abs(size) is greater than 1,
  43      * this integer is just too big.
  44      */
  45
  46     switch (size) {
  47     case -1:
  48         offset = -*(StgInt *) d;
  49         break;
  50     case 0:
  51         offset = 0;
  52         break;
  53     case 1:
  54         offset = *(StgInt *) d;
  55         break;
  56     default:
  57         ghc_errtype = ERR_INVALIDARGUMENT;
  58         ghc_errstr = "offset out of range";
  59         return -1;
  60     }
  61
  62     /* If we're doing a relative seek, see if we cannot deal
  63      * with the request without flushing the buffer..
  64      *
  65      * Note: the wording in the report is vague here, but
  66      * we only avoid flushing on *input* buffers and *not* output ones.
  67      */
  68     if ( whence == SEEK_CUR &&
  69          (FILEOBJ_READABLE(fo) && !FILEOBJ_WRITEABLE(fo) &&
  70           (fo->bufRPtr + (int)offset) < fo->bufWPtr &&
  71           (fo->bufRPtr + (int)offset) >= 0) ) { /* The input buffer case */
  72        fo->bufRPtr += (int)offset;
  73        return 0;
  74     } else if ( whence == SEEK_CUR && (FILEOBJ_READABLE(fo) && !FILEOBJ_WRITEABLE(fo)) ) {
  75          /* We're seeking outside the input buffer,
  76             record delta so that we can adjust the file position
  77             reported from the underlying fd to get
  78             at the real position we're at when we take into account
  79             buffering.
  80          */
  81         posn_delta = fo->bufWPtr - fo->bufRPtr;  /* number of chars left in the buffer */
  82         if (posn_delta < 0) posn_delta=0;
  83     }
  84
  85     /* If we cannot seek within our current buffer, flush it. */
  86     rc = flushBuffer(ptr);
  87     if (rc < 0) return rc;
  88
  89     /* Try to find out the file type & size for a physical file */
  90     while (fstat(fo->fd, &sb) < 0) {
  91         /* highly unlikely */
  92         if (errno != EINTR) {
  93             cvtErrno();
  94             stdErrno();
  95             return -1;
  96         }
  97     }
  98     if (S_ISREG(sb.st_mode)) {
  99         /* Verify that we are not seeking beyond end-of-file */
 100         off_t posn;
 101
 102         switch (whence) {
 103         case SEEK_SET:
 104             posn = offset;
 105             break;
 106         case SEEK_CUR:
 107             while ((posn = lseek(fo->fd, 0, SEEK_CUR)) == -1) {
 108                 /* the possibility seems awfully remote */
 109                 if (errno != EINTR) {
 110                     cvtErrno();
 111                     stdErrno();
 112                     return -1;
 113                 }
 114             }
 115             posn -= posn_delta;
 116             posn += offset;
 117             offset -= posn_delta; /* adjust the offset to include the buffer delta */
 118             break;
 119         case SEEK_END:
 120             posn = (off_t)sb.st_size + offset;
 121             break;
 122         }
 123         if (posn > sb.st_size) {
 124             ghc_errtype = ERR_INVALIDARGUMENT;
 125             ghc_errstr = "seek position beyond end of file";
 126             return -1;
 127         }
 128     } else if (S_ISFIFO(sb.st_mode)) {
 129         ghc_errtype = ERR_UNSUPPORTEDOPERATION;
 130         ghc_errstr = "can't seek on a pipe";
 131         return -1;
 132     } else {
 133         ghc_errtype = ERR_UNSUPPORTEDOPERATION;
 134         ghc_errstr = "can't seek on a device";
 135         return -1;
 136     }
 137     while ( lseek(fo->fd, offset, whence) == -1) {
 138         if (errno != EINTR) {
 139             cvtErrno();
 140             stdErrno();
 141             return -1;
 142         }
 143     }
 144     /* Clear EOF */
 145     FILEOBJ_CLEAR_EOF(fo);
 146     return 0;
 147 }
 148
 149 StgInt
 150 seekFileP(ptr)
 151 StgForeignObj ptr;
 152 {
 153     IOFileObject* fo = (IOFileObject*)ptr;
 154     struct stat sb;
 155
 156     /* Try to find out the file type */
 157     while (fstat(fo->fd, &sb) < 0) {
 158         /* highly unlikely */
 159         if (errno != EINTR) {
 160             cvtErrno();
 161             stdErrno();
 162             return -1;
 163         }
 164     }
 165     /* Regular files are okay */
 166     if (S_ISREG(sb.st_mode)) {
 167         return 1;
 168     }
 169     /* For now, everything else is not */
 170     else {
 171         return 0;
 172     }
 173 }
 174
 175 \end{code}