int ssl_get_new_session(SSL *s, int session)
{
    /* This gets used by clients and servers. */

    unsigned int tmp;
    SSL_SESSION *ss = NULL;
    GEN_SESSION_CB cb = def_generate_session_id;

    if ((ss = SSL_SESSION_new()) == NULL)
        return (0);

    /* If the context has a default timeout, use it */
    if (s->session_ctx->session_timeout == 0)
        ss->timeout = SSL_get_default_timeout(s);
    else
        ss->timeout = s->session_ctx->session_timeout;

    if (s->session != NULL) {
        SSL_SESSION_free(s->session);
        s->session = NULL;
    }

    if (session) {
        if (s->version == SSL2_VERSION) {
            ss->ssl_version = SSL2_VERSION;
            ss->session_id_length = SSL2_SSL_SESSION_ID_LENGTH;
        } else if (s->version == SSL3_VERSION) {
            ss->ssl_version = SSL3_VERSION;
            ss->session_id_length = SSL3_SSL_SESSION_ID_LENGTH;
        } else if (s->version == TLS1_VERSION) {
            ss->ssl_version = TLS1_VERSION;
            ss->session_id_length = SSL3_SSL_SESSION_ID_LENGTH;
        } else if (s->version == TLS1_1_VERSION) {
            ss->ssl_version = TLS1_1_VERSION;
            ss->session_id_length = SSL3_SSL_SESSION_ID_LENGTH;
        } else if (s->version == TLS1_2_VERSION) {
            ss->ssl_version = TLS1_2_VERSION;
            ss->session_id_length = SSL3_SSL_SESSION_ID_LENGTH;
        } else if (s->version == DTLS1_BAD_VER) {
            ss->ssl_version = DTLS1_BAD_VER;
            ss->session_id_length = SSL3_SSL_SESSION_ID_LENGTH;
        } else if (s->version == DTLS1_VERSION) {
            ss->ssl_version = DTLS1_VERSION;
            ss->session_id_length = SSL3_SSL_SESSION_ID_LENGTH;
        } else {
            SSLerr(SSL_F_SSL_GET_NEW_SESSION, SSL_R_UNSUPPORTED_SSL_VERSION);
            SSL_SESSION_free(ss);
            return (0);
        }
#ifndef OPENSSL_NO_TLSEXT
        /*-
         * If RFC5077 ticket, use empty session ID (as server).
         * Note that:
         * (a) ssl_get_prev_session() does lookahead into the
         *     ClientHello extensions to find the session ticket.
         *     When ssl_get_prev_session() fails, s3_srvr.c calls
         *     ssl_get_new_session() in ssl3_get_client_hello().
         *     At that point, it has not yet parsed the extensions,
         *     however, because of the lookahead, it already knows
         *     whether a ticket is expected or not.
         *
         * (b) s3_clnt.c calls ssl_get_new_session() before parsing
         *     ServerHello extensions, and before recording the session
         *     ID received from the server, so this block is a noop.
         */
        if (s->tlsext_ticket_expected) {
            ss->session_id_length = 0;
            goto sess_id_done;
        }
#endif
        /* Choose which callback will set the session ID */
        CRYPTO_r_lock(CRYPTO_LOCK_SSL_CTX);
        if (s->generate_session_id)
            cb = s->generate_session_id;
        else if (s->session_ctx->generate_session_id)
            cb = s->session_ctx->generate_session_id;
        CRYPTO_r_unlock(CRYPTO_LOCK_SSL_CTX);
        /* Choose a session ID */
        tmp = ss->session_id_length;
        if (!cb(s, ss->session_id, &tmp)) {
            /* The callback failed */
            SSLerr(SSL_F_SSL_GET_NEW_SESSION,
                   SSL_R_SSL_SESSION_ID_CALLBACK_FAILED);
            SSL_SESSION_free(ss);
            return (0);
        }
        /*
         * Don't allow the callback to set the session length to zero. nor
         * set it higher than it was.
         */
        if (!tmp || (tmp > ss->session_id_length)) {
            /* The callback set an illegal length */
            SSLerr(SSL_F_SSL_GET_NEW_SESSION,
                   SSL_R_SSL_SESSION_ID_HAS_BAD_LENGTH);
            SSL_SESSION_free(ss);
            return (0);
        }
        /* If the session length was shrunk and we're SSLv2, pad it */
        if ((tmp < ss->session_id_length) && (s->version == SSL2_VERSION))
            memset(ss->session_id + tmp, 0, ss->session_id_length - tmp);
        else
            ss->session_id_length = tmp;
        /* Finally, check for a conflict */
        if (SSL_has_matching_session_id(s, ss->session_id,
                                        ss->session_id_length)) {
            SSLerr(SSL_F_SSL_GET_NEW_SESSION, SSL_R_SSL_SESSION_ID_CONFLICT);
            SSL_SESSION_free(ss);
            return (0);
        }
#ifndef OPENSSL_NO_TLSEXT
 sess_id_done:
        if (s->tlsext_hostname) {
            ss->tlsext_hostname = BUF_strdup(s->tlsext_hostname);
            if (ss->tlsext_hostname == NULL) {
                SSLerr(SSL_F_SSL_GET_NEW_SESSION, ERR_R_INTERNAL_ERROR);
                SSL_SESSION_free(ss);
                return 0;
            }
        }
# ifndef OPENSSL_NO_EC
        if (s->tlsext_ecpointformatlist) {
            if (ss->tlsext_ecpointformatlist != NULL)
                OPENSSL_free(ss->tlsext_ecpointformatlist);
            if ((ss->tlsext_ecpointformatlist =
                 OPENSSL_malloc(s->tlsext_ecpointformatlist_length)) ==
                NULL) {
                SSLerr(SSL_F_SSL_GET_NEW_SESSION, ERR_R_MALLOC_FAILURE);
                SSL_SESSION_free(ss);
                return 0;
            }
            ss->tlsext_ecpointformatlist_length =
                s->tlsext_ecpointformatlist_length;
            memcpy(ss->tlsext_ecpointformatlist, s->tlsext_ecpointformatlist,
                   s->tlsext_ecpointformatlist_length);
        }
        if (s->tlsext_ellipticcurvelist) {
            if (ss->tlsext_ellipticcurvelist != NULL)
                OPENSSL_free(ss->tlsext_ellipticcurvelist);
            if ((ss->tlsext_ellipticcurvelist =
                 OPENSSL_malloc(s->tlsext_ellipticcurvelist_length)) ==
                NULL) {
                SSLerr(SSL_F_SSL_GET_NEW_SESSION, ERR_R_MALLOC_FAILURE);
                SSL_SESSION_free(ss);
                return 0;
            }
            ss->tlsext_ellipticcurvelist_length =
                s->tlsext_ellipticcurvelist_length;
            memcpy(ss->tlsext_ellipticcurvelist, s->tlsext_ellipticcurvelist,
                   s->tlsext_ellipticcurvelist_length);
        }
# endif
#endif
    } else {
        ss->session_id_length = 0;
    }

    if (s->sid_ctx_length > sizeof ss->sid_ctx) {
        SSLerr(SSL_F_SSL_GET_NEW_SESSION, ERR_R_INTERNAL_ERROR);
        SSL_SESSION_free(ss);
        return 0;
    }
    memcpy(ss->sid_ctx, s->sid_ctx, s->sid_ctx_length);
    ss->sid_ctx_length = s->sid_ctx_length;
    s->session = ss;
    ss->ssl_version = s->version;
    ss->verify_result = X509_V_OK;

    return (1);
}


unsigned int SSL_SESSION_get_compress_id(const SSL_SESSION *s)
{
    return s->compress_meth;
}

Fix race condition in NewSessionTicket

If a NewSessionTicket is received by a multi-threaded client when
attempting to reuse a previous ticket then a race condition can occur
potentially leading to a double free of the ticket data.

CVE-2015-1791

This also fixes RT#3808 where a session ID is changed for a session already
in the client session cache. Since the session ID is the key to the cache
this breaks the cache access.

Parts of this patch were inspired by this Akamai change:
https://github.com/akamai/openssl/commit/c0bf69a791239ceec64509f9f19fcafb2461b0d3

Reviewed-by: Rich Salz <rsalz@openssl.org>
(cherry picked from commit 27c76b9b8010b536687318739c6f631ce4194688)

Conflicts:
	ssl/ssl.h
	ssl/ssl_err.c


void (*SSL_CTX_get_info_callback(SSL_CTX *ctx)) (const SSL *ssl, int type,
                                                 int val) {
    return ctx->info_callback;
}


int (*SSL_CTX_get_client_cert_cb(SSL_CTX *ctx)) (SSL *ssl, X509 **x509,
                                                 EVP_PKEY **pkey) {
    return ctx->client_cert_cb;
}


long SSL_SESSION_set_timeout(SSL_SESSION *s, long t)
{
    if (s == NULL)
        return (0);
    s->timeout = t;
    return (1);
}


int SSL_set_session_ticket_ext_cb(SSL *s, tls_session_ticket_ext_cb_fn cb,
                                  void *arg)
{
    if (s == NULL)
        return (0);
    s->tls_session_ticket_ext_cb = cb;
    s->tls_session_ticket_ext_cb_arg = arg;
    return (1);
}


void SSL_CTX_set_cookie_verify_cb(SSL_CTX *ctx,
                                  int (*cb) (SSL *ssl, unsigned char *cookie,
                                             unsigned int cookie_len))
{
    ctx->app_verify_cookie_cb = cb;
}


const unsigned char *SSL_SESSION_get_id(const SSL_SESSION *s,
                                        unsigned int *len)
{
    if (len)
        *len = s->session_id_length;
    return s->session_id;
}


static void timeout_doall_arg(SSL_SESSION *s, TIMEOUT_PARAM *p)
{
    if ((p->time == 0) || (p->time > (s->time + s->timeout))) { /* timeout */
        /*
         * The reason we don't call SSL_CTX_remove_session() is to save on
         * locking overhead
         */
        (void)lh_SSL_SESSION_delete(p->cache, s);
        SSL_SESSION_list_remove(p->ctx, s);
        s->not_resumable = 1;
        if (p->ctx->remove_session_cb != NULL)
            p->ctx->remove_session_cb(p->ctx, s);
        SSL_SESSION_free(s);
    }
}


int SSL_set_session_secret_cb(SSL *s,
                              int (*tls_session_secret_cb) (SSL *s,
                                                            void *secret,
                                                            int *secret_len,
                                                            STACK_OF(SSL_CIPHER)
                                                            *peer_ciphers,
                                                            SSL_CIPHER
                                                            **cipher,
                                                            void *arg),
                              void *arg)
{
    if (s == NULL)
        return (0);
    s->tls_session_secret_cb = tls_session_secret_cb;
    s->tls_session_secret_cb_arg = arg;
    return (1);
}


SSL_SESSION *SSL_get1_session(SSL *ssl)
/* variant of SSL_get_session: caller really gets something */
{
    SSL_SESSION *sess;
    /*
     * Need to lock this all up rather than just use CRYPTO_add so that
     * somebody doesn't free ssl->session between when we check it's non-null
     * and when we up the reference count.
     */
    CRYPTO_w_lock(CRYPTO_LOCK_SSL_SESSION);
    sess = ssl->session;
    if (sess)
        sess->references++;
    CRYPTO_w_unlock(CRYPTO_LOCK_SSL_SESSION);
    return (sess);
}


void SSL_CTX_sess_set_get_cb(SSL_CTX *ctx,
                             SSL_SESSION *(*cb) (struct ssl_st *ssl,
                                                 unsigned char *data, int len,
                                                 int *copy))
{
    ctx->get_session_cb = cb;
}


void SSL_CTX_set_info_callback(SSL_CTX *ctx,
                               void (*cb) (const SSL *ssl, int type, int val))
{
    ctx->info_callback = cb;
}


void SSL_CTX_set_cookie_generate_cb(SSL_CTX *ctx,
                                    int (*cb) (SSL *ssl,
                                               unsigned char *cookie,
                                               unsigned int *cookie_len))
{
    ctx->app_gen_cookie_cb = cb;
}


static int def_generate_session_id(const SSL *ssl, unsigned char *id,
                                   unsigned int *id_len)
{
    unsigned int retry = 0;
    do
        if (RAND_pseudo_bytes(id, *id_len) <= 0)
            return 0;
    while (SSL_has_matching_session_id(ssl, id, *id_len) &&
           (++retry < MAX_SESS_ID_ATTEMPTS)) ;
    if (retry < MAX_SESS_ID_ATTEMPTS)
        return 1;
    /* else - woops a session_id match */
    /*
     * XXX We should also check the external cache -- but the probability of
     * a collision is negligible, and we could not prevent the concurrent
     * creation of sessions with identical IDs since we currently don't have
     * means to atomically check whether a session ID already exists and make
     * a reservation for it if it does not (this problem applies to the
     * internal cache as well).
     */
    return 0;
}


int ssl_clear_bad_session(SSL *s)
{
    if ((s->session != NULL) &&
        !(s->shutdown & SSL_SENT_SHUTDOWN) &&
        !(SSL_in_init(s) || SSL_in_before(s))) {
        SSL_CTX_remove_session(s->ctx, s->session);
        return (1);
    } else
        return (0);
}


int SSL_CTX_add_session(SSL_CTX *ctx, SSL_SESSION *c)
{
    int ret = 0;
    SSL_SESSION *s;

    /*
     * add just 1 reference count for the SSL_CTX's session cache even though
     * it has two ways of access: each session is in a doubly linked list and
     * an lhash
     */
    CRYPTO_add(&c->references, 1, CRYPTO_LOCK_SSL_SESSION);
    /*
     * if session c is in already in cache, we take back the increment later
     */

    CRYPTO_w_lock(CRYPTO_LOCK_SSL_CTX);
    s = lh_SSL_SESSION_insert(ctx->sessions, c);

    /*
     * s != NULL iff we already had a session with the given PID. In this
     * case, s == c should hold (then we did not really modify
     * ctx->sessions), or we're in trouble.
     */
    if (s != NULL && s != c) {
        /* We *are* in trouble ... */
        SSL_SESSION_list_remove(ctx, s);
        SSL_SESSION_free(s);
        /*
         * ... so pretend the other session did not exist in cache (we cannot
         * handle two SSL_SESSION structures with identical session ID in the
         * same cache, which could happen e.g. when two threads concurrently
         * obtain the same session from an external cache)
         */
        s = NULL;
    }

    /* Put at the head of the queue unless it is already in the cache */
    if (s == NULL)
        SSL_SESSION_list_add(ctx, c);

    if (s != NULL) {
        /*
         * existing cache entry -- decrement previously incremented reference
         * count because it already takes into account the cache
         */

        SSL_SESSION_free(s);    /* s == c */
        ret = 0;
    } else {
        /*
         * new cache entry -- remove old ones if cache has become too large
         */

        ret = 1;

        if (SSL_CTX_sess_get_cache_size(ctx) > 0) {
            while (SSL_CTX_sess_number(ctx) >
                   SSL_CTX_sess_get_cache_size(ctx)) {
                if (!remove_session_lock(ctx, ctx->session_cache_tail, 0))
                    break;
                else
                    ctx->stats.sess_cache_full++;
            }
        }
    }
    CRYPTO_w_unlock(CRYPTO_LOCK_SSL_CTX);
    return (ret);
}


