/* Copyright (C) 1993-99 Free Software Foundation, Inc.

   This file is part of GNU Pascal Library.

   Extended pascal binding routines.

The GNU Pascal Library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public License as
published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.

The GNU Pascal Library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
Library General Public License for more details.

You should have received a copy of the GNU Library General Public
License along with the GNU Pascal Library; see the file COPYING.LIB.  If
not, write to the Free Software Foundation, Inc., 675 Mass Ave,
Cambridge, MA 02139, USA.  */

#include "rts.h"

#include "fdr.h"

#include <sys/stat.h>

/* BIND(file, b);
 *
 * Attempt to bind FILE to B.NAME.
 *
 * This routine must not update any fields in B
 *
 * BINDING (object) is used to get the binding status info
 * of FILE after BIND has returned.
 */
void
_p_bind (File, b)
FDR File;
const GPC_BINDING *b;
{
  int permissions = 0, OK, ch;
  long long int known_size = -1;
  UnixTimeType atime = -1, mtime = -1, ctime = -1;
  struct stat st;
  char *name, *copy;
  GPC_BINDING *binding;
  int len = b->Name.length;

  if (_p_inoutres) return;

  if (!tst_BINDABLE (File))
    IOERROR_FILE (402,File,); /* `Bind' applied to non-bindable %s */

  if (m_BINDING(File))
    IOERROR_STRING (441, m_BNDNAM(File),); /* File already bound to `%s' */

  if (len < 0)
    IOERROR_FILE (424,File,); /* Invalid string length in `Bind' of `%s' */

  if (len >= BINDING_NAME_LENGTH)
    _p_warning_integer ("External names of bound objects must be shorter than %d characters", (long int) BINDING_NAME_LENGTH);

  /* Copy the name we are binding to (need it null terminated) */
  name = _p_malloc (len + 1);
  strncpy (name, &b->Name.string[0], len);
  name [len] = 0;
  _p_osdirseparator2slash_cstring (name);
  copy = _p_strdup (name);

  if (m_STATUS(File) != FiNOP)
    /* @@ Should we close it if it is opened instead of this? */
    _p_warning ("Bind: File already opened; binding takes effect with the next open");

  /* Unfortunately there is no knowledge if the file will be
   * reset, rewritten or extended, so I added some fields
   * to the bindingtype to let user have a control. */
  OK = TRUE;
  if (
#if defined (MSDOS) || defined (_WIN32) || defined (__EMX__)
  /* Write-only Dos devices */
           !_p_strcasecmp (copy, "prn")  ||
           !_p_strcasecmp (copy, "lpt1") ||
           !_p_strcasecmp (copy, "lpt2") ||
           !_p_strcasecmp (copy, "lpt3") ||
           !_p_strcasecmp (copy, "lpt4") ||
           !_p_strcasecmp (copy, "nul"))
    {
      permissions = 8 | 2;
      known_size = 1;
    }
  /* Read-Write Dos devices */
  else if (!_p_strcasecmp (copy, "aux")  ||
           !_p_strcasecmp (copy, "com1") ||
           !_p_strcasecmp (copy, "com2") ||
           !_p_strcasecmp (copy, "com3") ||
           !_p_strcasecmp (copy, "com4") ||
           !_p_strcasecmp (copy, "con")  ||
#endif
           !_p_strcmp (copy, "") ||
           !_p_strcmp (copy, "-"))
    {
      permissions = 8 | 4 | 2;
      known_size = 1;
    }
  else
    {
      permissions = ((access (copy, X_OK) == 0) * 1)  /* Execute permission? */
                  | ((access (copy, W_OK) == 0) * 2)  /* Write permission? */
                  | ((access (copy, R_OK) == 0) * 4)  /* Read permission? */
                  | ((access (copy, F_OK) == 0) * 8); /* File exists and directories allow file access */
      if (stat (copy, &st) == 0)
        {
          known_size = BYTENUM (File, st.st_size); /* Calculate the number of elements in the file */
          atime = (UnixTimeType) st.st_atime;
          mtime = (UnixTimeType) st.st_mtime;
          ctime = (UnixTimeType) st.st_ctime;
          if (S_ISDIR(st.st_mode))
            {
              permissions = (permissions & ~8) | 16;
              OK = FALSE;
            }
        }
      else if (!permissions)
        {
          /* Check for permissions to write/read the directory
             Only check the directory where the unexisting
             file would be created (not /tmp/non1/non2/non3) */
          char *slash = strrchr (copy, '/'); /* dir separators have already been changed to slashes */
          if (!slash)
            {
              /* Nonexisting file in current directory */
              ch = '.';
              copy [0] = '.';
              copy [1] = 0;
            }
          else
            {
              ch = slash [1];
              if (slash == copy)
                slash [1] = 0; /* root directory */
              else
                slash [0] = 0; /* get rid of the file component, leave the path */
            }
          if (ch && /* not /directory/name/ending/with/slash/ */
              access (copy, W_OK) == 0 &&
              stat (copy, &st) == 0 &&
              S_ISDIR (st.st_mode))
            permissions = 2; /* Only write permissions are valid because the file did not exist. */
          else
            OK = FALSE; /* path is not valid */
        }
    }

  _p_dispose (copy);

  if (!(OK || b->Force))
    {
      _p_dispose (name);
      return;
    }
  _p_inittfdd (File);
  m_BNDNAM (File) = name;
  m_BINDING (File) = binding = (GPC_BINDING *) _p_malloc (sizeof (GPC_BINDING));
  m_BNDCHG (File) = 1;
  memcpy (binding, b, sizeof (GPC_BINDING));
  binding->Extensions_valid = TRUE;
  binding->Readable         = !!(permissions&4);
  binding->Writable         = !!(permissions&2);
  binding->Executable       = !!(permissions&1);
  binding->Existing         = !!(permissions&8);
  binding->Directory        = !!(permissions&16);
  binding->Size             = known_size;
  binding->AccessTime       = atime;
  binding->ModificationTime = mtime;
  binding->ChangeTime       = ctime;
  binding->Error            = 0;
  binding->Bound            = TRUE; /* Standard flag */
}

