gboolean plgi_term_to_gpointer(term_t t, PLGIArgInfo *arg_info, gpointer *data) { PLGIBlob *blob; PLGI_debug(" term: 0x%lx ---> gpointer: %p", t, *data); if ( !plgi_get_blob(t, &blob) ) { return PL_type_error("gpointer", t); } if ( blob->gtype != G_TYPE_NONE ) { return PL_type_error("gpointer", t); } if ( arg_info->flags & PLGI_ARG_IS_POINTER ) { *data = blob->data; } else { plgi_raise_error("cannot pass-by-value untyped gpointer"); return FALSE; } if ( arg_info->direction == GI_DIRECTION_IN && arg_info->transfer != GI_TRANSFER_NOTHING ) { blob->magic = 0x0; } return TRUE; }
cairo_bool_t plcairo_term_to_ps_level(term_t t, cairo_ps_level_t *level) { atom_t a; PLCAIRO_debug(" term: 0x%lx ---> cairo_ps_level_t: %p", t, level); if ( !PL_get_atom(t, &a) ) { return PL_type_error("CairoPSLevel", t); } if ( !ATOM_cairo_ps_level_2 ) { ATOM_cairo_ps_level_2 = PL_new_atom("CAIRO_PS_LEVEL_2"); ATOM_cairo_ps_level_3 = PL_new_atom("CAIRO_PS_LEVEL_3"); } if ( a == ATOM_cairo_ps_level_2 ) { *level = CAIRO_PS_LEVEL_2; } else if ( a == ATOM_cairo_ps_level_3 ) { *level = CAIRO_PS_LEVEL_3; } else { return PL_domain_error("CairoPSLevel", t); } return TRUE; }
static int get_params(term_t t, clingo_part_t *pv) { int rc; atom_t name; term_t arg; clingo_symbol_t *values = NULL; if (!(rc = get_name_arity(t, &name, &pv->size))) { rc = PL_type_error("callable", t); goto out; } arg = PL_new_term_ref(); if (!(values = malloc(sizeof(*pv->params) * pv->size))) { rc = PL_resource_error("memory"); goto out; } for (size_t i = 0; i < pv->size; i++) { _PL_get_arg(i + 1, t, arg); if (!(rc = clingo_status(get_value(arg, &values[i], FALSE)))) { goto out; } } pv->params = values; pv->name = PL_atom_chars(name); values = NULL; out: if (values) { free(values); } return rc; }
gboolean plgi_term_to_gbytes(term_t t, GBytes **bytes) { GBytes *bytes0; term_t list = PL_copy_term_ref(t); term_t head = PL_new_term_ref(); guint8 *data; gsize len; gint i = 0; if ( PL_skip_list(list, 0, &len) != PL_LIST ) { return PL_type_error("list", t); } data = g_malloc0(len); while ( PL_get_list(list, head, list) ) { guint8 byte; if ( !plgi_term_to_guint8(head, &byte) ) { g_free(data); return FALSE; } data[i++] = byte; } bytes0 = g_bytes_new_take(data, len); PLGI_debug(" term: 0x%lx ---> GBytes: %p", t, bytes0); *bytes = bytes0; return TRUE; }
static foreign_t pl_group_info(term_t group, term_t info) { int gid; struct group grp, *pgrp; char buf[1000]; char *name; term_t members = PL_new_term_ref(); term_t tail = PL_copy_term_ref(members); term_t head = PL_new_term_ref(); char **memp; if ( PL_get_integer(group, &gid) ) { again1: errno = 0; if ( getgrgid_r(gid, &grp, buf, sizeof(buf), &pgrp) != 0 ) { if ( errno == EINTR ) { if ( PL_handle_signals() < 0 ) return FALSE; goto again1; } return error(errno, "info", "group", group); } } else if ( PL_get_chars(group, &name, CVT_ATOMIC|REP_MB) ) { again2: errno = 0; if ( getgrnam_r(name, &grp, buf, sizeof(buf), &pgrp) != 0 ) { if ( errno == EINTR ) { if ( PL_handle_signals() < 0 ) return FALSE; goto again2; } return error(errno, "info", "group", group); } } else { return PL_type_error("group", group); } if ( !pgrp ) return PL_existence_error("group", group); for(memp=pgrp->gr_mem; *memp; memp++) { if ( !PL_unify_list(tail, head, tail) || !PL_unify_chars(head, PL_ATOM|REP_MB, -1, *memp) ) return FALSE; } if ( !PL_unify_nil(tail) ) return FALSE; return PL_unify_term(info, PL_FUNCTOR_CHARS, "group_info", 4, PL_MBCHARS, pgrp->gr_name, PL_MBCHARS, pgrp->gr_passwd, PL_INT, (int)pgrp->gr_gid, PL_TERM, members ); }
/* cairo_pattern_t */ cairo_bool_t plcairo_term_to_pattern(term_t t, cairo_pattern_t **pattern) { PLGIBlob *blob; PLCAIRO_debug(" term: 0x%lx ---> cairo_pattern_t: %p", t, *pattern); if ( !plgi_get_blob(t, &blob) ) { return PL_type_error("CairoPattern", t); } if ( blob->gtype != G_TYPE_NONE && !g_type_is_a( blob->gtype, CAIRO_GOBJECT_TYPE_PATTERN ) ) { return PL_type_error("CairoPattern", t); } *pattern = blob->data; return TRUE; }
static foreign_t p_setrand(term_t state) { if ( !PL_is_functor(state, FUNCTOR_rand3) ) return PL_type_error("rand_state", state); if ( !get_short_arg_ex(1, state, &a1) || !get_short_arg_ex(2, state, &b1) || !get_short_arg_ex(3, state, &c1) ) return FALSE; return TRUE; }
static int md5_options(term_t options, optval *result) { term_t opts = PL_copy_term_ref(options); term_t opt = PL_new_term_ref(); /* defaults */ memset(result, 0, sizeof(*result)); result->encoding = REP_UTF8; while(PL_get_list(opts, opt, opts)) { atom_t aname; size_t arity; if ( PL_get_name_arity(opt, &aname, &arity) && arity == 1 ) { term_t a = PL_new_term_ref(); _PL_get_arg(1, opt, a); if ( aname == ATOM_encoding ) { atom_t a_enc; if ( !PL_get_atom_ex(a, &a_enc) ) return FALSE; if ( a_enc == ATOM_utf8 ) result->encoding = REP_UTF8; else if ( a_enc == ATOM_octet ) result->encoding = REP_ISO_LATIN_1; else return PL_domain_error("encoding", a); } } else { return PL_type_error("option", opt); } } if ( !PL_get_nil(opts) ) return PL_type_error("list", opts); return TRUE; }
static foreign_t pl_clingo_ground(term_t ccontrol, term_t parts) { clingo_env *ctl; clingo_part_t *part_vec = NULL; size_t plen = 0; int rc; if (!(rc = get_clingo(ccontrol, &ctl))) { goto out; } switch (PL_skip_list(parts, 0, &plen)) { case PL_LIST: { term_t tail = PL_copy_term_ref(parts); term_t head = PL_new_term_ref(); if (!(part_vec = malloc(sizeof(*part_vec) * plen))) { rc = PL_resource_error("memory"); goto out; } memset(part_vec, 0, sizeof(*part_vec) * plen); for (size_t i = 0; PL_get_list(tail, head, tail); i++) { if (!(rc = get_params(head, &part_vec[i]))) { goto out; } } break; } default: { rc = PL_type_error("list", parts); goto out; } } if (!(rc = clingo_status(clingo_control_ground(ctl->control, part_vec, plen, call_function, ctl)))) { goto out; } out: if (part_vec) { for (size_t i = 0; i < plen; i++) { if (part_vec[i].params) { free((void *)part_vec[i].params); } } free(part_vec); } return rc; }
static foreign_t pl_clingo_add(term_t ccontrol, term_t params, term_t program) { char *prog; clingo_env *ctl; atom_t name; size_t arity; char *param_buf[FAST_PARAMS]; char **prog_params = param_buf; term_t arg = PL_new_term_ref(); int rc; if (!(rc = get_clingo(ccontrol, &ctl))) { goto out; } if (!get_name_arity(params, &name, &arity)) { rc = PL_type_error("callable", params); goto out; } if (arity + 1 > FAST_PARAMS && !(prog_params = malloc(sizeof(char *) * arity))) { rc = PL_resource_error("memory"); goto out; } for (size_t i = 0; i < arity; i++) { _PL_get_arg(i + 1, params, arg); if (!(rc = get_null_terminated_string(arg, &prog_params[i], CVT_ATOM))) { goto out; } } if (!(rc = get_null_terminated_string(program, &prog, CVT_ATOM | CVT_STRING | CVT_LIST | BUF_DISCARDABLE))) { goto out; } if (!(rc = clingo_status( clingo_control_add(ctl->control, PL_atom_chars(name), (const char **)prog_params, arity, prog)))) { goto out; } out: if (prog_params != param_buf) { free(prog_params); } return rc; }
static foreign_t pl_user_info(term_t user, term_t info) { int uid; struct passwd pwd, *pwdp; char buf[1000]; char *name; if ( PL_get_integer(user, &uid) ) { again1: errno = 0; if ( getpwuid_r(uid, &pwd, buf, sizeof(buf), &pwdp) != 0 ) { if ( errno == EINTR ) { if ( PL_handle_signals() < 0 ) return FALSE; goto again1; } return error(errno, "info", "user", user); } } else if ( PL_get_chars(user, &name, CVT_ATOMIC|REP_MB) ) { again2: errno = 0; if ( getpwnam_r(name, &pwd, buf, sizeof(buf), &pwdp) != 0 ) { if ( errno == EINTR ) { if ( PL_handle_signals() < 0 ) return FALSE; goto again2; } return error(errno, "info", "user", user); } } else { return PL_type_error("user", user); } if ( !pwdp ) return PL_existence_error("user", user); return PL_unify_term(info, PL_FUNCTOR_CHARS, "user_info", 7, PL_MBCHARS, pwdp->pw_name, PL_MBCHARS, pwdp->pw_passwd, PL_INT, (int)pwdp->pw_uid, PL_INT, (int)pwdp->pw_gid, PL_MBCHARS, pwdp->pw_gecos, PL_MBCHARS, pwdp->pw_dir, PL_MBCHARS, pwdp->pw_shell ); }
cairo_bool_t plcairo_term_to_pattern_type(term_t t, cairo_pattern_type_t *pattern_type) { atom_t a; PLCAIRO_debug(" term: 0x%lx ---> cairo_pattern_type_t: %p", t, pattern_type); if ( !PL_get_atom(t, &a) ) { return PL_type_error("CairoPatternType", t); } if ( !ATOM_cairo_pattern_type_solid ) { ATOM_cairo_pattern_type_solid = PL_new_atom("CAIRO_PATTERN_TYPE_SOLID"); ATOM_cairo_pattern_type_surface = PL_new_atom("CAIRO_PATTERN_TYPE_SURFACE"); ATOM_cairo_pattern_type_linear = PL_new_atom("CAIRO_PATTERN_TYPE_LINEAR"); ATOM_cairo_pattern_type_radial = PL_new_atom("CAIRO_PATTERN_TYPE_RADIAL"); ATOM_cairo_pattern_type_mesh = PL_new_atom("CAIRO_PATTERN_TYPE_MESH"); ATOM_cairo_pattern_type_raster_source = PL_new_atom("CAIRO_PATTERN_TYPE_RASTER_SOURCE"); } if ( a == ATOM_cairo_pattern_type_solid ) { *pattern_type = CAIRO_PATTERN_TYPE_SOLID; } else if ( a == ATOM_cairo_pattern_type_surface ) { *pattern_type = CAIRO_PATTERN_TYPE_SURFACE; } else if ( a == ATOM_cairo_pattern_type_linear ) { *pattern_type = CAIRO_PATTERN_TYPE_LINEAR; } else if ( a == ATOM_cairo_pattern_type_radial ) { *pattern_type = CAIRO_PATTERN_TYPE_RADIAL; } else if ( a == ATOM_cairo_pattern_type_mesh ) { *pattern_type = CAIRO_PATTERN_TYPE_MESH; } else if ( a == ATOM_cairo_pattern_type_raster_source ) { *pattern_type = CAIRO_PATTERN_TYPE_RASTER_SOURCE; } else { return PL_domain_error("CairoPatternType", t); } return TRUE; }
cairo_bool_t plcairo_term_to_filter(term_t t, cairo_filter_t *filter) { atom_t a; PLCAIRO_debug(" term: 0x%lx ---> cairo_filter_t: %p", t, filter); if ( !PL_get_atom(t, &a) ) { return PL_type_error("CairoFilter", t); } if ( !ATOM_cairo_filter_fast ) { ATOM_cairo_filter_fast = PL_new_atom("CAIRO_FILTER_FAST"); ATOM_cairo_filter_good = PL_new_atom("CAIRO_FILTER_GOOD"); ATOM_cairo_filter_best = PL_new_atom("CAIRO_FILTER_BEST"); ATOM_cairo_filter_nearest = PL_new_atom("CAIRO_FILTER_NEAREST"); ATOM_cairo_filter_bilinear = PL_new_atom("CAIRO_FILTER_BILINEAR"); ATOM_cairo_filter_gaussian = PL_new_atom("CAIRO_FILTER_GAUSSIAN"); } if ( a == ATOM_cairo_filter_fast ) { *filter = CAIRO_FILTER_FAST; } else if ( a == ATOM_cairo_filter_good ) { *filter = CAIRO_FILTER_GOOD; } else if ( a == ATOM_cairo_filter_best ) { *filter = CAIRO_FILTER_BEST; } else if ( a == ATOM_cairo_filter_nearest ) { *filter = CAIRO_FILTER_NEAREST; } else if ( a == ATOM_cairo_filter_bilinear ) { *filter = CAIRO_FILTER_BILINEAR; } else if ( a == ATOM_cairo_filter_gaussian ) { *filter = CAIRO_FILTER_GAUSSIAN; } else { return PL_domain_error("CairoFilter", t); } return TRUE; }
static int get_clingo(term_t t, clingo_env **ccontrol) { PL_blob_t *type; void *data; if (PL_get_blob(t, &data, NULL, &type) && type == &clingo_blob) { clingo_wrapper *ar = data; assert(ar->magic == CLINGO_MAGIC); if (!ar->clingo->control) { return PL_existence_error("clingo", t); } *ccontrol = ar->clingo; return TRUE; } return PL_type_error("clingo", t); }
static int get_dict_ex(term_t t, Word dp, int ex ARG_LD) { Word p = valTermRef(t); deRef(p); if ( isTerm(*p) ) { Functor f = valueTerm(*p); FunctorDef fd = valueFunctor(f->definition); if ( fd->name == ATOM_dict && fd->arity%2 == 1 ) /* does *not* validate ordering */ { *dp = *p; return TRUE; } } if ( !ex ) return FALSE; PL_type_error("dict", t); return FALSE; }
static int get_archive(term_t t, archive_wrapper **arp) { PL_blob_t *type; void *data; if ( PL_get_blob(t, &data, NULL, &type) && type == &archive_blob) { archive_wrapper *ar = data; assert(ar->magic == ARCHIVE_MAGIC); if ( ar->symbol ) { *arp = ar; return TRUE; } PL_permission_error("access", "closed_archive", t); return FALSE; } return PL_type_error("archive", t); }
cairo_bool_t plcairo_term_to_extend(term_t t, cairo_extend_t *extend) { atom_t a; PLCAIRO_debug(" term: 0x%lx ---> cairo_extend_t: %p", t, extend); if ( !PL_get_atom(t, &a) ) { return PL_type_error("CairoExtend", t); } if ( !ATOM_cairo_extend_none ) { ATOM_cairo_extend_none = PL_new_atom("CAIRO_EXTEND_NONE"); ATOM_cairo_extend_repeat = PL_new_atom("CAIRO_EXTEND_REPEAT"); ATOM_cairo_extend_reflect = PL_new_atom("CAIRO_EXTEND_REFLECT"); ATOM_cairo_extend_pad = PL_new_atom("CAIRO_EXTEND_PAD"); } if ( a == ATOM_cairo_extend_none ) { *extend = CAIRO_EXTEND_NONE; } else if ( a == ATOM_cairo_extend_repeat ) { *extend = CAIRO_EXTEND_REPEAT; } else if ( a == ATOM_cairo_extend_reflect ) { *extend = CAIRO_EXTEND_REFLECT; } else if ( a == ATOM_cairo_extend_pad ) { *extend = CAIRO_EXTEND_PAD; } else { return PL_domain_error("CairoExtend", t); } return TRUE; }
static int get_create_dict_ex(term_t t, term_t dt ARG_LD) { Word p = valTermRef(t); deRef(p); if ( isTerm(*p) ) { Functor f = valueTerm(*p); FunctorDef fd = valueFunctor(f->definition); if ( fd->name == ATOM_dict && fd->arity%2 == 1 ) /* does *not* validate ordering */ { *valTermRef(dt) = *p; return TRUE; } } if ( PL_get_dict_ex(t, 0, dt, DICT_GET_ALL) ) { assert(isTerm(*valTermRef(dt))); return TRUE; } return PL_type_error("dict", t); }
static foreign_t pl_clingo_solve(term_t ccontrol, term_t assumptions, term_t Show, term_t Model, control_t h) { int rc = TRUE; solve_state *state = NULL; clingo_symbolic_literal_t *assump_vec = NULL; int control = PL_foreign_control(h); if (control == PL_FIRST_CALL) { size_t alen = 0; if (!(state = malloc(sizeof(*state)))) { rc = PL_resource_error("memory"); goto out; } memset(state, 0, sizeof(*state)); if (!(rc = get_clingo(ccontrol, &state->ctl))) { goto out; } if (PL_skip_list(assumptions, 0, &alen) != PL_LIST) { rc = PL_type_error("list", assumptions); goto out; } term_t tail = PL_copy_term_ref(assumptions); term_t head = PL_new_term_ref(); if (!(assump_vec = malloc(sizeof(*assump_vec) * alen))) { rc = PL_resource_error("memory"); goto out; } memset(assump_vec, 0, sizeof(*assump_vec) * alen); for (size_t i = 0; PL_get_list(tail, head, tail); i++) { if (!(rc = clingo_status(get_assumption(head, &assump_vec[i])))) { goto out; } } if (!(rc = clingo_status(clingo_control_solve_iteratively( state->ctl->control, assump_vec, alen, &state->it)))) { goto out; } } else { state = PL_foreign_context_address(h); } while (control != PL_PRUNED) { clingo_model_t *model; if (!(rc = clingo_status( clingo_solve_iteratively_next(state->it, &model)))) { goto out; } if (model) { int show; if (!(rc = get_show_map(Show, &show))) { goto out; } if (!(rc = unify_model(Model, show, model))) { if (PL_exception(0)) { goto out; } } else { PL_retry_address(state); state = NULL; break; } } else { rc = FALSE; break; } } out: if (assump_vec) { free(assump_vec); } if (state) { if (state->it) { clingo_solve_iteratively_close(state->it); } free(state); } return rc; }
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; }
foreign_t fcgi_param(term_t name, term_t value, control_t h) { fcgi_context *ctxt; char **env, **cgi_environ; char *s, *v, *sep; ctxt = pthread_getspecific(key); if ( FCGX_IsCGI() ) { cgi_environ = environ; } else { cgi_environ = ctxt->env; } if ( !PL_is_variable(name) ) { if ( !PL_get_atom_chars(name, &s) ) { return PL_type_error("atom", name); } v = FCGX_GetParam(s, cgi_environ); if ( !v ) { return FALSE; } return PL_unify_chars(value, PL_ATOM|REP_UTF8, -1, v); } switch ( PL_foreign_control(h) ) { case PL_FIRST_CALL: { env = cgi_environ; break; } case PL_REDO: { env = PL_foreign_context_address(h); break; } case PL_PRUNED: default: { return TRUE; } } for ( ; *env; env++ ) { s = strdup(*env); sep = index(s, '='); sep[0] = '\0'; if ( !PL_unify_chars(name, PL_ATOM|REP_UTF8, -1, s) ) { free(s); return FALSE; } if ( !PL_unify_chars(value, PL_ATOM|REP_UTF8, -1, sep+1) ) { free(s); return FALSE; } free(s); PL_retry_address(env+1); } return FALSE; }
static foreign_t archive_open_stream(term_t data, term_t handle, term_t options) { IOSTREAM *datas; archive_wrapper *ar; term_t tail = PL_copy_term_ref(options); term_t head = PL_new_term_ref(); term_t arg = PL_new_term_ref(); if ( !PL_get_stream_handle(data, &datas) ) return FALSE; if ( !(datas->flags & SIO_INPUT) ) { PL_release_stream(datas); return PL_domain_error("input_stream", data); } ar = PL_malloc(sizeof(*ar)); memset(ar, 0, sizeof(*ar)); ar->data = datas; ar->magic = ARCHIVE_MAGIC; if ( !PL_unify_blob(handle, ar, sizeof(*ar), &archive_blob) ) return FALSE; while( PL_get_list_ex(tail, head, tail) ) { atom_t name; int arity; if ( !PL_get_name_arity(head, &name, &arity) || !PL_get_arg(1, head, arg) ) return PL_type_error("option", head); if ( name == ATOM_compression || name == ATOM_filter ) { atom_t c; if ( !PL_get_atom_ex(arg, &c) ) return FALSE; if ( c == ATOM_all ) ar->type |= FILTER_ALL; #ifdef FILTER_BZIP2 else if ( c == ATOM_bzip2 ) ar->type |= FILTER_BZIP2; #endif #ifdef FILTER_COMPRESS else if ( c == ATOM_compress ) ar->type |= FILTER_COMPRESS; #endif #ifdef FILTER_GZIP else if ( c == ATOM_gzip ) ar->type |= FILTER_GZIP; #endif #ifdef FILTER_GRZIP else if ( c == ATOM_grzip ) ar->type |= FILTER_GRZIP; #endif #ifdef FILTER_LRZIP else if ( c == ATOM_lrzip ) ar->type |= FILTER_LRZIP; #endif #ifdef FILTER_LZIP else if ( c == ATOM_lzip ) ar->type |= FILTER_LZIP; #endif #ifdef FILTER_LZMA else if ( c == ATOM_lzma ) ar->type |= FILTER_LZMA; #endif #ifdef FILTER_LZOP else if ( c == ATOM_lzop ) ar->type |= FILTER_LZOP; #endif #ifdef FILTER_NONE else if ( c == ATOM_none ) ar->type |= FILTER_NONE; #endif #ifdef FILTER_RPM else if ( c == ATOM_rpm ) ar->type |= FILTER_RPM; #endif #ifdef FILTER_UU else if ( c == ATOM_uu ) ar->type |= FILTER_UU; #endif #ifdef FILTER_XZ else if ( c == ATOM_xz ) ar->type |= FILTER_XZ; #endif else return PL_domain_error("filter", arg); } else if ( name == ATOM_format ) { atom_t f; if ( !PL_get_atom_ex(arg, &f) ) return FALSE; if ( f == ATOM_all ) ar->type |= FORMAT_ALL; #ifdef FORMAT_7ZIP else if ( f == ATOM_7zip ) ar->type |= FORMAT_7ZIP; #endif #ifdef FORMAT_AR else if ( f == ATOM_ar ) ar->type |= FORMAT_AR; #endif #ifdef FORMAT_CAB else if ( f == ATOM_cab ) ar->type |= FORMAT_CAB; #endif #ifdef FORMAT_CPIO else if ( f == ATOM_cpio ) ar->type |= FORMAT_CPIO; #endif #ifdef FORMAT_EMPTY else if ( f == ATOM_empty ) ar->type |= FORMAT_EMPTY; #endif #ifdef FORMAT_GNUTAR else if ( f == ATOM_gnutar ) ar->type |= FORMAT_GNUTAR; #endif #ifdef FORMAT_ISO9960 else if ( f == ATOM_iso9960 ) ar->type |= FORMAT_ISO9960; #endif #ifdef FORMAT_LHA else if ( f == ATOM_lha ) ar->type |= FORMAT_LHA; #endif #ifdef FORMAT_MTREE else if ( f == ATOM_mtree ) ar->type |= FORMAT_MTREE; #endif #ifdef FORMAT_RAR else if ( f == ATOM_rar ) ar->type |= FORMAT_RAR; #endif #ifdef FORMAT_RAW else if ( f == ATOM_raw ) ar->type |= FORMAT_RAW; #endif #ifdef FORMAT_TAR else if ( f == ATOM_tar ) ar->type |= FORMAT_TAR; #endif #ifdef FORMAT_XAR else if ( f == ATOM_xar ) ar->type |= FORMAT_XAR; #endif #ifdef FORMAT_ZIP else if ( f == ATOM_zip ) ar->type |= FORMAT_ZIP; #endif else return PL_domain_error("format", arg); } else if ( name == ATOM_close_parent ) { if ( !PL_get_bool_ex(arg, &ar->close_parent) ) return FALSE; } } if ( !PL_get_nil_ex(tail) ) return FALSE; if ( !(ar->type & FILTER_ALL) ) ar->type |= FILTER_ALL; if ( !(ar->type & FORMAT_MASK) ) ar->type |= FORMAT_ALL; if ( !(ar->archive = archive_read_new()) ) return PL_resource_error("memory"); if ( (ar->type & FILTER_ALL) == FILTER_ALL ) { archive_read_support_filter_all(ar->archive); } else { #ifdef FILTER_BZIP2 enable_type(ar, FILTER_BZIP2, archive_read_support_filter_bzip2); #endif #ifdef FILTER_COMPRESS enable_type(ar, FILTER_COMPRESS, archive_read_support_filter_compress); #endif #ifdef FILTER_GZIP enable_type(ar, FILTER_GZIP, archive_read_support_filter_gzip); #endif #ifdef FILTER_GRZIP enable_type(ar, FILTER_GRZIP, archive_read_support_filter_grzip); #endif #ifdef FILTER_LRZIP enable_type(ar, FILTER_LRZIP, archive_read_support_filter_lrzip); #endif #ifdef FILTER_LZIP enable_type(ar, FILTER_LZIP, archive_read_support_filter_lzip); #endif #ifdef FILTER_LZMA enable_type(ar, FILTER_LZMA, archive_read_support_filter_lzma); #endif #ifdef FILTER_LZOP enable_type(ar, FILTER_LZOP, archive_read_support_filter_lzop); #endif #ifdef FILTER_NONE enable_type(ar, FILTER_NONE, archive_read_support_filter_none); #endif #ifdef FILTER_RPM enable_type(ar, FILTER_RPM, archive_read_support_filter_rpm); #endif #ifdef FILTER_UU enable_type(ar, FILTER_UU, archive_read_support_filter_uu); #endif #ifdef FILTER_XZ enable_type(ar, FILTER_XZ, archive_read_support_filter_xz); #endif } if ( (ar->type & FORMAT_ALL) == FORMAT_ALL ) { archive_read_support_format_all(ar->archive); #ifdef FORMAT_RAW enable_type(ar, FORMAT_RAW, archive_read_support_format_raw); #endif } else { #ifdef FORMAT_7ZIP enable_type(ar, FORMAT_7ZIP, archive_read_support_format_7zip); #endif #ifdef FORMAT_AR enable_type(ar, FORMAT_AR, archive_read_support_format_ar); #endif #ifdef FORMAT_CAB enable_type(ar, FORMAT_CAB, archive_read_support_format_cab); #endif #ifdef FORMAT_CPIO enable_type(ar, FORMAT_CPIO, archive_read_support_format_cpio); #endif #ifdef FORMAT_EMPTY enable_type(ar, FORMAT_EMPTY, archive_read_support_format_empty); #endif #ifdef FORMAT_GNUTAR enable_type(ar, FORMAT_GNUTAR, archive_read_support_format_gnutar); #endif #ifdef FORMAT_ISO9960 enable_type(ar, FORMAT_ISO9960, archive_read_support_format_iso9660); #endif #ifdef FORMAT_LHA enable_type(ar, FORMAT_LHA, archive_read_support_format_lha); #endif #ifdef FORMAT_MTREE enable_type(ar, FORMAT_MTREE, archive_read_support_format_mtree); #endif #ifdef FORMAT_RAR enable_type(ar, FORMAT_RAR, archive_read_support_format_rar); #endif #ifdef FORMAT_RAW enable_type(ar, FORMAT_RAW, archive_read_support_format_raw); #endif #ifdef FORMAT_TAR enable_type(ar, FORMAT_TAR, archive_read_support_format_tar); #endif #ifdef FORMAT_XAR enable_type(ar, FORMAT_XAR, archive_read_support_format_xar); #endif #ifdef FORMAT_ZIP enable_type(ar, FORMAT_ZIP, archive_read_support_format_zip); #endif } #ifdef HAVE_ARCHIVE_READ_OPEN1 archive_read_set_callback_data(ar->archive, ar); archive_read_set_open_callback(ar->archive, ar_open); archive_read_set_read_callback(ar->archive, ar_read); archive_read_set_skip_callback(ar->archive, ar_skip); archive_read_set_seek_callback(ar->archive, ar_seek); archive_read_set_close_callback(ar->archive, ar_close); if ( archive_read_open1(ar->archive) == ARCHIVE_OK ) { ar->status = AR_OPENED; return TRUE; } #else if ( archive_read_open2(ar->archive, ar, ar_open, ar_read, ar_skip, ar_close) == ARCHIVE_OK ) { ar->status = AR_OPENED; return TRUE; } #endif return archive_error(ar); }
static foreign_t archive_header_prop(term_t archive, term_t field) { archive_wrapper *ar; functor_t prop; if ( !get_archive(archive, &ar) ) return FALSE; if ( !PL_get_functor(field, &prop) ) return PL_type_error("compound", field); if ( ar->status != AR_NEW_ENTRY ) return PL_permission_error("access", "archive_entry", archive); if ( prop == FUNCTOR_filetype1 ) { __LA_MODE_T type = archive_entry_filetype(ar->entry); atom_t name; term_t arg = PL_new_term_ref(); _PL_get_arg(1, field, arg); switch(type&AE_IFMT) { case AE_IFREG: name = ATOM_file; break; case AE_IFLNK: name = ATOM_link; break; case AE_IFSOCK: name = ATOM_socket; break; case AE_IFCHR: name = ATOM_character_device; break; case AE_IFBLK: name = ATOM_block_device; break; case AE_IFDIR: name = ATOM_directory; break; case AE_IFIFO: name = ATOM_fifo; break; default: return PL_unify_integer(arg, (type&AE_IFMT)); } return PL_unify_atom(arg, name); } else if ( prop == FUNCTOR_mtime1 ) { time_t stamp = archive_entry_mtime(ar->entry); term_t arg = PL_new_term_ref(); _PL_get_arg(1, field, arg); return PL_unify_float(arg, (double)stamp); } else if ( prop == FUNCTOR_size1 ) { int64_t size = archive_entry_size(ar->entry); term_t arg = PL_new_term_ref(); _PL_get_arg(1, field, arg); return PL_unify_int64(arg, size); } else if ( prop == FUNCTOR_link_target1 ) { __LA_MODE_T type = archive_entry_filetype(ar->entry); const wchar_t *target = NULL; switch(type&AE_IFMT) { case AE_IFLNK: target = archive_entry_symlink_w(ar->entry); break; } if ( target ) { term_t arg = PL_new_term_ref(); _PL_get_arg(1, field, arg); return PL_unify_wchars(arg, PL_ATOM, (size_t)-1, target); } return FALSE; } else if ( prop == FUNCTOR_format1 ) { const char *s = archive_format_name(ar->archive); if ( s ) { char lwr[50]; char *o; term_t arg = PL_new_term_ref(); _PL_get_arg(1, field, arg); for(o=lwr; *s && o < lwr+sizeof(lwr); ) *o++ = tolower(*s++); *o = '\0'; return PL_unify_atom_chars(arg, lwr); } } return PL_domain_error("archive_header_property", field); }