int SSL_SESSION_get_ex_new_index(long argl, void *argp,
                                 CRYPTO_EX_new *new_func,
                                 CRYPTO_EX_dup *dup_func,
                                 CRYPTO_EX_free *free_func)
{
    return CRYPTO_get_ex_new_index(CRYPTO_EX_INDEX_SSL_SESSION, argl, argp,
                                   new_func, dup_func, free_func);
}


void SSL_SESSION_free(SSL_SESSION *ss)
{
    int i;

    if (ss == NULL)
        return;

    i = CRYPTO_add(&ss->references, -1, CRYPTO_LOCK_SSL_SESSION);
#ifdef REF_PRINT
    REF_PRINT("SSL_SESSION", ss);
#endif
    if (i > 0)
        return;
#ifdef REF_CHECK
    if (i < 0) {
        fprintf(stderr, "SSL_SESSION_free, bad reference count\n");
        abort();                /* ok */
    }
#endif

    CRYPTO_free_ex_data(CRYPTO_EX_INDEX_SSL_SESSION, ss, &ss->ex_data);

    OPENSSL_cleanse(ss->key_arg, sizeof ss->key_arg);
    OPENSSL_cleanse(ss->master_key, sizeof ss->master_key);
    OPENSSL_cleanse(ss->session_id, sizeof ss->session_id);
    if (ss->sess_cert != NULL)
        ssl_sess_cert_free(ss->sess_cert);
    if (ss->peer != NULL)
        X509_free(ss->peer);
    if (ss->ciphers != NULL)
        sk_SSL_CIPHER_free(ss->ciphers);
#ifndef OPENSSL_NO_TLSEXT
    if (ss->tlsext_hostname != NULL)
        OPENSSL_free(ss->tlsext_hostname);
    if (ss->tlsext_tick != NULL)
        OPENSSL_free(ss->tlsext_tick);
# ifndef OPENSSL_NO_EC
    ss->tlsext_ecpointformatlist_length = 0;
    if (ss->tlsext_ecpointformatlist != NULL)
        OPENSSL_free(ss->tlsext_ecpointformatlist);
    ss->tlsext_ellipticcurvelist_length = 0;
    if (ss->tlsext_ellipticcurvelist != NULL)
        OPENSSL_free(ss->tlsext_ellipticcurvelist);
# endif                         /* OPENSSL_NO_EC */
#endif
#ifndef OPENSSL_NO_PSK
    if (ss->psk_identity_hint != NULL)
        OPENSSL_free(ss->psk_identity_hint);
    if (ss->psk_identity != NULL)
        OPENSSL_free(ss->psk_identity);
#endif
#ifndef OPENSSL_NO_SRP
    if (ss->srp_username != NULL)
        OPENSSL_free(ss->srp_username);
#endif
    OPENSSL_cleanse(ss, sizeof(*ss));
    OPENSSL_free(ss);
}


int SSL_set_session_ticket_ext(SSL *s, void *ext_data, int ext_len)
{
    if (s->version >= TLS1_VERSION) {
        if (s->tlsext_session_ticket) {
            OPENSSL_free(s->tlsext_session_ticket);
            s->tlsext_session_ticket = NULL;
        }

        s->tlsext_session_ticket =
            OPENSSL_malloc(sizeof(TLS_SESSION_TICKET_EXT) + ext_len);
        if (!s->tlsext_session_ticket) {
            SSLerr(SSL_F_SSL_SET_SESSION_TICKET_EXT, ERR_R_MALLOC_FAILURE);
            return 0;
        }

        if (ext_data) {
            s->tlsext_session_ticket->length = ext_len;
            s->tlsext_session_ticket->data = s->tlsext_session_ticket + 1;
            memcpy(s->tlsext_session_ticket->data, ext_data, ext_len);
        } else {
            s->tlsext_session_ticket->length = 0;
            s->tlsext_session_ticket->data = NULL;
        }

        return 1;
    }

    return 0;
}


int ssl_get_prev_session(SSL *s, unsigned char *session_id, int len,
                         const unsigned char *limit)
{
    /* This is used only by servers. */

    SSL_SESSION *ret = NULL;
    int fatal = 0;
    int try_session_cache = 1;
#ifndef OPENSSL_NO_TLSEXT
    int r;
#endif

    if (len < 0 || len > SSL_MAX_SSL_SESSION_ID_LENGTH)
        goto err;

    if (session_id + len > limit) {
        fatal = 1;
        goto err;
    }

    if (len == 0)
        try_session_cache = 0;

#ifndef OPENSSL_NO_TLSEXT
    /* sets s->tlsext_ticket_expected */
    r = tls1_process_ticket(s, session_id, len, limit, &ret);
    switch (r) {
    case -1:                   /* Error during processing */
        fatal = 1;
        goto err;
    case 0:                    /* No ticket found */
    case 1:                    /* Zero length ticket found */
        break;                  /* Ok to carry on processing session id. */
    case 2:                    /* Ticket found but not decrypted. */
    case 3:                    /* Ticket decrypted, *ret has been set. */
        try_session_cache = 0;
        break;
    default:
        abort();
    }
#endif

    if (try_session_cache &&
        ret == NULL &&
        !(s->session_ctx->session_cache_mode &
          SSL_SESS_CACHE_NO_INTERNAL_LOOKUP)) {
        SSL_SESSION data;
        data.ssl_version = s->version;
        data.session_id_length = len;
        if (len == 0)
            return 0;
        memcpy(data.session_id, session_id, len);
        CRYPTO_r_lock(CRYPTO_LOCK_SSL_CTX);
        ret = lh_SSL_SESSION_retrieve(s->session_ctx->sessions, &data);
        if (ret != NULL) {
            /* don't allow other threads to steal it: */
            CRYPTO_add(&ret->references, 1, CRYPTO_LOCK_SSL_SESSION);
        }
        CRYPTO_r_unlock(CRYPTO_LOCK_SSL_CTX);
        if (ret == NULL)
            s->session_ctx->stats.sess_miss++;
    }

    if (try_session_cache &&
        ret == NULL && s->session_ctx->get_session_cb != NULL) {
        int copy = 1;

        if ((ret = s->session_ctx->get_session_cb(s, session_id, len, &copy))) {
            s->session_ctx->stats.sess_cb_hit++;

            /*
             * Increment reference count now if the session callback asks us
             * to do so (note that if the session structures returned by the
             * callback are shared between threads, it must handle the
             * reference count itself [i.e. copy == 0], or things won't be
             * thread-safe).
             */
            if (copy)
                CRYPTO_add(&ret->references, 1, CRYPTO_LOCK_SSL_SESSION);

            /*
             * Add the externally cached session to the internal cache as
             * well if and only if we are supposed to.
             */
            if (!
                (s->session_ctx->session_cache_mode &
                 SSL_SESS_CACHE_NO_INTERNAL_STORE))
                /*
                 * The following should not return 1, otherwise, things are
                 * very strange
                 */
                SSL_CTX_add_session(s->session_ctx, ret);
        }
    }

    if (ret == NULL)
        goto err;

    /* Now ret is non-NULL and we own one of its reference counts. */

    if (ret->sid_ctx_length != s->sid_ctx_length
        || memcmp(ret->sid_ctx, s->sid_ctx, ret->sid_ctx_length)) {
        /*
         * We have the session requested by the client, but we don't want to
         * use it in this context.
         */
        goto err;               /* treat like cache miss */
    }

    if ((s->verify_mode & SSL_VERIFY_PEER) && s->sid_ctx_length == 0) {
        /*
         * We can't be sure if this session is being used out of context,
         * which is especially important for SSL_VERIFY_PEER. The application
         * should have used SSL[_CTX]_set_session_id_context. For this error
         * case, we generate an error instead of treating the event like a
         * cache miss (otherwise it would be easy for applications to
         * effectively disable the session cache by accident without anyone
         * noticing).
         */

        SSLerr(SSL_F_SSL_GET_PREV_SESSION,
               SSL_R_SESSION_ID_CONTEXT_UNINITIALIZED);
        fatal = 1;
        goto err;
    }

    if (ret->cipher == NULL) {
        unsigned char buf[5], *p;
        unsigned long l;

        p = buf;
        l = ret->cipher_id;
        l2n(l, p);
        if ((ret->ssl_version >> 8) >= SSL3_VERSION_MAJOR)
            ret->cipher = ssl_get_cipher_by_char(s, &(buf[2]));
        else
            ret->cipher = ssl_get_cipher_by_char(s, &(buf[1]));
        if (ret->cipher == NULL)
            goto err;
    }

    if (ret->timeout < (long)(time(NULL) - ret->time)) { /* timeout */
        s->session_ctx->stats.sess_timeout++;
        if (try_session_cache) {
            /* session was from the cache, so remove it */
            SSL_CTX_remove_session(s->session_ctx, ret);
        }
        goto err;
    }

    s->session_ctx->stats.sess_hit++;

    if (s->session != NULL)
        SSL_SESSION_free(s->session);
    s->session = ret;
    s->verify_result = s->session->verify_result;
    return 1;

 err:
    if (ret != NULL) {
        SSL_SESSION_free(ret);
#ifndef OPENSSL_NO_TLSEXT
        if (!try_session_cache) {
            /*
             * The session was from a ticket, so we should issue a ticket for
             * the new session
             */
            s->tlsext_ticket_expected = 1;
        }
#endif
    }
    if (fatal)
        return -1;
    else
        return 0;
}


int ssl3_get_new_session_ticket(SSL *s)
{
    int ok, al, ret = 0, ticklen;
    long n;
    const unsigned char *p;
    unsigned char *d;

    n = s->method->ssl_get_message(s,
                                   SSL3_ST_CR_SESSION_TICKET_A,
                                   SSL3_ST_CR_SESSION_TICKET_B,
                                   SSL3_MT_NEWSESSION_TICKET, 16384, &ok);

    if (!ok)
        return ((int)n);

    if (n < 6) {
        /* need at least ticket_lifetime_hint + ticket length */
        al = SSL_AD_DECODE_ERROR;
        SSLerr(SSL_F_SSL3_GET_NEW_SESSION_TICKET, SSL_R_LENGTH_MISMATCH);
        goto f_err;
    }

    p = d = (unsigned char *)s->init_msg;

    if (s->session->session_id_length > 0) {
        int i = s->session_ctx->session_cache_mode;
        SSL_SESSION *new_sess;
        /*
         * We reused an existing session, so we need to replace it with a new
         * one
         */
        if (i & SSL_SESS_CACHE_CLIENT) {
            /*
             * Remove the old session from the cache
             */
            if (i & SSL_SESS_CACHE_NO_INTERNAL_STORE) {
                if (s->session_ctx->remove_session_cb != NULL)
                    s->session_ctx->remove_session_cb(s->session_ctx,
                                                      s->session);
            } else {
                /* We carry on if this fails */
                SSL_CTX_remove_session(s->session_ctx, s->session);
            }
        }

        if ((new_sess = ssl_session_dup(s->session, 0)) == 0) {
            al = SSL_AD_INTERNAL_ERROR;
            SSLerr(SSL_F_SSL3_GET_NEW_SESSION_TICKET, ERR_R_MALLOC_FAILURE);
            goto f_err;
        }

        SSL_SESSION_free(s->session);
        s->session = new_sess;
    }

    n2l(p, s->session->tlsext_tick_lifetime_hint);
    n2s(p, ticklen);
    /* ticket_lifetime_hint + ticket_length + ticket */
    if (ticklen + 6 != n) {
        al = SSL_AD_DECODE_ERROR;
        SSLerr(SSL_F_SSL3_GET_NEW_SESSION_TICKET, SSL_R_LENGTH_MISMATCH);
        goto f_err;
    }
    if (s->session->tlsext_tick) {
        OPENSSL_free(s->session->tlsext_tick);
        s->session->tlsext_ticklen = 0;
    }
    s->session->tlsext_tick = OPENSSL_malloc(ticklen);
    if (!s->session->tlsext_tick) {
        SSLerr(SSL_F_SSL3_GET_NEW_SESSION_TICKET, ERR_R_MALLOC_FAILURE);
        goto err;
    }
    memcpy(s->session->tlsext_tick, p, ticklen);
    s->session->tlsext_ticklen = ticklen;
    /*
     * There are two ways to detect a resumed ticket session. One is to set
     * an appropriate session ID and then the server must return a match in
     * ServerHello. This allows the normal client session ID matching to work
     * and we know much earlier that the ticket has been accepted. The
     * other way is to set zero length session ID when the ticket is
     * presented and rely on the handshake to determine session resumption.
     * We choose the former approach because this fits in with assumptions
     * elsewhere in OpenSSL. The session ID is set to the SHA256 (or SHA1 is
     * SHA256 is disabled) hash of the ticket.
     */
    EVP_Digest(p, ticklen,
               s->session->session_id, &s->session->session_id_length,
# ifndef OPENSSL_NO_SHA256
               EVP_sha256(), NULL);
# else
               EVP_sha1(), NULL);
# endif
    ret = 1;
    return (ret);
 f_err:
    ssl3_send_alert(s, SSL3_AL_FATAL, al);
 err:
    s->state = SSL_ST_ERR;
    return (-1);
}


void (*SSL_CTX_sess_get_remove_cb(SSL_CTX *ctx)) (SSL_CTX *ctx,
                                                  SSL_SESSION *sess) {
    return ctx->remove_session_cb;
}