void
_p_clearbinding (b)
     GPC_BINDING *b;
{
  b->Bound            = FALSE;
  b->Force            = FALSE;
  b->Extensions_valid = FALSE;
  b->Readable         = FALSE;
  b->Writable         = FALSE;
  b->Executable       = FALSE;
  b->Existing         = FALSE;
  b->Directory        = FALSE;
  b->Size             = -1;
  b->AccessTime       = -1;
  b->ModificationTime = -1;
  b->ChangeTime       = -1;
  b->Error            = 0;
  b->CFile            = NULL;
  b->Name.length      = 0;
  b->Name.string[0]   = 0;
}

void
_p_binding (File, b)
     const FDR File;
     GPC_BINDING *b;
{
  int len;

  _p_clearbinding (b);

  if (_p_inoutres) return;
  if (!tst_BINDABLE (File))
    IOERROR_FILE (403,File,); /* `Binding' applied to non-bindable %s */

  if (!m_BINDING (File)) return;

  /* Copy all fields except the Name field */
  *b = *m_BINDING (File);
  len = strlen (m_BNDNAM (File));
  if (len >= BINDING_NAME_LENGTH)
    {
      len = BINDING_NAME_LENGTH-1;
      _p_warning_integer ("`Binding': bound name truncated to %d characters", (long int) len);
    }

  /* Now copy the name, does not matter if null terminated or not */
  b->Name.length = len;
  strncpy (&b->Name.string[0], m_BNDNAM (File), len+1);
}

void
_p_unbind (File)
     FDR File;
{
  if (_p_inoutres) return;
  if (!tst_BINDABLE (File))
    IOERROR_FILE (404,File,); /* `Unbind' applied to non-bindable %s */
  _p_close (File);
  _p_inittfdd (File);
  if (_p_inoutres) return;
  if (m_BINDING (File))
    {
      _p_dispose (m_BNDNAM (File));
      _p_dispose (m_BINDING (File));
      m_BINDING (File) = NULL;
      m_EXTNAM (File) = NULL;
      m_BNDCHG (File) = 1;
    }
}

void _p_assign_tfdd (File, OpenProc, ReadFunc, WriteFunc, FlushProc, CloseProc, DoneProc, PrivateData)
     FDR File;
     TOpenProc  OpenProc;
     TReadFunc  ReadFunc;
     TWriteFunc WriteFunc;
     TFlushProc FlushProc;
     TCloseProc CloseProc;
     TDoneProc  DoneProc;
     void *PrivateData;
{
  _p_internal_assign (File, "", 0);
  File->OpenProc    = OpenProc;
  File->ReadFunc    = ReadFunc;
  File->WriteFunc   = WriteFunc;
  File->FlushProc   = FlushProc;
  File->CloseProc   = CloseProc;
  File->DoneProc    = DoneProc;
  File->PrivateData = PrivateData;
}

void _p_get_tfdd (File, OpenProc, ReadFunc, WriteFunc, FlushProc, CloseProc, DoneProc, PrivateData)
     FDR File;
     TOpenProc  *OpenProc;
     TReadFunc  *ReadFunc;
     TWriteFunc *WriteFunc;
     TFlushProc *FlushProc;
     TCloseProc *CloseProc;
     TDoneProc  *DoneProc;
     void **PrivateData;
{
  *OpenProc    = File->OpenProc;
  *ReadFunc    = File->ReadFunc;
  *WriteFunc   = File->WriteFunc;
  *FlushProc   = File->FlushProc;
  *CloseProc   = File->CloseProc;
  *DoneProc    = File->DoneProc;
  *PrivateData = File->PrivateData;
}
