Ejemplo n.º 1
0
static int
get_int_arg(int i, term_t t, term_t a, int *val)
{ GET_LD

  _PL_get_arg(i, t, a);

  return PL_get_integer_ex(a, val);
}
Ejemplo n.º 2
0
static foreign_t
pl_setegid(term_t gid)
{ int id;

  if ( !PL_get_integer_ex(gid, &id) )
    return FALSE;

  if ( setegid(id) == 0 )
    return TRUE;

  return error(errno, "setegid", "gid", gid);
}
Ejemplo n.º 3
0
static int
get_voff_arg(int i, term_t t, term_t a, int *val)
{ GET_LD

  _PL_get_arg(i, t, a);

  if ( PL_is_variable(a) )
  { *val = NO_UTC_OFFSET;
    return TRUE;
  } else
  { return PL_get_integer_ex(a, val);
  }
}
Ejemplo n.º 4
0
bool
scan_options(term_t options, int flags, atom_t optype,
	     const opt_spec *specs, ...)
{ GET_LD
  va_list args;
  const opt_spec *s;
  optvalue values[MAXOPTIONS];
  term_t list = PL_copy_term_ref(options);
  term_t head = PL_new_term_ref();
  term_t tmp  = PL_new_term_ref();
  term_t val  = PL_new_term_ref();
  int n;

  if ( truePrologFlag(PLFLAG_ISO) )
    flags |= OPT_ALL;

  va_start(args, specs);
  for( n=0, s = specs; s->name; s++, n++ )
    values[n].ptr = va_arg(args, void *);
  va_end(args);

  while ( PL_get_list(list, head, list) )
  { atom_t name;
    int arity;

    if ( PL_get_name_arity(head, &name, &arity) )
    { if ( name == ATOM_equals && arity == 2 )
      { _PL_get_arg(1, head, tmp);

	if ( !PL_get_atom(tmp, &name) )
	  goto itemerror;
	_PL_get_arg(2, head, val);
      } else if ( arity == 1 )
      { _PL_get_arg(1, head, val);
      } else if ( arity == 0 )
	PL_put_atom(val, ATOM_true);
    } else if ( PL_is_variable(head) )
    { return PL_error(NULL, 0, NULL, ERR_INSTANTIATION);
    } else
    { itemerror:
      return PL_error(NULL, 0, NULL, ERR_DOMAIN, optype, head);
    }

    for( n=0, s = specs; s->name; n++, s++ )
    { if ( s->name == name )
      { switch((s->type & OPT_TYPE_MASK))
	{ case OPT_BOOL:
	  { int bval;

	    if ( !PL_get_bool_ex(val, &bval) )
	      return FALSE;
	    *values[n].b = bval;
	    break;
	  }
	  case OPT_INT:
	  { if ( !PL_get_integer_ex(val, values[n].i) )
	      return FALSE;

	    break;
	  }
	  case OPT_LONG:
	  { if ( (s->type & OPT_INF) && PL_is_inf(val) )
	      *values[n].l = LONG_MAX;
	    else if ( !PL_get_long_ex(val, values[n].l) )
	      return FALSE;

	    break;
	  }
	  case OPT_NATLONG:
	  { if ( !PL_get_long_ex(val, values[n].l) )
	      return FALSE;
	    if ( *(values[n].l) <= 0 )
	      return PL_error(NULL, 0, NULL, ERR_DOMAIN,
			      ATOM_not_less_than_one, val);

	    break;
	  }
	  case OPT_SIZE:
	  { if ( (s->type & OPT_INF) && PL_is_inf(val) )
	      *values[n].sz = (size_t)-1;
	    else if ( !PL_get_size_ex(val, values[n].sz) )
	      return FALSE;

	    break;
	  }
	  case OPT_DOUBLE:
	  { if ( !PL_get_float_ex(val, values[n].f) )
	      return FALSE;

	    break;
	  }
	  case OPT_STRING:
	  { char *str;

	    if ( !PL_get_chars(val, &str, CVT_ALL|CVT_EXCEPTION) ) /* copy? */
	      return FALSE;
	    *values[n].s = str;
	    break;
	  }
	  case OPT_ATOM:
	  { atom_t a;

	    if ( !PL_get_atom_ex(val, &a) )
	      return FALSE;
	    *values[n].a = a;
	    break;
	  }
#ifdef O_LOCALE
	  case OPT_LOCALE:
	  { PL_locale *l;
	    PL_locale **lp = values[n].ptr;

	    if ( !getLocaleEx(val, &l) )
	      return FALSE;
	    *lp = l;
	    break;
	  }
#endif
	  case OPT_TERM:
	  { *values[n].t = val;
	    val = PL_new_term_ref();	/* can't reuse anymore */
	    break;
	  }
	  default:
	    assert(0);
	    fail;
	}
	break;
      }
    }

    if ( !s->name && (flags & OPT_ALL) )
      goto itemerror;
  }

  if ( !PL_get_nil(list) )
    return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_list, list);

  succeed;
}
Ejemplo n.º 5
0
static int
get_optval(optvalue valp, const opt_spec *spec, term_t val ARG_LD)
{ switch((spec->type & OPT_TYPE_MASK))
  { case OPT_BOOL:
    { int bval;

      if ( !PL_get_bool_ex(val, &bval) )
	return FALSE;
      *valp.b = bval;

      return TRUE;
    }
    case OPT_INT:
    { if ( !PL_get_integer_ex(val, valp.i) )
	return FALSE;

      return TRUE;
    }
    case OPT_LONG:
    { if ( (spec->type & OPT_INF) && PL_is_inf(val) )
	*valp.l = LONG_MAX;
      else if ( !PL_get_long_ex(val, valp.l) )
	return FALSE;

      return TRUE;
    }
    case OPT_NATLONG:
    { if ( !PL_get_long_ex(val, valp.l) )
	return FALSE;
      if ( *(valp.l) <= 0 )
	return PL_error(NULL, 0, NULL, ERR_DOMAIN,
			ATOM_not_less_than_one, val);

      return TRUE;
    }
    case OPT_SIZE:
    { if ( (spec->type & OPT_INF) && PL_is_inf(val) )
	*valp.sz = (size_t)-1;
      else if ( !PL_get_size_ex(val, valp.sz) )
	return FALSE;

      return TRUE;
    }
    case OPT_DOUBLE:
    { if ( !PL_get_float_ex(val, valp.f) )
	return FALSE;

      return TRUE;
    }
    case OPT_STRING:
    { char *str;

      if ( !PL_get_chars(val, &str, CVT_ALL|CVT_EXCEPTION) ) /* copy? */
	return FALSE;
      *valp.s = str;

      return TRUE;
    }
    case OPT_ATOM:
    { atom_t a;

      if ( !PL_get_atom_ex(val, &a) )
	return FALSE;
      *valp.a = a;

      return TRUE;
    }
#ifdef O_LOCALE
    case OPT_LOCALE:
    { PL_locale *l;
      PL_locale **lp = valp.ptr;

      if ( !getLocaleEx(val, &l) )
	return FALSE;
      *lp = l;

      return TRUE;
    }
#endif
    case OPT_TERM:
    { *valp.t = PL_copy_term_ref(val); /* can't reuse anymore */

      return TRUE;
    }
    default:
      assert(0);
  }

  return FALSE;
}
Ejemplo n.º 6
0
static foreign_t
pl_uuid(term_t UUID, term_t options)
{ unsigned int mode = UUID_MAKE_V1;
  atom_t format = ATOM_atom;
  uuid_t *uuid;
  char *ns = NULL;
  char *str = NULL;
  int rc;
  uuid_rc_t urc;

  if ( !PL_get_nil(options) )
  { term_t tail = PL_copy_term_ref(options);
    term_t head = PL_new_term_ref();
    term_t arg  = PL_new_term_ref();

    while( PL_get_list(tail, head, tail) )
    { atom_t name;
      size_t arity;

      if ( !PL_get_name_arity(head, &name, &arity) || arity != 1 )
	return PL_type_error("option", head);
      _PL_get_arg(1, head, arg);

      if ( name == ATOM_version )
      { int v;

	if ( !PL_get_integer_ex(arg, &v) )
	  return FALSE;
	switch(v)
	{ case 1: mode = UUID_MAKE_V1; break;
	  case 2: mode = UUID_MAKE_MC; break;
	  case 3: mode = UUID_MAKE_V3; break;
	  case 4: mode = UUID_MAKE_V4; break;
	  case 5: mode = UUID_MAKE_V5; break;
          default: return PL_domain_error("uuid_version", arg);
	}
      } else if ( name == ATOM_format )
      { if ( !PL_get_atom_ex(arg, &format) )
	  return FALSE;
	if ( format != ATOM_atom && format != ATOM_integer )
	  return PL_domain_error("uuid_format", arg);
      } else
      { char *newns = NULL;

	if ( name == ATOM_dns )
	{ newns = "ns:DNS";
	} else if ( name == ATOM_url )
	{ newns = "ns:URL";
	} else if ( name == ATOM_oid )
	{ newns = "ns:OID";
	} else if ( name == ATOM_x500 )
	{ newns = "ns:X500";
	}

	if ( newns )
	{ ns = newns;
	  if ( !PL_get_chars(arg, &str, CVT_ATOM|CVT_EXCEPTION) )
	    return FALSE;
	  if ( mode == UUID_MAKE_V1 )
	    mode = UUID_MAKE_V3;
	}
      }
    }
    if ( !PL_get_nil_ex(tail) )
      return FALSE;
  }

  switch(mode)
  { case UUID_MAKE_V1:
    case UUID_MAKE_MC:
    case UUID_MAKE_V4:
      uuid_create(&uuid);
      if ( (urc=uuid_make(uuid, mode)) != UUID_RC_OK )
	return PL_warning("UUID: make: %s\n", uuid_error(urc));
      break;
    case UUID_MAKE_V3:
    case UUID_MAKE_V5:
    { uuid_t *uuid_ns;

      if ( !ns )
	return PL_existence_error("uuid_context", options);

      uuid_create(&uuid);
      uuid_create(&uuid_ns);
      uuid_load(uuid_ns, ns);
      if ( (urc=uuid_make(uuid, mode, uuid_ns, str)) != UUID_RC_OK )
	return PL_warning("UUID: make: %s\n", uuid_error(urc));
      uuid_destroy(uuid_ns);
      break;
    }
    default:
      assert(0);
      return FALSE;
  }

  if ( format == ATOM_atom )
  { char buf[UUID_LEN_STR+1];
    void *ptr = buf;
    size_t datalen = sizeof(buf);

    if ( (urc=uuid_export(uuid, UUID_FMT_STR, &ptr, &datalen)) != UUID_RC_OK )
      return PL_warning("UUID: export: %s\n", uuid_error(urc));
    rc = PL_unify_chars(UUID, PL_ATOM|REP_ISO_LATIN_1, (size_t)-1, buf);
  } else if ( format == ATOM_integer )
  { char buf[UUID_LEN_SIV+1];
    void *ptr = buf;
    size_t datalen = sizeof(buf);
    term_t tmp = PL_new_term_ref();

    if ( (urc=uuid_export(uuid, UUID_FMT_SIV, &ptr, &datalen)) != UUID_RC_OK )
      return PL_warning("UUID: export: %s\n", uuid_error(urc));
    rc = ( PL_chars_to_term(buf, tmp) &&
	   PL_unify(UUID, tmp)
	 );
  } else
  { assert(0);
    return FALSE;
  }

  uuid_destroy(uuid);

  return rc;
}