long SSL_SESSION_get_timeout(const SSL_SESSION *s)
{
    if (s == NULL)
        return (0);
    return (s->timeout);
}


SCM_DEFINE (scm_symlink, "symlink", 2, 0, 0,
            (SCM oldpath, SCM newpath),
	    "Create a symbolic link named @var{newpath} with the value\n"
	    "(i.e., pointing to) @var{oldpath}.  The return value is\n"
	    "unspecified.")
#define FUNC_NAME s_scm_symlink
{
  int val;

  STRING2_SYSCALL (oldpath, c_oldpath,
		   newpath, c_newpath,
		   val = symlink (c_oldpath, c_newpath));
  if (val != 0)
    SCM_SYSERROR;
  return SCM_UNSPECIFIED;
}

Remove 'umask' calls from 'mkdir'.

Fixes <http://bugs.gnu.org/24659>.

* libguile/filesys.c (SCM_DEFINE): Remove calls to 'umask' when MODE is
unbound; instead, use 0777 as the mode.  Update docstring to clarify
this.
* doc/ref/posix.texi (File System): Adjust accordingly.
* NEWS: Mention it.


fill_select_type (fd_set *set, SCM *ports_ready, SCM list_or_vec, int pos)
{
  int max_fd = 0;

  if (scm_is_simple_vector (list_or_vec))
    {
      int i = SCM_SIMPLE_VECTOR_LENGTH (list_or_vec);

      while (--i >= 0)
	{
	  int fd = set_element (set, ports_ready,
				SCM_SIMPLE_VECTOR_REF (list_or_vec, i), pos);

	  if (fd > max_fd)
	    max_fd = fd;
	}
    }
  else
    {
      while (!SCM_NULL_OR_NIL_P (list_or_vec))
	{
	  int fd = set_element (set, ports_ready, SCM_CAR (list_or_vec), pos);

	  if (fd > max_fd)
	    max_fd = fd;
	  list_or_vec = SCM_CDR (list_or_vec);
	}
    }

  return max_fd;
}


SCM_DEFINE (scm_chown, "chown", 3, 0, 0,
            (SCM object, SCM owner, SCM group),
	    "Change the ownership and group of the file referred to by @var{object} to\n"
	    "the integer values @var{owner} and @var{group}.  @var{object} can be\n"
	    "a string containing a file name or, if the platform\n"
	    "supports fchown, a port or integer file descriptor\n"
	    "which is open on the file.  The return value\n"
	    "is unspecified.\n\n"
	    "If @var{object} is a symbolic link, either the\n"
	    "ownership of the link or the ownership of the referenced file will be\n"
	    "changed depending on the operating system (lchown is\n"
	    "unsupported at present).  If @var{owner} or @var{group} is specified\n"
	    "as @code{-1}, then that ID is not changed.")
#define FUNC_NAME s_scm_chown
{
  int rv;

  object = SCM_COERCE_OUTPORT (object);

#ifdef HAVE_FCHOWN
  if (scm_is_integer (object) || (SCM_OPFPORTP (object)))
    {
      int fdes = (SCM_OPFPORTP (object)?
		  SCM_FPORT_FDES (object) : scm_to_int (object));

      SCM_SYSCALL (rv = fchown (fdes, scm_to_int (owner), scm_to_int (group)));
    }
  else
#endif
    {
      STRING_SYSCALL (object, c_object,
		      rv = chown (c_object,
				  scm_to_int (owner), scm_to_int (group)));
    }
  if (rv == -1)
    SCM_SYSERROR;
  return SCM_UNSPECIFIED;
}


SCM_DEFINE (scm_delete_file, "delete-file", 1, 0, 0,
           (SCM str),
	    "Deletes (or \"unlinks\") the file specified by @var{str}.")
#define FUNC_NAME s_scm_delete_file
{
  int ans;
  STRING_SYSCALL (str, c_str, ans = unlink (c_str));
  if (ans != 0)
    SCM_SYSERROR;
  return SCM_UNSPECIFIED;
}


SCM_DEFINE (scm_system_file_name_convention,
            "system-file-name-convention", 0, 0, 0, (void),
	    "Return either @code{posix} or @code{windows}, depending on\n"
            "what kind of system this Guile is running on.")
#define FUNC_NAME s_scm_system_file_name_convention
{
  return sym_file_name_convention;
}


set_element (fd_set *set, SCM *ports_ready, SCM element, int pos)
{
  int fd;

  if (scm_is_integer (element))
    {
      fd = scm_to_int (element);
    }
  else
    {
      int use_buf = 0;

      element = SCM_COERCE_OUTPORT (element);
      SCM_ASSERT (SCM_OPFPORTP (element), element, pos, "select");
      if (pos == SCM_ARG1)
	{
	  /* check whether port has buffered input.  */
	  scm_t_port *pt = SCM_PTAB_ENTRY (element);

	  if (pt->read_pos < pt->read_end)
	    use_buf = 1;
	}
      else if (pos == SCM_ARG2)
	{
	  /* check whether port's output buffer has room.  */
	  scm_t_port *pt = SCM_PTAB_ENTRY (element);

	  /* > 1 since writing the last byte in the buffer causes flush.  */
	  if (pt->write_end - pt->write_pos > 1)
	    use_buf = 1;
	}
      fd = use_buf ? -1 : SCM_FPORT_FDES (element);
    }
  if (fd == -1)
    *ports_ready = scm_cons (element, *ports_ready);
  else
    FD_SET (fd, set);
  return fd;
}


SCM_DEFINE (scm_close_fdes, "close-fdes", 1, 0, 0,
            (SCM fd),
	    "A simple wrapper for the @code{close} system call.\n"
	    "Close file descriptor @var{fd}, which must be an integer.\n"
	    "Unlike close (@pxref{Ports and File Descriptors, close}),\n"
	    "the file descriptor will be closed even if a port is using it.\n"
	    "The return value is unspecified.")
#define FUNC_NAME s_scm_close_fdes
{
  int c_fd;
  int rv;

  c_fd = scm_to_int (fd);
  SCM_SYSCALL (rv = close (c_fd));
  if (rv < 0)
    SCM_SYSERROR;
  return SCM_UNSPECIFIED;
}


SCM_DEFINE (scm_canonicalize_path, "canonicalize-path", 1, 0, 0,
            (SCM path),
	    "Return the canonical path of @var{path}. A canonical path has\n"
            "no @code{.} or @code{..} components, nor any repeated path\n"
            "separators (@code{/}) nor symlinks.\n\n"
            "Raises an error if any component of @var{path} does not exist.")
#define FUNC_NAME s_scm_canonicalize_path
{
  char *str, *canon;

  SCM_VALIDATE_STRING (1, path);

  str = scm_to_locale_string (path);
  canon = canonicalize_file_name (str);
  free (str);

  if (canon)
    return scm_take_locale_string (canon);
  else
    SCM_SYSERROR;
}


SCM_DEFINE (scm_open_fdes, "open-fdes", 2, 1, 0,
            (SCM path, SCM flags, SCM mode),
	    "Similar to @code{open} but return a file descriptor instead of\n"
	    "a port.")
#define FUNC_NAME s_scm_open_fdes
{
  int fd;
  int iflags;
  int imode;

  iflags = SCM_NUM2INT (2, flags);
  imode = SCM_NUM2INT_DEF (3, mode, 0666);
  STRING_SYSCALL (path, c_path, fd = open_or_open64 (c_path, iflags, imode));
  if (fd == -1)
    SCM_SYSERROR;
  return scm_from_int (fd);
}


SCM_DEFINE (scm_fsync, "fsync", 1, 0, 0,
            (SCM object),
	    "Copies any unwritten data for the specified output file\n"
	    "descriptor to disk.  If @var{object} is a port, its buffer is\n"
	    "flushed before the underlying file descriptor is fsync'd.\n"
	    "The return value is unspecified.")
#define FUNC_NAME s_scm_fsync
{
  int fdes;

  object = SCM_COERCE_OUTPORT (object);

  if (SCM_OPFPORTP (object))
    {
      scm_flush (object);
      fdes = SCM_FPORT_FDES (object);
    }
  else
    fdes = scm_to_int (object);

  if (fsync (fdes) == -1)
    SCM_SYSERROR;
  return SCM_UNSPECIFIED;
}


scm_stat2scm (struct stat_or_stat64 *stat_temp)
{
  SCM ans = scm_c_make_vector (18, SCM_UNSPECIFIED);

  SCM_SIMPLE_VECTOR_SET(ans, 0, scm_from_ulong (stat_temp->st_dev));
  SCM_SIMPLE_VECTOR_SET(ans, 1, scm_from_ino_t_or_ino64_t (stat_temp->st_ino));
  SCM_SIMPLE_VECTOR_SET(ans, 2, scm_from_ulong (stat_temp->st_mode));
  SCM_SIMPLE_VECTOR_SET(ans, 3, scm_from_ulong (stat_temp->st_nlink));
  SCM_SIMPLE_VECTOR_SET(ans, 4, scm_from_ulong (stat_temp->st_uid));
  SCM_SIMPLE_VECTOR_SET(ans, 5, scm_from_ulong (stat_temp->st_gid));
#ifdef HAVE_STRUCT_STAT_ST_RDEV
  SCM_SIMPLE_VECTOR_SET(ans, 6, scm_from_ulong (stat_temp->st_rdev));
#else
  SCM_SIMPLE_VECTOR_SET(ans, 6, SCM_BOOL_F);
#endif
  SCM_SIMPLE_VECTOR_SET(ans, 7, scm_from_off_t_or_off64_t (stat_temp->st_size));
  SCM_SIMPLE_VECTOR_SET(ans, 8, scm_from_ulong (stat_temp->st_atime));
  SCM_SIMPLE_VECTOR_SET(ans, 9, scm_from_ulong (stat_temp->st_mtime));
  SCM_SIMPLE_VECTOR_SET(ans, 10, scm_from_ulong (stat_temp->st_ctime));
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
  SCM_SIMPLE_VECTOR_SET(ans, 11, scm_from_ulong (stat_temp->st_blksize));
#else
  SCM_SIMPLE_VECTOR_SET(ans, 11, scm_from_ulong (4096L));
#endif
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
  SCM_SIMPLE_VECTOR_SET(ans, 12, scm_from_blkcnt_t_or_blkcnt64_t (stat_temp->st_blocks));
#else
  SCM_SIMPLE_VECTOR_SET(ans, 12, SCM_BOOL_F);
#endif
  {
    int mode = stat_temp->st_mode;

    if (S_ISREG (mode))
      SCM_SIMPLE_VECTOR_SET(ans, 13, scm_sym_regular);
    else if (S_ISDIR (mode))
      SCM_SIMPLE_VECTOR_SET(ans, 13, scm_sym_directory);
#ifdef S_ISLNK
    /* systems without symlinks probably don't have S_ISLNK */
    else if (S_ISLNK (mode))
      SCM_SIMPLE_VECTOR_SET(ans, 13, scm_sym_symlink);
#endif
    else if (S_ISBLK (mode))
      SCM_SIMPLE_VECTOR_SET(ans, 13, scm_sym_block_special);
    else if (S_ISCHR (mode))
      SCM_SIMPLE_VECTOR_SET(ans, 13, scm_sym_char_special);
    else if (S_ISFIFO (mode))
      SCM_SIMPLE_VECTOR_SET(ans, 13, scm_sym_fifo);
#ifdef S_ISSOCK
    else if (S_ISSOCK (mode))
      SCM_SIMPLE_VECTOR_SET(ans, 13, scm_sym_sock);
#endif
    else
      SCM_SIMPLE_VECTOR_SET(ans, 13, scm_sym_unknown);

    SCM_SIMPLE_VECTOR_SET(ans, 14, scm_from_int ((~S_IFMT) & mode));

    /* the layout of the bits in ve[14] is intended to be portable.
       If there are systems that don't follow the usual convention,
       the following could be used:

       tmp = 0;
       if (S_ISUID & mode) tmp += 1;
       tmp <<= 1;
       if (S_IRGRP & mode) tmp += 1;
       tmp <<= 1;
       if (S_ISVTX & mode) tmp += 1;
       tmp <<= 1;
       if (S_IRUSR & mode) tmp += 1;
       tmp <<= 1;
       if (S_IWUSR & mode) tmp += 1;
       tmp <<= 1;
       if (S_IXUSR & mode) tmp += 1;
       tmp <<= 1;
       if (S_IWGRP & mode) tmp += 1;
       tmp <<= 1;
       if (S_IXGRP & mode) tmp += 1;
       tmp <<= 1;
       if (S_IROTH & mode) tmp += 1;
       tmp <<= 1;
       if (S_IWOTH & mode) tmp += 1;
       tmp <<= 1;
       if (S_IXOTH & mode) tmp += 1;

       SCM_SIMPLE_VECTOR_SET(ans, 14, scm_from_int (tmp));

       */
  }
#ifdef HAVE_STRUCT_STAT_ST_ATIM
  SCM_SIMPLE_VECTOR_SET(ans, 15, scm_from_long (stat_temp->st_atim.tv_nsec));
#else
  SCM_SIMPLE_VECTOR_SET(ans, 15, SCM_I_MAKINUM (0));
#endif
#ifdef HAVE_STRUCT_STAT_ST_MTIM
  SCM_SIMPLE_VECTOR_SET(ans, 16, scm_from_long (stat_temp->st_mtim.tv_nsec));
#else
  SCM_SIMPLE_VECTOR_SET(ans, 16, SCM_I_MAKINUM (0));
#endif
#ifdef HAVE_STRUCT_STAT_ST_CTIM
  SCM_SIMPLE_VECTOR_SET(ans, 17, scm_from_ulong (stat_temp->st_ctim.tv_sec));
#else
  SCM_SIMPLE_VECTOR_SET(ans, 17, SCM_I_MAKINUM (0));
#endif

  return ans;
}


SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0,
            (SCM path),
	    "Return the value of the symbolic link named by @var{path} (a\n"
	    "string), i.e., the file that the link points to.")
#define FUNC_NAME s_scm_readlink
{
  int rv;
  int size = 100;
  char *buf;
  SCM result;
  char *c_path;

  scm_dynwind_begin (0);

  c_path = scm_to_locale_string (path);
  scm_dynwind_free (c_path);

  buf = scm_malloc (size);

  while ((rv = readlink (c_path, buf, size)) == size)
    {
      free (buf);
      size *= 2;
      buf = scm_malloc (size);
    }
  if (rv == -1)
    {
      int save_errno = errno;
      free (buf);
      errno = save_errno;
      SCM_SYSERROR;
    }
  result = scm_take_locale_stringn (buf, rv);

  scm_dynwind_end ();
  return result;
}


SCM_DEFINE (scm_dirname, "dirname", 1, 0, 0,
            (SCM filename),
	    "Return the directory name component of the file name\n"
	    "@var{filename}. If @var{filename} does not contain a directory\n"
	    "component, @code{.} is returned.")
#define FUNC_NAME s_scm_dirname
{
  char *c_filename, *c_dirname;
  SCM res;

  scm_dynwind_begin (0);
  c_filename = scm_to_utf8_string (filename);
  scm_dynwind_free (c_filename);

  c_dirname = mdir_name (c_filename);
  if (!c_dirname)
    SCM_SYSERROR;
  scm_dynwind_free (c_dirname);

  res = scm_from_utf8_string (c_dirname);
  scm_dynwind_end ();

  return res;
}


SCM_DEFINE (scm_fcntl, "fcntl", 2, 1, 0,
            (SCM object, SCM cmd, SCM value),
	    "Apply @var{cmd} to the specified file descriptor or the underlying\n"
	    "file descriptor of the specified port.  @var{value} is an optional\n"
	    "integer argument.\n\n"
	    "Values for @var{cmd} are:\n\n"
	    "@table @code\n"
	    "@item F_DUPFD\n"
	    "Duplicate a file descriptor\n"
	    "@item F_GETFD\n"
	    "Get flags associated with the file descriptor.\n"
	    "@item F_SETFD\n"
	    "Set flags associated with the file descriptor to @var{value}.\n"
	    "@item F_GETFL\n"
	    "Get flags associated with the open file.\n"
	    "@item F_SETFL\n"
	    "Set flags associated with the open file to @var{value}\n"
	    "@item F_GETOWN\n"
	    "Get the process ID of a socket's owner, for @code{SIGIO} signals.\n"
	    "@item F_SETOWN\n"
	    "Set the process that owns a socket to @var{value}, for @code{SIGIO} signals.\n"
	    "@item FD_CLOEXEC\n"
	    "The value used to indicate the \"close on exec\" flag with @code{F_GETFL} or\n"
	    "@code{F_SETFL}.\n"
	    "@end table")
#define FUNC_NAME s_scm_fcntl
{
  int rv;
  int fdes;
  int ivalue;

  object = SCM_COERCE_OUTPORT (object);

  if (SCM_OPFPORTP (object))
    fdes = SCM_FPORT_FDES (object);
  else
    fdes = scm_to_int (object);

  if (SCM_UNBNDP (value))
    ivalue = 0;
  else
    ivalue = scm_to_int (value);

  SCM_SYSCALL (rv = fcntl (fdes, scm_to_int (cmd), ivalue));
  if (rv == -1)
    SCM_SYSERROR;
  return scm_from_int (rv);
}


get_element (fd_set *set, SCM element, SCM list)
{
  int fd;

  if (scm_is_integer (element))
    {
      fd = scm_to_int (element);
    }
  else
    {
      fd = SCM_FPORT_FDES (SCM_COERCE_OUTPORT (element));
    }
  if (FD_ISSET (fd, set))
    list = scm_cons (element, list);
  return list;
}


SCM_DEFINE (scm_umask, "umask", 0, 1, 0,
            (SCM mode),
	    "If @var{mode} is omitted, returns a decimal number representing the current\n"
	    "file creation mask.  Otherwise the file creation mask is set to\n"
	    "@var{mode} and the previous value is returned.\n\n"
	    "E.g., @code{(umask #o022)} sets the mask to octal 22, decimal 18.")
#define FUNC_NAME s_scm_umask
{
  mode_t mask;
  if (SCM_UNBNDP (mode))
    {
      mask = umask (0);
      umask (mask);
    }
  else
    {
      mask = umask (scm_to_uint (mode));
    }
  return scm_from_uint (mask);
}


scm_init_filesys ()
{
#ifdef HAVE_POSIX
  scm_tc16_dir = scm_make_smob_type ("directory", 0);
  scm_set_smob_free (scm_tc16_dir, scm_dir_free);
  scm_set_smob_print (scm_tc16_dir, scm_dir_print);

#ifdef O_RDONLY
  scm_c_define ("O_RDONLY", scm_from_int (O_RDONLY));
#endif
#ifdef O_WRONLY
  scm_c_define ("O_WRONLY", scm_from_int (O_WRONLY));
#endif
#ifdef O_RDWR
  scm_c_define ("O_RDWR", scm_from_int (O_RDWR));
#endif
#ifdef O_CREAT
  scm_c_define ("O_CREAT", scm_from_int (O_CREAT));
#endif
#ifdef O_EXCL
  scm_c_define ("O_EXCL", scm_from_int (O_EXCL));
#endif
#ifdef O_NOCTTY
  scm_c_define ("O_NOCTTY", scm_from_int (O_NOCTTY));
#endif
#ifdef O_TRUNC
  scm_c_define ("O_TRUNC", scm_from_int (O_TRUNC));
#endif
#ifdef O_APPEND
  scm_c_define ("O_APPEND", scm_from_int (O_APPEND));
#endif
#ifdef O_NONBLOCK
  scm_c_define ("O_NONBLOCK", scm_from_int (O_NONBLOCK));
#endif
#ifdef O_NDELAY
  scm_c_define ("O_NDELAY", scm_from_int (O_NDELAY));
#endif
#ifdef O_SYNC
  scm_c_define ("O_SYNC", scm_from_int (O_SYNC));
#endif
#ifdef O_LARGEFILE
  scm_c_define ("O_LARGEFILE", scm_from_int (O_LARGEFILE));
#endif
#ifdef O_NOTRANS
  scm_c_define ("O_NOTRANS", scm_from_int (O_NOTRANS));
#endif

#ifdef F_DUPFD
  scm_c_define ("F_DUPFD", scm_from_int (F_DUPFD));
#endif
#ifdef F_GETFD
  scm_c_define ("F_GETFD", scm_from_int (F_GETFD));
#endif
#ifdef F_SETFD
  scm_c_define ("F_SETFD", scm_from_int (F_SETFD));
#endif
#ifdef F_GETFL
  scm_c_define ("F_GETFL", scm_from_int (F_GETFL));
#endif
#ifdef F_SETFL
  scm_c_define ("F_SETFL", scm_from_int (F_SETFL));
#endif
#ifdef F_GETOWN
  scm_c_define ("F_GETOWN", scm_from_int (F_GETOWN));
#endif
#ifdef F_SETOWN
  scm_c_define ("F_SETOWN", scm_from_int (F_SETOWN));
#endif
#ifdef FD_CLOEXEC
  scm_c_define ("FD_CLOEXEC", scm_from_int (FD_CLOEXEC));
#endif
#endif /* HAVE_POSIX */

  /* `access' symbols.  */
  scm_c_define ("R_OK", scm_from_int (R_OK));
  scm_c_define ("W_OK", scm_from_int (W_OK));
  scm_c_define ("X_OK", scm_from_int (X_OK));
  scm_c_define ("F_OK", scm_from_int (F_OK));

  scm_dot_string = scm_from_locale_string (".");

#include "libguile/filesys.x"
}


SCM_DEFINE (scm_rewinddir, "rewinddir", 1, 0, 0,
	    (SCM port),
	    "Reset the directory port @var{port} so that the next call to\n"
	    "@code{readdir} will return the first directory entry.")
#define FUNC_NAME s_scm_rewinddir
{
  SCM_VALIDATE_DIR (1, port);
  if (!SCM_DIR_OPEN_P (port))
    SCM_MISC_ERROR ("Directory ~S is not open.", scm_list_1 (port));

  rewinddir ((DIR *) SCM_SMOB_DATA_1 (port));

  return SCM_UNSPECIFIED;
}


SCM_DEFINE (scm_mkdir, "mkdir", 1, 1, 0,
            (SCM path, SCM mode),
	    "Create a new directory named by @var{path}.  If @var{mode} is omitted\n"
	    "then the permissions of the directory are set to @code{#o777}\n"
	    "masked with the current umask (@pxref{Processes, @code{umask}}).\n"
	    "Otherwise they are set to the value specified with @var{mode}.\n"
	    "The return value is unspecified.")
#define FUNC_NAME s_scm_mkdir
{
  int rv;
  mode_t c_mode;

  c_mode = SCM_UNBNDP (mode) ? 0777 : scm_to_uint (mode);

  STRING_SYSCALL (path, c_path, rv = mkdir (c_path, c_mode));
  if (rv != 0)
    SCM_SYSERROR;

  return SCM_UNSPECIFIED;
}


SCM_DEFINE (scm_rename, "rename-file", 2, 0, 0,
            (SCM oldname, SCM newname),
	    "Renames the file specified by @var{oldname} to @var{newname}.\n"
	    "The return value is unspecified.")
#define FUNC_NAME s_scm_rename
{
  int rv;

  STRING2_SYSCALL (oldname, c_oldname,
		   newname, c_newname,
		   rv = rename (c_oldname, c_newname));
  if (rv != 0)
    SCM_SYSERROR;
  return SCM_UNSPECIFIED;
}


scm_mkstemp (SCM tmpl)
{
  return scm_i_mkstemp (tmpl, SCM_UNDEFINED);
}


scm_dir_free (SCM p)
{
  if (SCM_DIR_OPEN_P (p))
    closedir ((DIR *) SCM_SMOB_DATA_1 (p));
  return 0;
}


SCM_DEFINE (scm_lstat, "lstat", 1, 0, 0,
            (SCM str),
	    "Similar to @code{stat}, but does not follow symbolic links, i.e.,\n"
	    "it will return information about a symbolic link itself, not the\n"
	    "file it points to.  @var{str} must be a string.")
#define FUNC_NAME s_scm_lstat
{
  int rv;
  struct stat_or_stat64 stat_temp;

  STRING_SYSCALL (str, c_str, rv = lstat_or_lstat64 (c_str, &stat_temp));
  if (rv != 0)
    {
      int en = errno;

      SCM_SYSERROR_MSG ("~A: ~S",
			scm_list_2 (scm_strerror (scm_from_int (en)), str),
			en);
    }
  return scm_stat2scm (&stat_temp);
}


SCM_DEFINE (scm_getcwd, "getcwd", 0, 0, 0,
            (),
	    "Return the name of the current working directory.")
#define FUNC_NAME s_scm_getcwd
{
  char *rv;
  size_t size = 100;
  char *wd;
  SCM result;

  wd = scm_malloc (size);
  while ((rv = getcwd (wd, size)) == 0 && errno == ERANGE)
    {
      free (wd);
      size *= 2;
      wd = scm_malloc (size);
    }
  if (rv == 0)
    {
      int save_errno = errno;
      free (wd);
      errno = save_errno;
      SCM_SYSERROR;
    }
  /* On Windows, convert backslashes in current directory to forward
     slashes.  */
  scm_i_mirror_backslashes (wd);
  result = scm_from_locale_stringn (wd, strlen (wd));
  free (wd);
  return result;
}


SCM_DEFINE (scm_open, "open", 2, 1, 0,
            (SCM path, SCM flags, SCM mode),
	    "Open the file named by @var{path} for reading and/or writing.\n"
	    "@var{flags} is an integer specifying how the file should be opened.\n"
	    "@var{mode} is an integer specifying the permission bits of the file, if\n"
	    "it needs to be created, before the umask is applied.  The default is 666\n"
	    "(Unix itself has no default).\n\n"
	    "@var{flags} can be constructed by combining variables using @code{logior}.\n"
	    "Basic flags are:\n\n"
	    "@defvar O_RDONLY\n"
	    "Open the file read-only.\n"
	    "@end defvar\n"
	    "@defvar O_WRONLY\n"
	    "Open the file write-only.\n"
	    "@end defvar\n"
	    "@defvar O_RDWR\n"
	    "Open the file read/write.\n"
	    "@end defvar\n"
	    "@defvar O_APPEND\n"
	    "Append to the file instead of truncating.\n"
	    "@end defvar\n"
	    "@defvar O_CREAT\n"
	    "Create the file if it does not already exist.\n"
	    "@end defvar\n\n"
	    "See the Unix documentation of the @code{open} system call\n"
	    "for additional flags.")
#define FUNC_NAME s_scm_open
{
  SCM newpt;
  char *port_mode;
  int fd;
  int iflags;

  fd = scm_to_int (scm_open_fdes (path, flags, mode));
  iflags = SCM_NUM2INT (2, flags);

  if ((iflags & O_RDWR) == O_RDWR)
    {
      /* Opened read-write.  */
      if (iflags & O_APPEND)
	port_mode = "a+";
      else if (iflags & O_CREAT)
	port_mode = "w+";
      else
	port_mode = "r+";
    }
  else
    {
      /* Opened read-only or write-only.  */
      if (iflags & O_APPEND)
	port_mode = "a";
      else if (iflags & O_WRONLY)
	port_mode = "w";
      else
	port_mode = "r";
    }

  newpt = scm_fdes_to_port (fd, port_mode, path);
  return newpt;
}


SCM_DEFINE (scm_readdir, "readdir", 1, 0, 0,
	    (SCM port),
	    "Return (as a string) the next directory entry from the directory stream\n"
	    "@var{port}.  If there is no remaining entry to be read then the\n"
	    "end of file object is returned.")
#define FUNC_NAME s_scm_readdir
{
  struct dirent_or_dirent64 *rdent;

  SCM_VALIDATE_DIR (1, port);
  if (!SCM_DIR_OPEN_P (port))
    SCM_MISC_ERROR ("Directory ~S is not open.", scm_list_1 (port));

#if HAVE_READDIR_R
  /* As noted in the glibc manual, on various systems (such as Solaris) the
     d_name[] field is only 1 char and you're expected to size the dirent
     buffer for readdir_r based on NAME_MAX.  The SCM_MAX expressions below
     effectively give either sizeof(d_name) or NAME_MAX+1, whichever is
     bigger.

     On solaris 10 there's no NAME_MAX constant, it's necessary to use
     pathconf().  We prefer NAME_MAX though, since it should be a constant
     and will therefore save a system call.  We also prefer it since dirfd()
     is not available everywhere.

     An alternative to dirfd() would be to open() the directory and then use
     fdopendir(), if the latter is available.  That'd let us hold the fd
     somewhere in the smob, or just the dirent size calculated once.  */
  {
    struct dirent_or_dirent64 de; /* just for sizeof */
    DIR    *ds = (DIR *) SCM_SMOB_DATA_1 (port);
#ifdef NAME_MAX
    char   buf [SCM_MAX (sizeof (de),
			 sizeof (de) - sizeof (de.d_name) + NAME_MAX + 1)];
#else
    char   *buf;
    long   name_max = fpathconf (dirfd (ds), _PC_NAME_MAX);
    if (name_max == -1)
      SCM_SYSERROR;
    buf = alloca (SCM_MAX (sizeof (de),
			   sizeof (de) - sizeof (de.d_name) + name_max + 1));
#endif

    errno = 0;
    SCM_SYSCALL (readdir_r_or_readdir64_r (ds, (struct dirent_or_dirent64 *) buf, &rdent));
    if (errno != 0)
      SCM_SYSERROR;
    if (! rdent)
      return SCM_EOF_VAL;

    return (rdent ? scm_from_locale_stringn (rdent->d_name, NAMLEN (rdent))
	    : SCM_EOF_VAL);
  }
#else
  {
    SCM ret;
    scm_dynwind_begin (0);
    scm_i_dynwind_pthread_mutex_lock (&scm_i_misc_mutex);

    errno = 0;
    SCM_SYSCALL (rdent = readdir_or_readdir64 ((DIR *) SCM_SMOB_DATA_1 (port)));
    if (errno != 0)
      SCM_SYSERROR;

    ret = (rdent ? scm_from_locale_stringn (rdent->d_name, NAMLEN (rdent))
	   : SCM_EOF_VAL);

    scm_dynwind_end ();
    return ret;
  }
#endif
}


SCM_DEFINE (scm_link, "link", 2, 0, 0,
            (SCM oldpath, SCM newpath),
	    "Creates a new name @var{newpath} in the file system for the\n"
	    "file named by @var{oldpath}.  If @var{oldpath} is a symbolic\n"
	    "link, the link may or may not be followed depending on the\n"
	    "system.")
#define FUNC_NAME s_scm_link
{
  int val;

  STRING2_SYSCALL (oldpath, c_oldpath,
		   newpath, c_newpath,
		   val = link (c_oldpath, c_newpath));
  if (val != 0)
    SCM_SYSERROR;
  return SCM_UNSPECIFIED;
}


SCM_DEFINE (scm_closedir, "closedir", 1, 0, 0,
	    (SCM port),
	    "Close the directory stream @var{port}.\n"
	    "The return value is unspecified.")
#define FUNC_NAME s_scm_closedir
{
  SCM_VALIDATE_DIR (1, port);

  if (SCM_DIR_OPEN_P (port))
    {
      int sts;

      SCM_SYSCALL (sts = closedir ((DIR *) SCM_SMOB_DATA_1 (port)));
      if (sts != 0)
	SCM_SYSERROR;

      SCM_SET_SMOB_DATA_0 (port, scm_tc16_dir);
    }

  return SCM_UNSPECIFIED;
}


SCM_DEFINE (scm_opendir, "opendir", 1, 0, 0,
	    (SCM dirname),
	    "Open the directory specified by @var{dirname} and return a directory\n"
	    "stream.")
#define FUNC_NAME s_scm_opendir
{
  DIR *ds;
  STRING_SYSCALL (dirname, c_dirname, ds = opendir (c_dirname));
  if (ds == NULL)
    SCM_SYSERROR;
  SCM_RETURN_NEWSMOB (scm_tc16_dir | (SCM_DIR_FLAG_OPEN<<16), ds);
}


SCM_DEFINE (scm_chdir, "chdir", 1, 0, 0,
            (SCM str),
	    "Change the current working directory to @var{str}.\n"
	    "The return value is unspecified.")
#define FUNC_NAME s_scm_chdir
{
  int ans;

  STRING_SYSCALL (str, c_str, ans = chdir (c_str));
  if (ans != 0)
    SCM_SYSERROR;
  return SCM_UNSPECIFIED;
}


SCM_DEFINE (scm_access, "access?", 2, 0, 0,
            (SCM path, SCM how),
	    "Test accessibility of a file under the real UID and GID of the\n"
	    "calling process.  The return is @code{#t} if @var{path} exists\n"
	    "and the permissions requested by @var{how} are all allowed, or\n"
	    "@code{#f} if not.\n"
	    "\n"
	    "@var{how} is an integer which is one of the following values,\n"
	    "or a bitwise-OR (@code{logior}) of multiple values.\n"
	    "\n"
	    "@defvar R_OK\n"
	    "Test for read permission.\n"
	    "@end defvar\n"
	    "@defvar W_OK\n"
	    "Test for write permission.\n"
	    "@end defvar\n"
	    "@defvar X_OK\n"
	    "Test for execute permission.\n"
	    "@end defvar\n"
	    "@defvar F_OK\n"
	    "Test for existence of the file.  This is implied by each of the\n"
	    "other tests, so there's no need to combine it with them.\n"
	    "@end defvar\n"
	    "\n"
	    "It's important to note that @code{access?} does not simply\n"
	    "indicate what will happen on attempting to read or write a\n"
	    "file.  In normal circumstances it does, but in a set-UID or\n"
	    "set-GID program it doesn't because @code{access?} tests the\n"
	    "real ID, whereas an open or execute attempt uses the effective\n"
	    "ID.\n"
	    "\n"
	    "A program which will never run set-UID/GID can ignore the\n"
	    "difference between real and effective IDs, but for maximum\n"
	    "generality, especially in library functions, it's best not to\n"
	    "use @code{access?} to predict the result of an open or execute,\n"
	    "instead simply attempt that and catch any exception.\n"
	    "\n"
	    "The main use for @code{access?} is to let a set-UID/GID program\n"
	    "determine what the invoking user would have been allowed to do,\n"
	    "without the greater (or perhaps lesser) privileges afforded by\n"
	    "the effective ID.  For more on this, see ``Testing File\n"
	    "Access'' in The GNU C Library Reference Manual.")
#define FUNC_NAME s_scm_access
{
  int rv;
  char *c_path;

  c_path = scm_to_locale_string (path);
  rv = access (c_path, scm_to_int (how));
  free (c_path);

  return scm_from_bool (!rv);
}


SCM_DEFINE (scm_close, "close", 1, 0, 0,
            (SCM fd_or_port),
	    "Similar to close-port (@pxref{Closing, close-port}),\n"
	    "but also works on file descriptors.  A side\n"
	    "effect of closing a file descriptor is that any ports using that file\n"
	    "descriptor are moved to a different file descriptor and have\n"
	    "their revealed counts set to zero.")
#define FUNC_NAME s_scm_close
{
  int rv;
  int fd;

  fd_or_port = SCM_COERCE_OUTPORT (fd_or_port);

  if (SCM_PORTP (fd_or_port))
    return scm_close_port (fd_or_port);
  fd = scm_to_int (fd_or_port);
  scm_evict_ports (fd);		/* see scsh manual.  */
  SCM_SYSCALL (rv = close (fd));
  /* following scsh, closing an already closed file descriptor is
     not an error.  */
  if (rv < 0 && errno != EBADF)
    SCM_SYSERROR;
  return scm_from_bool (rv >= 0);
}


is_file_name_separator (SCM c)
{
  if (scm_is_eq (c, SCM_MAKE_CHAR ('/')))
    return 1;
#ifdef __MINGW32__
  if (scm_is_eq (c, SCM_MAKE_CHAR ('\\')))
    return 1;
#endif
  return 0;
}


SCM_DEFINE (scm_copy_file, "copy-file", 2, 0, 0,
            (SCM oldfile, SCM newfile),
	    "Copy the file specified by @var{oldfile} to @var{newfile}.\n"
	    "The return value is unspecified.")
#define FUNC_NAME s_scm_copy_file
{
  char *c_oldfile, *c_newfile;
  int oldfd, newfd;
  int n, rv;
  char buf[BUFSIZ];
  struct stat_or_stat64 oldstat;

  scm_dynwind_begin (0);

  c_oldfile = scm_to_locale_string (oldfile);
  scm_dynwind_free (c_oldfile);
  c_newfile = scm_to_locale_string (newfile);
  scm_dynwind_free (c_newfile);

  oldfd = open_or_open64 (c_oldfile, O_RDONLY | O_BINARY);
  if (oldfd == -1)
    SCM_SYSERROR;

  SCM_SYSCALL (rv = fstat_or_fstat64 (oldfd, &oldstat));
  if (rv == -1)
    goto err_close_oldfd;

  /* use POSIX flags instead of 07777?.  */
  newfd = open_or_open64 (c_newfile, O_WRONLY | O_CREAT | O_TRUNC,
                          oldstat.st_mode & 07777);
  if (newfd == -1)
    {
    err_close_oldfd:
      close (oldfd);
      SCM_SYSERROR;
    }

  while ((n = read (oldfd, buf, sizeof buf)) > 0)
    if (write (newfd, buf, n) != n)
      {
	close (oldfd);
	close (newfd);
	SCM_SYSERROR;
      }
  close (oldfd);
  if (close (newfd) == -1)
    SCM_SYSERROR;

  scm_dynwind_end ();
  return SCM_UNSPECIFIED;
}


SCM_DEFINE (scm_sendfile, "sendfile", 3, 1, 0,
	    (SCM out, SCM in, SCM count, SCM offset),
	    "Send @var{count} bytes from @var{in} to @var{out}, both of which "
	    "must be either open file ports or file descriptors.  When "
	    "@var{offset} is omitted, start reading from @var{in}'s current "
	    "position; otherwise, start reading at @var{offset}.  Return "
	    "the number of bytes actually sent.")
#define FUNC_NAME s_scm_sendfile
{
#define VALIDATE_FD_OR_PORT(cvar, svar, pos)	\
  if (scm_is_integer (svar))			\
    cvar = scm_to_int (svar);			\
  else						\
    {						\
      SCM_VALIDATE_OPFPORT (pos, svar);		\
      scm_flush (svar);				\
      cvar = SCM_FPORT_FDES (svar);		\
    }

  ssize_t result SCM_UNUSED;
  size_t c_count, total = 0;
  scm_t_off c_offset;
  int in_fd, out_fd;

  VALIDATE_FD_OR_PORT (out_fd, out, 1);
  VALIDATE_FD_OR_PORT (in_fd, in, 2);
  c_count = scm_to_size_t (count);
  c_offset = SCM_UNBNDP (offset) ? 0 : scm_to_off_t (offset);

#if defined HAVE_SYS_SENDFILE_H && defined HAVE_SENDFILE
  /* The Linux-style sendfile(2), which is different from the BSD-style.  */

  {
    off_t *offset_ptr;

    offset_ptr = SCM_UNBNDP (offset) ? NULL : &c_offset;

    /* On Linux, when OUT_FD is a file, everything is transferred at once and
       RESULT == C_COUNT.  However, when OUT_FD is a pipe or other "slow"
       device, fewer bytes may be transferred, hence the loop.  RESULT == 0
       means EOF on IN_FD, so leave the loop in that case.  */
    do
      {
	result = sendfile_or_sendfile64 (out_fd, in_fd, offset_ptr,
					 c_count - total);
	if (result > 0)
	  /* At this point, either OFFSET_PTR is non-NULL and it has been
	     updated to the current offset in IN_FD, or it is NULL and IN_FD's
	     offset has been updated.  */
	  total += result;
	else if (result < 0 && (errno == EINTR || errno == EAGAIN))
	  /* Keep going.  */
	  result = 1;
      }
    while (total < c_count && result > 0);
  }

  /* Quoting the Linux man page: "In Linux kernels before 2.6.33, out_fd
     must refer to a socket.  Since Linux 2.6.33 it can be any file."
     Fall back to read(2) and write(2) when such an error occurs.  */
  if (result < 0 && errno != EINVAL && errno != ENOSYS)
    SCM_SYSERROR;
  else if (result < 0)
#endif
  {
    char buf[8192];
    size_t left;
    int reached_eof = 0;

    if (!SCM_UNBNDP (offset))
      {
	if (SCM_PORTP (in))
	  scm_seek (in, scm_from_off_t (c_offset), scm_from_int (SEEK_SET));
	else
	  {
	    if (lseek_or_lseek64 (in_fd, c_offset, SEEK_SET) < 0)
	      SCM_SYSERROR;
	  }
      }

    for (total = 0, left = c_count; total < c_count && !reached_eof; )
      {
	size_t asked, obtained, written;

	asked = SCM_MIN (sizeof buf, left);
	obtained = full_read (in_fd, buf, asked);
	if (obtained < asked)
          {
            if (errno == 0)
              reached_eof = 1;
            else
              SCM_SYSERROR;
          }

	left -= obtained;

	written = full_write (out_fd, buf, obtained);
	if (written < obtained)
	  SCM_SYSERROR;

	total += written;
      }

  }

  return scm_from_size_t (total);

#undef VALIDATE_FD_OR_PORT
}


SCM_DEFINE (scm_directory_stream_p, "directory-stream?", 1, 0, 0,
	    (SCM obj),
	    "Return a boolean indicating whether @var{obj} is a directory\n"
	    "stream as returned by @code{opendir}.")
#define FUNC_NAME s_scm_directory_stream_p
{
  return scm_from_bool (SCM_DIRP (obj));
}


SCM_DEFINE (scm_chmod, "chmod", 2, 0, 0,
            (SCM object, SCM mode),
	    "Changes the permissions of the file referred to by\n"
	    "@var{object}.  @var{object} can be a string containing a file\n"
	    "name or a port or integer file descriptor which is open on a\n"
	    "file (in which case @code{fchmod} is used as the underlying\n"
	    "system call).  @var{mode} specifies the new permissions as a\n"
	    "decimal number, e.g., @code{(chmod \"foo\" #o755)}.\n"
	    "The return value is unspecified.")
#define FUNC_NAME s_scm_chmod
{
  int rv;

  object = SCM_COERCE_OUTPORT (object);

#if HAVE_FCHMOD
  if (scm_is_integer (object) || SCM_OPFPORTP (object))
    {
      int fdes;
      if (scm_is_integer (object))
	fdes = scm_to_int (object);
      else
	fdes = SCM_FPORT_FDES (object);
      SCM_SYSCALL (rv = fchmod (fdes, scm_to_int (mode)));
    }
  else
#endif
    {
      STRING_SYSCALL (object, c_object,
		      rv = chmod (c_object, scm_to_int (mode)));
    }
  if (rv == -1)
    SCM_SYSERROR;
  return SCM_UNSPECIFIED;
}


SCM_DEFINE (scm_i_mkstemp, "mkstemp!", 1, 1, 0,
	    (SCM tmpl, SCM mode),
	    "Create a new unique file in the file system and return a new\n"
	    "buffered port open for reading and writing to the file.\n"
	    "\n"
	    "@var{tmpl} is a string specifying where the file should be\n"
	    "created: it must end with @samp{XXXXXX} and those @samp{X}s\n"
	    "will be changed in the string to return the name of the file.\n"
	    "(@code{port-filename} on the port also gives the name.)\n"
	    "\n"
	    "POSIX doesn't specify the permissions mode of the file, on GNU\n"
	    "and most systems it's @code{#o600}.  An application can use\n"
	    "@code{chmod} to relax that if desired.  For example\n"
	    "@code{#o666} less @code{umask}, which is usual for ordinary\n"
	    "file creation,\n"
	    "\n"
	    "@example\n"
	    "(let ((port (mkstemp! (string-copy \"/tmp/myfile-XXXXXX\"))))\n"
	    "  (chmod port (logand #o666 (lognot (umask))))\n"
	    "  ...)\n"
	    "@end example\n"
            "\n"
            "The optional @var{mode} argument specifies a mode, as a string\n"
            "in the same format that @code{open-file} takes.  It defaults\n"
            "to @code{\"w+\"}.")
#define FUNC_NAME s_scm_i_mkstemp
{
  char *c_tmpl;
  long mode_bits;
  int rv;
  int open_flags, is_binary;
  SCM port;

  scm_dynwind_begin (0);

  c_tmpl = scm_to_locale_string (tmpl);
  scm_dynwind_free (c_tmpl);
  if (SCM_UNBNDP (mode))
    {
      /* mkostemp will create a read/write file and add on additional
         flags; open_flags just adjoins flags to that set.  */
      open_flags = 0;
      is_binary = 0;
      mode_bits = SCM_OPN | SCM_RDNG | SCM_WRTNG;
    }
  else
    {
      open_flags = scm_i_mode_to_open_flags (mode, &is_binary, FUNC_NAME);
      mode_bits = scm_i_mode_bits (mode);
    }

  SCM_SYSCALL (rv = mkostemp (c_tmpl, open_flags));
  if (rv == -1)
    SCM_SYSERROR;

  scm_substring_move_x (scm_from_locale_string (c_tmpl),
			SCM_INUM0, scm_string_length (tmpl),
			tmpl, SCM_INUM0);

  scm_dynwind_end ();

  port = scm_i_fdes_to_port (rv, mode_bits, tmpl);
  if (is_binary)
    /* Use the binary-friendly ISO-8859-1 encoding. */
    scm_i_set_port_encoding_x (port, NULL);

  return port;
}


SCM_DEFINE (scm_stat, "stat", 1, 1, 0,
            (SCM object, SCM exception_on_error),
	    "Return an object containing various information about the file\n"
	    "determined by @var{object}.  @var{object} can be a string containing\n"
	    "a file name or a port or integer file descriptor which is open\n"
	    "on a file (in which case @code{fstat} is used as the underlying\n"
	    "system call).\n"
	    "\n"
            "If the optional @var{exception_on_error} argument is true, which\n"
            "is the default, an exception will be raised if the underlying\n"
            "system call returns an error, for example if the file is not\n"
            "found or is not readable. Otherwise, an error will cause\n"
            "@code{stat} to return @code{#f}."
	    "\n"
	    "The object returned by a successful call to @code{stat} can be\n"
            "passed as a single parameter to the following procedures, all of\n"
            "which return integers:\n"
	    "\n"
	    "@table @code\n"
	    "@item stat:dev\n"
	    "The device containing the file.\n"
	    "@item stat:ino\n"
	    "The file serial number, which distinguishes this file from all\n"
	    "other files on the same device.\n"
	    "@item stat:mode\n"
	    "The mode of the file.  This includes file type information and\n"
	    "the file permission bits.  See @code{stat:type} and\n"
	    "@code{stat:perms} below.\n"
	    "@item stat:nlink\n"
	    "The number of hard links to the file.\n"
	    "@item stat:uid\n"
	    "The user ID of the file's owner.\n"
	    "@item stat:gid\n"
	    "The group ID of the file.\n"
	    "@item stat:rdev\n"
	    "Device ID; this entry is defined only for character or block\n"
	    "special files.\n"
	    "@item stat:size\n"
	    "The size of a regular file in bytes.\n"
	    "@item stat:atime\n"
	    "The last access time for the file.\n"
	    "@item stat:mtime\n"
	    "The last modification time for the file.\n"
	    "@item stat:ctime\n"
	    "The last modification time for the attributes of the file.\n"
	    "@item stat:blksize\n"
	    "The optimal block size for reading or writing the file, in\n"
	    "bytes.\n"
	    "@item stat:blocks\n"
	    "The amount of disk space that the file occupies measured in\n"
	    "units of 512 byte blocks.\n"
	    "@end table\n"
	    "\n"
	    "In addition, the following procedures return the information\n"
	    "from stat:mode in a more convenient form:\n"
	    "\n"
	    "@table @code\n"
	    "@item stat:type\n"
	    "A symbol representing the type of file.  Possible values are\n"
	    "regular, directory, symlink, block-special, char-special, fifo,\n"
	    "socket and unknown\n"
	    "@item stat:perms\n"
	    "An integer representing the access permission bits.\n"
	    "@end table")
#define FUNC_NAME s_scm_stat
{
  int rv;
  int fdes;
  struct stat_or_stat64 stat_temp;

  if (scm_is_integer (object))
    {
      SCM_SYSCALL (rv = fstat_or_fstat64 (scm_to_int (object), &stat_temp));
    }
  else if (scm_is_string (object))
    {
      char *file = scm_to_locale_string (object);
      SCM_SYSCALL (rv = stat_or_stat64 (file, &stat_temp));
      free (file);
    }
  else
    {
      object = SCM_COERCE_OUTPORT (object);
      SCM_VALIDATE_OPFPORT (1, object);
      fdes = SCM_FPORT_FDES (object);
      SCM_SYSCALL (rv = fstat_or_fstat64 (fdes, &stat_temp));
    }

  if (rv == -1)
    {
      if (SCM_UNBNDP (exception_on_error) || scm_is_true (exception_on_error))
        {
          int en = errno;
          SCM_SYSERROR_MSG ("~A: ~S",
                            scm_list_2 (scm_strerror (scm_from_int (en)),
                                        object),
                            en);
        }
      else
        return SCM_BOOL_F;
    }
  return scm_stat2scm (&stat_temp);
}


SCM_DEFINE (scm_rmdir, "rmdir", 1, 0, 0,
            (SCM path),
	    "Remove the existing directory named by @var{path}.  The directory must\n"
	    "be empty for this to succeed.  The return value is unspecified.")
#define FUNC_NAME s_scm_rmdir
{
  int val;

  STRING_SYSCALL (path, c_path, val = rmdir (c_path));
  if (val != 0)
    SCM_SYSERROR;
  return SCM_UNSPECIFIED;
}


SCM_DEFINE (scm_basename, "basename", 1, 1, 0,
            (SCM filename, SCM suffix),
	    "Return the base name of the file name @var{filename}. The\n"
	    "base name is the file name without any directory components.\n"
	    "If @var{suffix} is provided, and is equal to the end of\n"
	    "@var{filename}, it is removed also.")
#define FUNC_NAME s_scm_basename
{
  char *c_filename, *c_last_component;
  SCM res;

  scm_dynwind_begin (0);
  c_filename = scm_to_utf8_string (filename);
  scm_dynwind_free (c_filename);

  c_last_component = last_component (c_filename);
  if (!c_last_component)
    res = filename;
  else
    res = scm_from_utf8_string (c_last_component);
  scm_dynwind_end ();

  if (!SCM_UNBNDP (suffix) &&
      scm_is_true (scm_string_suffix_p (suffix, filename,
                                        SCM_UNDEFINED, SCM_UNDEFINED,
                                        SCM_UNDEFINED, SCM_UNDEFINED)))
    res = scm_c_substring
      (res, 0, scm_c_string_length (res) - scm_c_string_length (suffix));

  return res;
}


SCM_DEFINE (scm_select, "select", 3, 2, 0,
            (SCM reads, SCM writes, SCM excepts, SCM secs, SCM usecs),
	    "This procedure has a variety of uses: waiting for the ability\n"
	    "to provide input, accept output, or the existence of\n"
	    "exceptional conditions on a collection of ports or file\n"
	    "descriptors, or waiting for a timeout to occur.\n\n"

	    "When an error occurs, of if it is interrupted by a signal, this\n"
	    "procedure throws a @code{system-error} exception\n"
	    "(@pxref{Conventions, @code{system-error}}).  In case of an\n"
	    "interruption, the associated error number is @var{EINTR}.\n\n"

	    "@var{reads}, @var{writes} and @var{excepts} can be lists or\n"
	    "vectors, with each member a port or a file descriptor.\n"
	    "The value returned is a list of three corresponding\n"
	    "lists or vectors containing only the members which meet the\n"
	    "specified requirement.  The ability of port buffers to\n"
	    "provide input or accept output is taken into account.\n"
	    "Ordering of the input lists or vectors is not preserved.\n\n"
	    "The optional arguments @var{secs} and @var{usecs} specify the\n"
	    "timeout.  Either @var{secs} can be specified alone, as\n"
	    "either an integer or a real number, or both @var{secs} and\n"
	    "@var{usecs} can be specified as integers, in which case\n"
	    "@var{usecs} is an additional timeout expressed in\n"
	    "microseconds.  If @var{secs} is omitted or is @code{#f} then\n"
	    "select will wait for as long as it takes for one of the other\n"
	    "conditions to be satisfied.\n\n"
	    "The scsh version of @code{select} differs as follows:\n"
	    "Only vectors are accepted for the first three arguments.\n"
	    "The @var{usecs} argument is not supported.\n"
	    "Multiple values are returned instead of a list.\n"
	    "Duplicates in the input vectors appear only once in output.\n"
	    "An additional @code{select!} interface is provided.")
#define FUNC_NAME s_scm_select
{
  struct timeval timeout;
  struct timeval * time_ptr;
  fd_set read_set;
  fd_set write_set;
  fd_set except_set;
  int read_count;
  int write_count;
  int except_count;
  /* these lists accumulate ports which are ready due to buffering.
     their file descriptors don't need to be added to the select sets.  */
  SCM read_ports_ready = SCM_EOL;
  SCM write_ports_ready = SCM_EOL;
  int max_fd;

  if (scm_is_simple_vector (reads))
    {
      read_count = SCM_SIMPLE_VECTOR_LENGTH (reads);
    }
  else
    {
      read_count = scm_ilength (reads);
      SCM_ASSERT (read_count >= 0, reads, SCM_ARG1, FUNC_NAME);
    }
  if (scm_is_simple_vector (writes))
    {
      write_count = SCM_SIMPLE_VECTOR_LENGTH (writes);
    }
  else
    {
      write_count = scm_ilength (writes);
      SCM_ASSERT (write_count >= 0, writes, SCM_ARG2, FUNC_NAME);
    }
  if (scm_is_simple_vector (excepts))
    {
      except_count = SCM_SIMPLE_VECTOR_LENGTH (excepts);
    }
  else
    {
      except_count = scm_ilength (excepts);
      SCM_ASSERT (except_count >= 0, excepts, SCM_ARG3, FUNC_NAME);
    }

  FD_ZERO (&read_set);
  FD_ZERO (&write_set);
  FD_ZERO (&except_set);

  max_fd = fill_select_type (&read_set, &read_ports_ready, reads, SCM_ARG1);

  {
    int write_max = fill_select_type (&write_set, &write_ports_ready,
				      writes, SCM_ARG2);
    int except_max = fill_select_type (&except_set, NULL,
				       excepts, SCM_ARG3);

    if (write_max > max_fd)
      max_fd = write_max;
    if (except_max > max_fd)
      max_fd = except_max;
  }

  /* if there's a port with a ready buffer, don't block, just
     check for ready file descriptors.  */
  if (!scm_is_null (read_ports_ready) || !scm_is_null (write_ports_ready))
    {
      timeout.tv_sec = 0;
      timeout.tv_usec = 0;
      time_ptr = &timeout;
    }
  else if (SCM_UNBNDP (secs) || scm_is_false (secs))
    time_ptr = 0;
  else
    {
      if (scm_is_unsigned_integer (secs, 0, ULONG_MAX))
	{
	  timeout.tv_sec = scm_to_ulong (secs);
	  if (SCM_UNBNDP (usecs))
	    timeout.tv_usec = 0;
	  else
	    timeout.tv_usec = scm_to_long (usecs);
	}
      else
	{
	  double fl = scm_to_double (secs);

	  if (!SCM_UNBNDP (usecs))
	    SCM_WRONG_TYPE_ARG (4, secs);
	  if (fl > LONG_MAX)
	    SCM_OUT_OF_RANGE (4, secs);
	  timeout.tv_sec = (long) fl;
	  timeout.tv_usec = (long) ((fl - timeout.tv_sec) * 1000000);
	}
      time_ptr = &timeout;
    }

  {
    int rv = select (max_fd + 1,
                     &read_set, &write_set, &except_set,
                     time_ptr);
    if (rv < 0)
      SCM_SYSERROR;
  }
  return scm_list_3 (retrieve_select_type (&read_set, read_ports_ready, reads),
		     retrieve_select_type (&write_set, write_ports_ready, writes),
		     retrieve_select_type (&except_set, SCM_EOL, excepts));
}


scm_dir_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
{
  scm_puts ("#<", port);
  if (!SCM_DIR_OPEN_P (exp))
    scm_puts ("closed: ", port);
  scm_puts ("directory stream ", port);
  scm_uintprint (SCM_SMOB_DATA_1 (exp), 16, port);
  scm_putc ('>', port);
  return 1;
}


retrieve_select_type (fd_set *set, SCM ports_ready, SCM list_or_vec)
{
  SCM answer_list = ports_ready;

  if (scm_is_simple_vector (list_or_vec))
    {
      int i = SCM_SIMPLE_VECTOR_LENGTH (list_or_vec);

      while (--i >= 0)
	{
	  answer_list = get_element (set,
				     SCM_SIMPLE_VECTOR_REF (list_or_vec, i),
				     answer_list);
	}
      return scm_vector (answer_list);
    }
  else
    {
      /* list_or_vec must be a list.  */
      while (!SCM_NULL_OR_NIL_P (list_or_vec))
	{
	  answer_list = get_element (set, SCM_CAR (list_or_vec), answer_list);
	  list_or_vec = SCM_CDR (list_or_vec);
	}
      return answer_list;
    }
}


scm_i_relativize_path (SCM path, SCM in_path)
{
  char *str, *canon;
  SCM scanon;

  str = scm_to_locale_string (path);
  canon = canonicalize_file_name (str);
  free (str);

  if (!canon)
    return SCM_BOOL_F;

  scanon = scm_take_locale_string (canon);

  for (; scm_is_pair (in_path); in_path = scm_cdr (in_path))
    {
      SCM dir = scm_car (in_path);
      size_t len = scm_c_string_length (dir);

      /* When DIR is empty, it means "current working directory".  We
	 could set DIR to (getcwd) in that case, but then the
	 canonicalization would depend on the current directory, which
	 is not what we want in the context of `compile-file', for
	 instance.  */
      if (len > 0
	  && scm_is_true (scm_string_prefix_p (dir, scanon,
					       SCM_UNDEFINED, SCM_UNDEFINED,
					       SCM_UNDEFINED, SCM_UNDEFINED)))
	{
	  /* DIR either has a trailing delimiter or doesn't.  SCANON
	     will be delimited by single delimiters.  When DIR does not
	     have a trailing delimiter, add one to the length to strip
	     off the delimiter within SCANON.  */
	  if (!is_file_name_separator (scm_c_string_ref (dir, len - 1)))
	    len++;

	  if (scm_c_string_length (scanon) > len)
	    return scm_substring (scanon, scm_from_size_t (len), SCM_UNDEFINED);
	  else
	    return SCM_BOOL_F;
	}
    }

  return SCM_BOOL_F;
}


escape_none(const char *string,
	    const struct auth_request *request ATTR_UNUSED)
{
	return string;
}

auth: Don't crash expanding %variables when username isn't set.

This continues the auth-policy fix in
c3d3faa4f72a676e183f34be960cff13a5a725ae


void auth_request_var_expand(string_t *dest, const char *str,
			     const struct auth_request *auth_request,
			     auth_request_escape_func_t *escape_func)
{
	auth_request_var_expand_with_table(dest, str, auth_request,
		auth_request_get_var_expand_table(auth_request, escape_func),
		escape_func);
}


auth_request_str_escape(const char *string,
			const struct auth_request *request ATTR_UNUSED)
{
	return str_escape(string);
}


void auth_request_var_expand_with_table(string_t *dest, const char *str,
					const struct auth_request *auth_request,
					const struct var_expand_table *table,
					auth_request_escape_func_t *escape_func)
{
	struct auth_request_var_expand_ctx ctx;

	memset(&ctx, 0, sizeof(ctx));
	ctx.auth_request = auth_request;
	ctx.escape_func = escape_func == NULL ? escape_none : escape_func;
	var_expand_with_funcs(dest, str, table,
			      auth_request_var_funcs_table, &ctx);
}


auth_request_get_var_expand_table_full(const struct auth_request *auth_request,
				       auth_request_escape_func_t *escape_func,
				       unsigned int *count)
{
	const unsigned int auth_count =
		N_ELEMENTS(auth_request_var_expand_static_tab);
	struct var_expand_table *tab, *ret_tab;
	const char *orig_user, *auth_user, *username;

	if (escape_func == NULL)
		escape_func = escape_none;

	/* keep the extra fields at the beginning. the last static_tab field
	   contains the ending NULL-fields. */
	tab = ret_tab = t_malloc((*count + auth_count) * sizeof(*tab));
	memset(tab, 0, *count * sizeof(*tab));
	tab += *count;
	*count += auth_count;

	memcpy(tab, auth_request_var_expand_static_tab,
	       auth_count * sizeof(*tab));

	username = auth_request->user != NULL ? auth_request->user : "";
	tab[0].value = escape_func(username, auth_request);
	tab[1].value = escape_func(t_strcut(username, '@'),
				   auth_request);
	tab[2].value = strchr(username, '@');
	if (tab[2].value != NULL)
		tab[2].value = escape_func(tab[2].value+1, auth_request);
	tab[3].value = escape_func(auth_request->service, auth_request);
	/* tab[4] = we have no home dir */
	if (auth_request->local_ip.family != 0)
		tab[5].value = net_ip2addr(&auth_request->local_ip);
	if (auth_request->remote_ip.family != 0)
		tab[6].value = net_ip2addr(&auth_request->remote_ip);
	tab[7].value = dec2str(auth_request->client_pid);
	if (auth_request->mech_password != NULL) {
		tab[8].value = escape_func(auth_request->mech_password,
					   auth_request);
	}
	if (auth_request->userdb_lookup) {
		tab[9].value = auth_request->userdb == NULL ? "" :
			dec2str(auth_request->userdb->userdb->id);
	} else {
		tab[9].value = auth_request->passdb == NULL ? "" :
			dec2str(auth_request->passdb->passdb->id);
	}
	tab[10].value = auth_request->mech_name == NULL ? "" :
		escape_func(auth_request->mech_name, auth_request);
	tab[11].value = auth_request->secured ? "secured" : "";
	tab[12].value = dec2str(auth_request->local_port);
	tab[13].value = dec2str(auth_request->remote_port);
	tab[14].value = auth_request->valid_client_cert ? "valid" : "";

	if (auth_request->requested_login_user != NULL) {
		const char *login_user = auth_request->requested_login_user;

		tab[15].value = escape_func(login_user, auth_request);
		tab[16].value = escape_func(t_strcut(login_user, '@'),
					    auth_request);
		tab[17].value = strchr(login_user, '@');
		if (tab[17].value != NULL) {
			tab[17].value = escape_func(tab[17].value+1,
						    auth_request);
		}
	}
	tab[18].value = auth_request->session_id == NULL ? NULL :
		escape_func(auth_request->session_id, auth_request);
	if (auth_request->real_local_ip.family != 0)
		tab[19].value = net_ip2addr(&auth_request->real_local_ip);
	if (auth_request->real_remote_ip.family != 0)
		tab[20].value = net_ip2addr(&auth_request->real_remote_ip);
	tab[21].value = dec2str(auth_request->real_local_port);
	tab[22].value = dec2str(auth_request->real_remote_port);
	tab[23].value = strchr(username, '@');
	if (tab[23].value != NULL) {
		tab[23].value = escape_func(t_strcut(tab[23].value+1, '@'),
					    auth_request);
	}
	tab[24].value = strrchr(username, '@');
	if (tab[24].value != NULL)
		tab[24].value = escape_func(tab[24].value+1, auth_request);
	tab[25].value = auth_request->master_user == NULL ? NULL :
		escape_func(auth_request->master_user, auth_request);
	tab[26].value = auth_request->session_pid == (pid_t)-1 ? NULL :
		dec2str(auth_request->session_pid);

	orig_user = auth_request->original_username != NULL ?
		auth_request->original_username : username;
	tab[27].value = escape_func(orig_user, auth_request);
	tab[28].value = escape_func(t_strcut(orig_user, '@'), auth_request);
	tab[29].value = strchr(orig_user, '@');
	if (tab[29].value != NULL)
		tab[29].value = escape_func(tab[29].value+1, auth_request);

	if (auth_request->master_user != NULL)
		auth_user = auth_request->master_user;
	else
		auth_user = orig_user;
	tab[30].value = escape_func(auth_user, auth_request);
	tab[31].value = escape_func(t_strcut(auth_user, '@'), auth_request);
	tab[32].value = strchr(auth_user, '@');
	if (tab[32].value != NULL)
		tab[32].value = escape_func(tab[32].value+1, auth_request);
	if (auth_request->local_name != NULL)
		tab[33].value = escape_func(auth_request->local_name, auth_request);
	else
		tab[33].value = "";
	return ret_tab;
}


static const char *field_get_default(const char *data)
{
	const char *p;

	p = strchr(data, ':');
	if (p == NULL)
		return "";
	else {
		/* default value given */
		return p+1;
	}
}


auth_request_var_expand_func_passdb(const char *data, void *context)
{
	struct auth_request_var_expand_ctx *ctx = context;
	const char *field_name = t_strcut(data, ':');
	const char *value;

	value = auth_fields_find(ctx->auth_request->extra_fields, field_name);
	return ctx->escape_func(value != NULL ? value : field_get_default(data),
				ctx->auth_request);
}


t_auth_request_var_expand(const char *str,
			  const struct auth_request *auth_request,
			  auth_request_escape_func_t *escape_func)
{
	string_t *dest = t_str_new(128);
	auth_request_var_expand(dest, str, auth_request, escape_func);
	return str_c(dest);
}


auth_request_get_var_expand_table(const struct auth_request *auth_request,
				  auth_request_escape_func_t *escape_func)
{
	unsigned int count = 0;

	return auth_request_get_var_expand_table_full(auth_request, escape_func,
						      &count);
}


auth_request_var_expand_func_userdb(const char *data, void *context)
{
	struct auth_request_var_expand_ctx *ctx = context;
	const char *field_name = t_strcut(data, ':');
	const char *value;

	value = ctx->auth_request->userdb_reply == NULL ? NULL :
		auth_fields_find(ctx->auth_request->userdb_reply, field_name);
	return ctx->escape_func(value != NULL ? value : field_get_default(data),
				ctx->auth_request);
}


static enum TIFFReadDirEntryErr TIFFReadDirEntryDataAndRealloc(
                    TIFF* tif, uint64 offset, tmsize_t size, void** pdest)
{
#if SIZEOF_VOIDP == 8 || SIZEOF_SIZE_T == 8
        tmsize_t threshold = INITIAL_THRESHOLD;
#endif
        tmsize_t already_read = 0;

        assert( !isMapped(tif) );

        if (!SeekOK(tif,offset))
                return(TIFFReadDirEntryErrIo);

        /* On 64 bit processes, read first a maximum of 1 MB, then 10 MB, etc */
        /* so as to avoid allocating too much memory in case the file is too */
        /* short. We could ask for the file size, but this might be */
        /* expensive with some I/O layers (think of reading a gzipped file) */
        /* Restrict to 64 bit processes, so as to avoid reallocs() */
        /* on 32 bit processes where virtual memory is scarce.  */
        while( already_read < size )
        {
            void* new_dest;
            tmsize_t bytes_read;
            tmsize_t to_read = size - already_read;
#if SIZEOF_VOIDP == 8 || SIZEOF_SIZE_T == 8
            if( to_read >= threshold && threshold < MAX_THRESHOLD )
            {
                to_read = threshold;
                threshold *= THRESHOLD_MULTIPLIER;
            }
#endif

            new_dest = (uint8*) _TIFFrealloc(
                            *pdest, already_read + to_read);
            if( new_dest == NULL )
            {
                TIFFErrorExt(tif->tif_clientdata, tif->tif_name,
                            "Failed to allocate memory for %s "
                            "(%ld elements of %ld bytes each)",
                            "TIFFReadDirEntryArray",
                             (long) 1, (long) already_read + to_read);
                return TIFFReadDirEntryErrAlloc;
            }
            *pdest = new_dest;

            bytes_read = TIFFReadFile(tif,
                (char*)*pdest + already_read, to_read);
            already_read += bytes_read;
            if (bytes_read != to_read) {
                return TIFFReadDirEntryErrIo;
            }
        }
        return TIFFReadDirEntryErrOk;
}

* libtiff/tif_read.c: add protection against excessive memory
allocation attempts in TIFFReadDirEntryArray() on short files.
Effective for mmap'ed case. And non-mmap'ed case, but restricted
to 64bit builds.
Fixes http://bugzilla.maptools.org/show_bug.cgi?id=2675


static enum TIFFReadDirEntryErr TIFFReadDirEntryArrayWithLimit(
    TIFF* tif, TIFFDirEntry* direntry, uint32* count, uint32 desttypesize,
    void** value, uint64 maxcount)
{
	int typesize;
	uint32 datasize;
	void* data;
        uint64 target_count64;
	typesize=TIFFDataWidth(direntry->tdir_type);

        target_count64 = (direntry->tdir_count > maxcount) ?
                maxcount : direntry->tdir_count;

	if ((target_count64==0)||(typesize==0))
	{
		*value=0;
		return(TIFFReadDirEntryErrOk);
	}
        (void) desttypesize;

        /*
         * As a sanity check, make sure we have no more than a 2GB tag array
         * in either the current data type or the dest data type.  This also
         * avoids problems with overflow of tmsize_t on 32bit systems.
         */
	if ((uint64)(2147483647/typesize)<target_count64)
		return(TIFFReadDirEntryErrSizesan);
	if ((uint64)(2147483647/desttypesize)<target_count64)
		return(TIFFReadDirEntryErrSizesan);

	*count=(uint32)target_count64;
	datasize=(*count)*typesize;
	assert((tmsize_t)datasize>0);

	if( isMapped(tif) && datasize > tif->tif_size )
		return TIFFReadDirEntryErrIo;

	if( !isMapped(tif) &&
		(((tif->tif_flags&TIFF_BIGTIFF) && datasize > 8) ||
		(!(tif->tif_flags&TIFF_BIGTIFF) && datasize > 4)) )
	{
		data = NULL;
	}
	else
	{
		data=_TIFFCheckMalloc(tif, *count, typesize, "ReadDirEntryArray");
		if (data==0)
			return(TIFFReadDirEntryErrAlloc);
	}
	if (!(tif->tif_flags&TIFF_BIGTIFF))
	{
		if (datasize<=4)
			_TIFFmemcpy(data,&direntry->tdir_offset,datasize);
		else
		{
			enum TIFFReadDirEntryErr err;
			uint32 offset = direntry->tdir_offset.toff_long;
			if (tif->tif_flags&TIFF_SWAB)
				TIFFSwabLong(&offset);
			if( isMapped(tif) )
				err=TIFFReadDirEntryData(tif,(uint64)offset,(tmsize_t)datasize,data);
			else
				err=TIFFReadDirEntryDataAndRealloc(tif,(uint64)offset,(tmsize_t)datasize,&data);
			if (err!=TIFFReadDirEntryErrOk)
			{
				_TIFFfree(data);
				return(err);
			}
		}
	}
	else
	{
		if (datasize<=8)
			_TIFFmemcpy(data,&direntry->tdir_offset,datasize);
		else
		{
			enum TIFFReadDirEntryErr err;
			uint64 offset = direntry->tdir_offset.toff_long8;
			if (tif->tif_flags&TIFF_SWAB)
				TIFFSwabLong8(&offset);
			if( isMapped(tif) )
				err=TIFFReadDirEntryData(tif,(uint64)offset,(tmsize_t)datasize,data);
			else
				err=TIFFReadDirEntryDataAndRealloc(tif,(uint64)offset,(tmsize_t)datasize,&data);
			if (err!=TIFFReadDirEntryErrOk)
			{
				_TIFFfree(data);
				return(err);
			}
		}
	}
	*value=data;
	return(TIFFReadDirEntryErrOk);
}


static int chacha20_poly1305_cipher(EVP_CIPHER_CTX *ctx, unsigned char *out,
                                    const unsigned char *in, size_t len)
{
    EVP_CHACHA_AEAD_CTX *actx = aead_data(ctx);
    size_t rem, plen = actx->tls_payload_length;

    if (!actx->mac_inited) {
#  if !defined(OPENSSL_SMALL_FOOTPRINT)
        if (plen != NO_TLS_PAYLOAD_LENGTH && out != NULL)
            return chacha20_poly1305_tls_cipher(ctx, out, in, len);
#  endif
        actx->key.counter[0] = 0;
        ChaCha20_ctr32(actx->key.buf, zero, CHACHA_BLK_SIZE,
                       actx->key.key.d, actx->key.counter);
        Poly1305_Init(POLY1305_ctx(actx), actx->key.buf);
        actx->key.counter[0] = 1;
        actx->key.partial_len = 0;
        actx->len.aad = actx->len.text = 0;
        actx->mac_inited = 1;
        if (plen != NO_TLS_PAYLOAD_LENGTH) {
            Poly1305_Update(POLY1305_ctx(actx), actx->tls_aad,
                            EVP_AEAD_TLS1_AAD_LEN);
            actx->len.aad = EVP_AEAD_TLS1_AAD_LEN;
            actx->aad = 1;
        }
    }

    if (in) {                                   /* aad or text */
        if (out == NULL) {                      /* aad */
            Poly1305_Update(POLY1305_ctx(actx), in, len);
            actx->len.aad += len;
            actx->aad = 1;
            return len;
        } else {                                /* plain- or ciphertext */
            if (actx->aad) {                    /* wrap up aad */
                if ((rem = (size_t)actx->len.aad % POLY1305_BLOCK_SIZE))
                    Poly1305_Update(POLY1305_ctx(actx), zero,
                                    POLY1305_BLOCK_SIZE - rem);
                actx->aad = 0;
            }

            actx->tls_payload_length = NO_TLS_PAYLOAD_LENGTH;
            if (plen == NO_TLS_PAYLOAD_LENGTH)
                plen = len;
            else if (len != plen + POLY1305_BLOCK_SIZE)
                return -1;

            if (ctx->encrypt) {                 /* plaintext */
                chacha_cipher(ctx, out, in, plen);
                Poly1305_Update(POLY1305_ctx(actx), out, plen);
                in += plen;
                out += plen;
                actx->len.text += plen;
            } else {                            /* ciphertext */
                Poly1305_Update(POLY1305_ctx(actx), in, plen);
                chacha_cipher(ctx, out, in, plen);
                in += plen;
                out += plen;
                actx->len.text += plen;
            }
        }
    }
    if (in == NULL                              /* explicit final */
        || plen != len) {                       /* or tls mode */
        const union {
            long one;
            char little;
        } is_endian = { 1 };
        unsigned char temp[POLY1305_BLOCK_SIZE];

        if (actx->aad) {                        /* wrap up aad */
            if ((rem = (size_t)actx->len.aad % POLY1305_BLOCK_SIZE))
                Poly1305_Update(POLY1305_ctx(actx), zero,
                                POLY1305_BLOCK_SIZE - rem);
            actx->aad = 0;
        }

        if ((rem = (size_t)actx->len.text % POLY1305_BLOCK_SIZE))
            Poly1305_Update(POLY1305_ctx(actx), zero,
                            POLY1305_BLOCK_SIZE - rem);

        if (is_endian.little) {
            Poly1305_Update(POLY1305_ctx(actx),
                            (unsigned char *)&actx->len, POLY1305_BLOCK_SIZE);
        } else {
            temp[0]  = (unsigned char)(actx->len.aad);
            temp[1]  = (unsigned char)(actx->len.aad>>8);
            temp[2]  = (unsigned char)(actx->len.aad>>16);
            temp[3]  = (unsigned char)(actx->len.aad>>24);
            temp[4]  = (unsigned char)(actx->len.aad>>32);
            temp[5]  = (unsigned char)(actx->len.aad>>40);
            temp[6]  = (unsigned char)(actx->len.aad>>48);
            temp[7]  = (unsigned char)(actx->len.aad>>56);

            temp[8]  = (unsigned char)(actx->len.text);
            temp[9]  = (unsigned char)(actx->len.text>>8);
            temp[10] = (unsigned char)(actx->len.text>>16);
            temp[11] = (unsigned char)(actx->len.text>>24);
            temp[12] = (unsigned char)(actx->len.text>>32);
            temp[13] = (unsigned char)(actx->len.text>>40);
            temp[14] = (unsigned char)(actx->len.text>>48);
            temp[15] = (unsigned char)(actx->len.text>>56);

            Poly1305_Update(POLY1305_ctx(actx), temp, POLY1305_BLOCK_SIZE);
        }
        Poly1305_Final(POLY1305_ctx(actx), ctx->encrypt ? actx->tag
                                                        : temp);
        actx->mac_inited = 0;

        if (in != NULL && len != plen) {        /* tls mode */
            if (ctx->encrypt) {
                memcpy(out, actx->tag, POLY1305_BLOCK_SIZE);
            } else {
                if (CRYPTO_memcmp(temp, in, POLY1305_BLOCK_SIZE)) {
                    memset(out - plen, 0, plen);
                    return -1;
                }
            }
        }
        else if (!ctx->encrypt) {
            if (CRYPTO_memcmp(temp, actx->tag, actx->tag_len))
                return -1;
        }
    }
    return len;
}

Prevent over long nonces in ChaCha20-Poly1305

ChaCha20-Poly1305 is an AEAD cipher, and requires a unique nonce input for
every encryption operation. RFC 7539 specifies that the nonce value (IV)
should be 96 bits (12 bytes). OpenSSL allows a variable nonce length and
front pads the nonce with 0 bytes if it is less than 12 bytes. However it
also incorrectly allows a nonce to be set of up to 16 bytes. In this case
only the last 12 bytes are significant and any additional leading bytes are
ignored.

It is a requirement of using this cipher that nonce values are unique.
Messages encrypted using a reused nonce value are susceptible to serious
confidentiality and integrity attacks. If an application changes the
default nonce length to be longer than 12 bytes and then makes a change to
the leading bytes of the nonce expecting the new value to be a new unique
nonce then such an application could inadvertently encrypt messages with a
reused nonce.

Additionally the ignored bytes in a long nonce are not covered by the
integrity guarantee of this cipher. Any application that relies on the
integrity of these ignored leading bytes of a long nonce may be further
affected.

Any OpenSSL internal use of this cipher, including in SSL/TLS, is safe
because no such use sets such a long nonce value. However user
applications that use this cipher directly and set a non-default nonce
length to be longer than 12 bytes may be vulnerable.

CVE-2019-1543

Fixes #8345

Reviewed-by: Paul Dale <paul.dale@oracle.com>
Reviewed-by: Richard Levitte <levitte@openssl.org>
(Merged from https://github.com/openssl/openssl/pull/8406)

(cherry picked from commit 2a3d0ee9d59156c48973592331404471aca886d6)


const EVP_CIPHER *EVP_chacha20(void)
{
    return &chacha20;
}


static int chacha20_poly1305_tls_cipher(EVP_CIPHER_CTX *ctx, unsigned char *out,
                                        const unsigned char *in, size_t len)
{
    EVP_CHACHA_AEAD_CTX *actx = aead_data(ctx);
    size_t tail, tohash_len, buf_len, plen = actx->tls_payload_length;
    unsigned char *buf, *tohash, *ctr, storage[sizeof(zero) + 32];

    if (len != plen + POLY1305_BLOCK_SIZE)
        return -1;

    buf = storage + ((0 - (size_t)storage) & 15);   /* align */
    ctr = buf + CHACHA_BLK_SIZE;
    tohash = buf + CHACHA_BLK_SIZE - POLY1305_BLOCK_SIZE;

#   ifdef XOR128_HELPERS
    if (plen <= 3 * CHACHA_BLK_SIZE) {
        actx->key.counter[0] = 0;
        buf_len = (plen + 2 * CHACHA_BLK_SIZE - 1) & (0 - CHACHA_BLK_SIZE);
        ChaCha20_ctr32(buf, zero, buf_len, actx->key.key.d,
                       actx->key.counter);
        Poly1305_Init(POLY1305_ctx(actx), buf);
        actx->key.partial_len = 0;
        memcpy(tohash, actx->tls_aad, POLY1305_BLOCK_SIZE);
        tohash_len = POLY1305_BLOCK_SIZE;
        actx->len.aad = EVP_AEAD_TLS1_AAD_LEN;
        actx->len.text = plen;

        if (plen) {
            if (ctx->encrypt)
                ctr = xor128_encrypt_n_pad(out, in, ctr, plen);
            else
                ctr = xor128_decrypt_n_pad(out, in, ctr, plen);

            in += plen;
            out += plen;
            tohash_len = (size_t)(ctr - tohash);
        }
    }
#   else
    if (plen <= CHACHA_BLK_SIZE) {
        size_t i;

        actx->key.counter[0] = 0;
        ChaCha20_ctr32(buf, zero, (buf_len = 2 * CHACHA_BLK_SIZE),
                       actx->key.key.d, actx->key.counter);
        Poly1305_Init(POLY1305_ctx(actx), buf);
        actx->key.partial_len = 0;
        memcpy(tohash, actx->tls_aad, POLY1305_BLOCK_SIZE);
        tohash_len = POLY1305_BLOCK_SIZE;
        actx->len.aad = EVP_AEAD_TLS1_AAD_LEN;
        actx->len.text = plen;

        if (ctx->encrypt) {
            for (i = 0; i < plen; i++) {
                out[i] = ctr[i] ^= in[i];
            }
        } else {
            for (i = 0; i < plen; i++) {
                unsigned char c = in[i];
                out[i] = ctr[i] ^ c;
                ctr[i] = c;
            }
        }

        in += i;
        out += i;

        tail = (0 - i) & (POLY1305_BLOCK_SIZE - 1);
        memset(ctr + i, 0, tail);
        ctr += i + tail;
        tohash_len += i + tail;
    }
#   endif
    else {
        actx->key.counter[0] = 0;
        ChaCha20_ctr32(buf, zero, (buf_len = CHACHA_BLK_SIZE),
                       actx->key.key.d, actx->key.counter);
        Poly1305_Init(POLY1305_ctx(actx), buf);
        actx->key.counter[0] = 1;
        actx->key.partial_len = 0;
        Poly1305_Update(POLY1305_ctx(actx), actx->tls_aad, POLY1305_BLOCK_SIZE);
        tohash = ctr;
        tohash_len = 0;
        actx->len.aad = EVP_AEAD_TLS1_AAD_LEN;
        actx->len.text = plen;

        if (ctx->encrypt) {
            ChaCha20_ctr32(out, in, plen, actx->key.key.d, actx->key.counter);
            Poly1305_Update(POLY1305_ctx(actx), out, plen);
        } else {
            Poly1305_Update(POLY1305_ctx(actx), in, plen);
            ChaCha20_ctr32(out, in, plen, actx->key.key.d, actx->key.counter);
        }

        in += plen;
        out += plen;
        tail = (0 - plen) & (POLY1305_BLOCK_SIZE - 1);
        Poly1305_Update(POLY1305_ctx(actx), zero, tail);
    }

    {
        const union {
            long one;
            char little;
        } is_endian = { 1 };

        if (is_endian.little) {
            memcpy(ctr, (unsigned char *)&actx->len, POLY1305_BLOCK_SIZE);
        } else {
            ctr[0]  = (unsigned char)(actx->len.aad);
            ctr[1]  = (unsigned char)(actx->len.aad>>8);
            ctr[2]  = (unsigned char)(actx->len.aad>>16);
            ctr[3]  = (unsigned char)(actx->len.aad>>24);
            ctr[4]  = (unsigned char)(actx->len.aad>>32);
            ctr[5]  = (unsigned char)(actx->len.aad>>40);
            ctr[6]  = (unsigned char)(actx->len.aad>>48);
            ctr[7]  = (unsigned char)(actx->len.aad>>56);

            ctr[8]  = (unsigned char)(actx->len.text);
            ctr[9]  = (unsigned char)(actx->len.text>>8);
            ctr[10] = (unsigned char)(actx->len.text>>16);
            ctr[11] = (unsigned char)(actx->len.text>>24);
            ctr[12] = (unsigned char)(actx->len.text>>32);
            ctr[13] = (unsigned char)(actx->len.text>>40);
            ctr[14] = (unsigned char)(actx->len.text>>48);
            ctr[15] = (unsigned char)(actx->len.text>>56);
        }
        tohash_len += POLY1305_BLOCK_SIZE;
    }

    Poly1305_Update(POLY1305_ctx(actx), tohash, tohash_len);
    OPENSSL_cleanse(buf, buf_len);
    Poly1305_Final(POLY1305_ctx(actx), ctx->encrypt ? actx->tag
                                                    : tohash);

    actx->tls_payload_length = NO_TLS_PAYLOAD_LENGTH;

    if (ctx->encrypt) {
        memcpy(out, actx->tag, POLY1305_BLOCK_SIZE);
    } else {
        if (CRYPTO_memcmp(tohash, in, POLY1305_BLOCK_SIZE)) {
            memset(out - (len - POLY1305_BLOCK_SIZE), 0,
                   len - POLY1305_BLOCK_SIZE);
            return -1;
        }
    }

    return len;
}