/*
 ===========================================================================
 Crypt::GCrypt

 Perl interface to the GNU Cryptographic library
 
 Author: Alessandro Ranellucci <aar@cpan.org>
 
 Use this software AT YOUR OWN RISK.
 ===========================================================================
*/

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"

#include <gcrypt.h>
#include <string.h>

#ifdef USE_ITHREADS
    #ifdef I_PTHREAD
        #include <pthread.h>
        #define HAVE_PTHREAD
    #else
        #warning "Perl ithreads not available or not implemented with Pthread: building a non-threadsafe Crypt::GCrypt"
    # endif
#endif


static const char my_name[] = "Crypt::GCrypt";
static const char author[] = "Alessandro Ranellucci <aar@cpan.org>";

enum cg_type
{
    CG_TYPE_CIPHER,
    CG_TYPE_ASYMM,
    CG_TYPE_DIGEST
};
enum cg_action
{
    CG_ACTION_NONE,
    CG_ACTION_ENCRYPT,
    CG_ACTION_DECRYPT
};
enum cg_padding
{
    CG_PADDING_NONE,
    CG_PADDING_STANDARD,
    CG_PADDING_NULL,
    CG_PADDING_SPACE
};

struct Crypt_GCrypt_s {
    int type;
    int action;
    gcry_cipher_hd_t h;
/*
    gcry_ac_handle_t h_ac;
*/
    gcry_md_hd_t h_md;
/*
    gcry_ac_key_t key_ac;
*/
    gcry_error_t err;
    int mode;
    int padding;
    unsigned char *buffer;
    STRLEN buflen, blklen, keylen;
    int need_to_call_finish;
    int buffer_is_decrypted;
};
typedef struct Crypt_GCrypt_s *Crypt_GCrypt;

/* a Crypt_GCrypt_MPI need only be a pointer to a gcrypt MPI object */
typedef gcry_mpi_t Crypt_GCrypt_MPI;

/* return the offset of padding or -1 if none */
int find_padding (Crypt_GCrypt gcr, unsigned char *string, size_t string_len) {
    unsigned char last_char = string[string_len-1];
    size_t i, offset;
    void *p;
    
    switch (gcr->padding) {
        case CG_PADDING_STANDARD:
            /* padding length is last_char */
            for (i = 1; i <= last_char; ++i) {
                if (string[string_len-i] != last_char) return -1;
            }
            return string_len-last_char;
            
        case CG_PADDING_NULL:
            p = memchr((char *) string, '\0', string_len);
            if (p == NULL) return -1;
            
            offset = p - (void *)string;
            for (i = offset; i < string_len; ++i) {
                if (string[string_len-i] != '\0') return -1;
            }
            return offset;
            
        case CG_PADDING_SPACE:
            p = memchr((char *) string, '\32', string_len);
            if (p == NULL) return -1;
            
            offset = p - (void *)string;
            for (i = offset; i < string_len; ++i) {
                if (string[string_len-i] != '\32') return -1;
            }
            return offset;
    }
    return -1;
}

Crypt_GCrypt_MPI
dereference_gcm(SV* sv_gcm) {
    if (!sv_derived_from(sv_gcm, "Crypt::GCrypt::MPI"))
        croak("Not a Crypt::GCrypt::MPI object");
    IV tmp = SvIV((SV*)SvRV(sv_gcm));
    return INT2PTR(Crypt_GCrypt_MPI, tmp);
}

#ifdef HAVE_PTHREAD
    GCRY_THREAD_OPTION_PTHREAD_IMPL;
#endif

void
init_library() {
  gcry_error_t ret;
  if (gcry_control(GCRYCTL_INITIALIZATION_FINISHED_P)) {
    /* we just need to make sure that the right version is available */
    if (!gcry_check_version(GCRYPT_VERSION))
      croak("libgcrypt version mismatch (needed: %s)", GCRYPT_VERSION);
    return;
  }
  /* else, we need to go ahead with the full initialization: */
  #ifdef HAVE_PTHREAD
    ret = gcry_control(GCRYCTL_SET_THREAD_CBS, &gcry_threads_pthread);
    if (gcry_err_code(ret) != GPG_ERR_NO_ERROR)
    croak("could not initialize libgcrypt for threads (%d: %s/%s)", 
      gcry_err_code(ret),
      gcry_strsource(ret),
      gcry_strerror(ret));
  #endif
  
  if (!gcry_check_version(GCRYPT_VERSION))
    croak("libgcrypt version mismatch (needed: %s)", GCRYPT_VERSION);

  /* Why do it this way?  see 
     /usr/share/doc/libgcrypt11-doc/html/Initializing-the-library.html#sample-use-suspend-secmem
  */

  /* We don't want to see any warnings, e.g. because we have not yet
     parsed program options which might be used to suppress such
     warnings. */
  gcry_control (GCRYCTL_SUSPEND_SECMEM_WARN);
     
  /* Allocate a pool of 32k secure memory.  This make the secure memory
     available and also drops privileges where needed.  

     This mirrors changes made in libgcrypt 1.4.3, to auto-initialize
     the library with 32KB of secure memory if no other initialization
     has been done.

     FIXME: we should probably allow the user to choose how much 
     secure RAM to use something like this:

     use Crypt::GCrypt { secmem => 1024*1024 };

  */
  gcry_control (GCRYCTL_INIT_SECMEM, 32768, 0);
     
  /* It is now okay to let Libgcrypt complain when there was/is
     a problem with the secure memory. */
  gcry_control (GCRYCTL_RESUME_SECMEM_WARN);

  gcry_control(GCRYCTL_INITIALIZATION_FINISHED);
}


MODULE = Crypt::GCrypt        PACKAGE = Crypt::GCrypt    PREFIX = cg_

SV *
cg_built_against_version()
    CODE:
        init_library();
        RETVAL = newSVpvn(GCRYPT_VERSION, strlen(GCRYPT_VERSION));
    OUTPUT:
        RETVAL

SV *
cg_gcrypt_version()
    INIT:
        const char * v;
    CODE:
        init_library();
        v = gcry_check_version(NULL);
        RETVAL = newSVpvn(v, strlen(v));
    OUTPUT:
        RETVAL

Crypt_GCrypt
cg_new(...)
    PROTOTYPE: @
    INIT:
        char *s, *algo_s = NULL, *mode_s, *key_s;
        int i, algo, mode;
        unsigned int c_flags, ac_flags, md_flags;
/*
        gcry_ac_id_t ac_algo;
*/
        bool have_mode;
    CODE:
        New(0, RETVAL, 1, struct Crypt_GCrypt_s);
        s = SvPV_nolen(ST(0));
        if (strcmp(s, "Crypt::GCrypt") == 0) {
            i = 1;
        } else {
            i = 0;
        }
        if ((items-i % 2) == 1)
            croak("Wrong number of arguments for Crypt::GCrypt->new()");
            
        /* Default values: */
        RETVAL->type = -1;
        RETVAL->padding = CG_PADDING_STANDARD;
        RETVAL->action = CG_ACTION_NONE;
        RETVAL->need_to_call_finish = 0;
        RETVAL->buffer_is_decrypted = 0;
        RETVAL->buffer = NULL;
        c_flags = 0;
        ac_flags = 0;
        md_flags = 0;
        have_mode = 0;
        
        /* Let's get parameters: */
        while (i < items) {
            s = SvPV_nolen(ST(i));
            if (strcmp(s, "type") == 0) {
                s = SvPV_nolen(ST(i+1));
                if (strcmp(s, "cipher") == 0)
                    RETVAL->type = CG_TYPE_CIPHER;
                if (strcmp(s, "asymm") == 0)
                    RETVAL->type = CG_TYPE_ASYMM;
                if (strcmp(s, "digest") == 0)
                    RETVAL->type = CG_TYPE_DIGEST;
            }
            if (strcmp(s, "algorithm") == 0) {
                algo_s = SvPV_nolen(ST(i+1));
            }
            if (strcmp(s, "mode") == 0) {
                mode_s = SvPV_nolen(ST(i+1));
                have_mode = 1;
            }
            if (strcmp(s, "padding") == 0) {
                s = SvPV_nolen(ST(i+1));
                if (strcmp(s, "none") == 0)
                    RETVAL->padding = CG_PADDING_NONE;
                if (strcmp(s, "standard") == 0)
                    RETVAL->padding = CG_PADDING_STANDARD;
                if (strcmp(s, "null") == 0)
                    RETVAL->padding = CG_PADDING_NULL;
            }
            if (strcmp(s, "secure") == 0) {
                if (SvTRUE(ST(i+1))) {
                   c_flags |= GCRY_CIPHER_SECURE;
                   md_flags |= GCRY_MD_FLAG_SECURE;
                }
            }
            if (strcmp(s, "hmac") == 0) {
                key_s = SvPV(ST(i+1), RETVAL->keylen);
                md_flags |= GCRY_MD_FLAG_HMAC;
            }
            if (strcmp(s, "enable_sync") == 0) {
                if (SvTRUE(ST(i+1))) c_flags |= GCRY_CIPHER_ENABLE_SYNC;
            }
            i = i + 2;
        }
        if (RETVAL->type == -1)
            croak("No valid type specified for Crypt::GCrypt->new()");
        if (!algo_s)
            croak("No algorithm specified for Crypt::GCrypt->new()");

        init_library();

        if (RETVAL->type == CG_TYPE_CIPHER) {
            /* Checking algorithm */
            if (!(algo = gcry_cipher_map_name(algo_s)))
                croak("Unknown cipher algorithm %s", algo_s);
            RETVAL->blklen = gcry_cipher_get_algo_blklen(algo);
            RETVAL->keylen = gcry_cipher_get_algo_keylen(algo);
            
            /* Checking mode */
            if (have_mode) {
                switch (mode_s[0]) {
                    case 'e':
                        if (strcmp(mode_s+1, "cb") == 0)
                            RETVAL->mode = GCRY_CIPHER_MODE_ECB;
                        break;
                    case 'c':
                        if (strcmp(mode_s+1, "fb") == 0)
                            RETVAL->mode = GCRY_CIPHER_MODE_CFB;
                        else if (strcmp(mode_s+1, "bc") == 0)
                            RETVAL->mode = GCRY_CIPHER_MODE_CBC;
                        break;
                    case 's':
                        if (strcmp(mode_s+1, "tream") == 0)
                            RETVAL->mode = GCRY_CIPHER_MODE_STREAM;
                        break;
                    case 'o':
                        if (strcmp(mode_s+1, "fb") == 0)
                            RETVAL->mode = GCRY_CIPHER_MODE_OFB;
                        break;
                }
            } else {
                RETVAL->mode = RETVAL->blklen > 1 ? GCRY_CIPHER_MODE_CBC
                        : GCRY_CIPHER_MODE_STREAM;
            }
            if (!RETVAL->mode)
                croak("Unknown mode %s", mode_s);
            
            /* Init cipher */
            RETVAL->err = gcry_cipher_open(&RETVAL->h, algo, RETVAL->mode, c_flags);
            if (RETVAL->h == NULL) XSRETURN_UNDEF;
        }
        if (RETVAL->type == CG_TYPE_DIGEST) {
            if (!(algo = gcry_md_map_name(algo_s)))
                croak("Unknown digest algorithm %s", algo_s);

        RETVAL->err = gcry_md_open(&RETVAL->h_md, algo, md_flags);
            if (RETVAL->h_md == NULL) XSRETURN_UNDEF;

        if (md_flags & GCRY_MD_FLAG_HMAC) {
            /* what if this overwrites the earlier error value? */
            RETVAL->err = gcry_md_setkey(RETVAL->h_md, key_s, RETVAL->keylen);
        }
    }
        if (RETVAL->type == CG_TYPE_ASYMM) {
        
            croak("Asymmetric cryptography is not yet supported by Crypt::GCrypt");
            XSRETURN_UNDEF;
        }
        

    OUTPUT:
        RETVAL

SV *
cg_encrypt(gcr, in)
    Crypt_GCrypt gcr;
    SV *in;
    PREINIT:
        char *ibuf, *curbuf, *obuf;
        size_t len, ilen, buflen;
    CODE:
        if (gcr->action != CG_ACTION_ENCRYPT)
            croak("start('encrypting') was not called");
        
        ibuf = SvPV(in, ilen);
        
        if (gcr->padding == CG_PADDING_NONE && ilen % gcr->blklen > 0)
            croak("'None' padding requires that input to ->encrypt() is supplied as a multiple of blklen");
        
        /* Get total buffer+ibuf length */
        Newz(0, curbuf, ilen + gcr->buflen, char);
        memcpy(curbuf, gcr->buffer, gcr->buflen);
        memcpy(curbuf+gcr->buflen, ibuf, ilen);
        
        if ((len = (ilen+gcr->buflen) % gcr->blklen) == 0) {
            len = ilen+gcr->buflen;
            gcr->buffer[0] = '\0';
            gcr->buflen = 0;
        } else {
            char *tmpbuf;
            len = (ilen+gcr->buflen) - len;   /* len contiene i byte da scrivere effettivemente */
            
            Newz(0, tmpbuf, len, char);
            memcpy(tmpbuf, curbuf, len);
            memcpy(gcr->buffer, curbuf+len, (ilen+gcr->buflen)-len);
            gcr->buflen = (ilen+gcr->buflen)-len;
            Safefree(curbuf);
            curbuf = tmpbuf;
        }

        /* Encrypt data */
        New(0, obuf, len, char);
        if (len > 0) {
            if ((gcr->err = gcry_cipher_encrypt(gcr->h, obuf, len, curbuf, len)) != 0)
                croak("encrypt: %s", gcry_strerror(gcr->err));
        }
        RETVAL = newSVpvn(obuf, len);
        Safefree(curbuf);
        Safefree(obuf);
    OUTPUT:
        RETVAL

SV *
cg_finish(gcr)
    Crypt_GCrypt gcr;
    PREINIT:
        char *obuf;
        size_t rlen, return_len, padding_length;
    CODE:
        if (gcr->type != CG_TYPE_CIPHER)
            croak("Can't call finish when doing non-cipher operations");
        gcr->need_to_call_finish = 0;
        if (gcr->action == CG_ACTION_ENCRYPT) {
            
            if (gcr->buflen < gcr->blklen) {
                unsigned char *tmpbuf;
                rlen = gcr->blklen - gcr->buflen;
                Newz(0, tmpbuf, gcr->buflen+rlen, unsigned char);
                memcpy(tmpbuf, gcr->buffer, gcr->buflen);
                switch (gcr->padding) {
                    case CG_PADDING_STANDARD:
                        memset(tmpbuf + gcr->buflen, rlen, rlen);
                        break;
                    case CG_PADDING_NULL:
                        memset(tmpbuf + gcr->buflen, 0, rlen);
                        break;
                    case CG_PADDING_SPACE:
                        memset(tmpbuf + gcr->buflen, '\32', rlen);
                        break;
                }
                Safefree(gcr->buffer);
                gcr->buffer = tmpbuf;
            } else {
                if (gcr->padding == CG_PADDING_NULL && gcr->blklen == 8) {
                    unsigned char *tmpbuf;
                    Newz(0, tmpbuf, gcr->buflen+8, unsigned char);
                    memcpy(tmpbuf, gcr->buffer, gcr->buflen);
                    memset(tmpbuf + gcr->buflen, 0, 8);
                    Safefree(gcr->buffer);
                    gcr->buffer = tmpbuf;
                }
            }
            Newz(0, obuf, gcr->blklen, char);
            if ((gcr->err = gcry_cipher_encrypt(gcr->h, obuf, gcr->blklen, gcr->buffer, gcr->blklen)) != 0)
                croak("encrypt: %s", gcry_strerror(gcr->err));
            gcr->buffer[0] = '\0';
            gcr->buflen = 0;
            RETVAL = newSVpvn(obuf, gcr->blklen);
            Safefree(obuf);
            
        } else {  /* CG_ACTION_DECRYPT */
            
            /* decrypt remaining ciphertext if any */
            New(0, obuf, gcr->buflen, char);
            return_len = gcr->buflen;
            if (gcr->buflen > 0) {
                if (gcr->buffer_is_decrypted == 1) {
                    Move(gcr->buffer, obuf, gcr->buflen, char);
                } else {
                    if ((gcr->err = gcry_cipher_decrypt(gcr->h, obuf, return_len, gcr->buffer, gcr->buflen)) != 0)
                        croak("decrypt: %s", gcry_strerror(gcr->err));
                }
                gcr->buffer[0] = '\0';
                gcr->buflen = 0;
                
                /* Remove padding */
                return_len = find_padding(gcr, (unsigned char *) obuf, return_len);
            }
            
            RETVAL = newSVpvn(obuf, return_len);
            Safefree(obuf);
        }
    OUTPUT:
        RETVAL



SV *
cg_decrypt(gcr, in)
    Crypt_GCrypt gcr;
    SV *in;
    PREINIT:
        unsigned char *ibuf, *obuf, *ciphertext, *decrypted_buffer;
        size_t total_len, len, ilen;
        int ciphertext_offset;
    CODE:
        if (gcr->action != CG_ACTION_DECRYPT)
            croak("start('decrypting') was not called");
        
        ibuf = (unsigned char *) SvPV(in, ilen);
        if ((ilen % gcr->blklen) > 0 || ilen == 0)
            croak("input must be a multiple of blklen");
        
        /* Concatenate buffer and input to get total length of ciphertext */
        total_len = gcr->buflen + ilen;  /* total_len is a multiple of blklen */
        Newz(0, ciphertext, total_len, unsigned char);
        Move(gcr->buffer, ciphertext, gcr->buflen, unsigned char);
        Move(ibuf, ciphertext+gcr->buflen, ilen, unsigned char);
        
        /* if our buffer was decrypted by the previous run of this method,
           we set a ciphertext_offset to avoid re-decrypting such plaintext
           coming from the buffer */
        ciphertext_offset = (gcr->buffer_is_decrypted == 1) ? gcr->buflen : 0;
        
        /* strip last block and move it to buffer */
        len = total_len - gcr->blklen;  /* len is the length of plaintext we're returning */
        Move(ciphertext+len, gcr->buffer, (total_len - len), unsigned char);
        gcr->buflen = gcr->blklen;
        
        /* do actual decryption */
        New(0, obuf, len, unsigned char);
        Copy(ciphertext, obuf, ciphertext_offset, unsigned char);
        if (len-ciphertext_offset > 0) { /* that is, if we have something to decrypt */
            if ((gcr->err = gcry_cipher_decrypt(gcr->h, obuf+ciphertext_offset, len-ciphertext_offset, ciphertext+ciphertext_offset, len-ciphertext_offset)) != 0)
                croak("decrypt: %s", gcry_strerror(gcr->err));
        }
        Safefree(ciphertext);
        
        /* OPTIMIZATION for compatibility with implementations of Crypt::GCrypt <= 1.17:
           decrypt buffer and check if it seems padded */
        if ((gcr->err = gcry_cipher_decrypt(gcr->h, gcr->buffer, gcr->buflen, NULL, 0)) != 0) /* in-place decryption */
                         croak("decrypt: %s", gcry_strerror(gcr->err));
        gcr->buffer_is_decrypted = 1;
        if (find_padding(gcr, gcr->buffer, gcr->buflen) == -1) {
            /* if the string doesn't appear to be padded, let's append it to the
               output so that users who don't call ->finish() don't break their applications */
            Renew(obuf, len + gcr->buflen, unsigned char);
            Move(gcr->buffer, obuf+len, gcr->buflen, unsigned char);
            len = len + gcr->buflen;
            gcr->buffer[0] = '\0';
            gcr->buflen = 0;
            gcr->buffer_is_decrypted = 0;
        }
        RETVAL = newSVpvn((char *) obuf, len);
        Safefree(obuf);
    OUTPUT:
        RETVAL

void
cg_start(gcr, act)
    Crypt_GCrypt gcr;
    SV *act;
    PREINIT:
        char *action;
        size_t len;
    CODE:
        gcr->err = gcry_cipher_reset(gcr->h);
        Safefree(gcr->buffer);
        New(0, gcr->buffer, gcr->blklen, unsigned char);
        gcr->buflen = 0;
        gcr->need_to_call_finish = 1;
        action = SvPV(act, len);
        switch (action[0]) {
            case 'e':
                gcr->action = CG_ACTION_ENCRYPT;
                break;
            case 'd':
                gcr->action = CG_ACTION_DECRYPT;
                break;
        }

void
cg_setkey(gcr, ...)
    Crypt_GCrypt gcr;
    PREINIT:
        char *k, *s;
        char *mykey, *buf;
/*
        gcry_ac_key_type_t keytype;
        gcry_ac_data_t keydata;
*/
        gcry_mpi_t mpi;
        size_t len;
    CODE:
        /* Set key for cipher */
        if (gcr->type == CG_TYPE_CIPHER) {
            buf = NULL;
            mykey = SvPV(ST(1), len);
            /* If key is shorter than our algorithm's key size 
               let's pad it with zeroes */
            if (len < gcr->keylen) {
                Newz(0, buf, gcr->keylen, char);
                memcpy(buf, mykey, len);
                mykey = buf;
            }
            gcr->err = gcry_cipher_setkey(gcr->h, mykey, gcr->keylen);
            if (gcr->err != 0) croak("setkey: %s", gcry_strerror(gcr->err));
            Safefree(buf);
        }
        
        /* Set key for asymmetric criptography */
        if (gcr->type == CG_TYPE_ASYMM) {
            croak("Asymmetric cryptography is not yet supported by Crypt::GCrypt");
        }

void
cg_setiv(gcr, ...)
    Crypt_GCrypt gcr;
    PREINIT:
        char *buf, *param;
        size_t len;
    CODE:
        buf = NULL;
        if (gcr->type != CG_TYPE_CIPHER)
            croak("Can't call setiv when doing non-cipher operations");
        if (items == 2) {
            param = SvPV(ST(1), len);
            if (len < gcr->blklen) {
                Newz(0, buf, gcr->blklen, char);
                memcpy(buf, param, len);
                param = buf;
            }
        } else if (items == 1) {
            Newz(0, buf, gcr->blklen, char);
            param = buf;
        } else
            croak("Usage: $cipher->setiv([iv])");
        gcry_cipher_setiv(gcr->h, param, gcr->blklen);
        Safefree(buf);

void
cg_sync(gcr)
    Crypt_GCrypt gcr;
    CODE:
        if (gcr->type != CG_TYPE_CIPHER)
            croak("Can't call sync when doing non-cipher operations");
        gcry_cipher_sync(gcr->h);

int
cg_keylen(gcr)
    Crypt_GCrypt gcr;
    CODE:
        if (gcr->type != CG_TYPE_CIPHER)
            croak("Can't call keylen when doing non-cipher operations");
        RETVAL = gcr->keylen;
    OUTPUT:
        RETVAL

int
cg_blklen(gcr)
    Crypt_GCrypt gcr;
    CODE:
        if (gcr->type != CG_TYPE_CIPHER)
            croak("Can't call blklen when doing non-cipher operations");
        RETVAL = gcr->blklen;
    OUTPUT:
        RETVAL

void
cg_reset(gcr)
    Crypt_GCrypt gcr;
    CODE:
        if (gcr->type != CG_TYPE_DIGEST)
            croak("Can't call reset when doing non-digest operations");
        gcry_md_reset(gcr->h_md);

void
cg_write(gcr, in)
    Crypt_GCrypt gcr;
    SV *in;
    PREINIT:
        char *ibuf;
        size_t ilen;
    CODE:
        if (gcr->type != CG_TYPE_DIGEST)
            croak("Can't call write when doing non-digest operations.");
        ibuf = SvPV(in, ilen);
        gcry_md_write(gcr->h_md, ibuf, ilen);

SV *
cg_read(gcr)
    Crypt_GCrypt gcr;
    PREINIT:
        unsigned char *output;
        size_t len;
    CODE:
        if (gcr->type != CG_TYPE_DIGEST)
            croak("Can't call read when doing non-digest operations.");
        output = gcry_md_read(gcr->h_md, 0);
        len = gcry_md_get_algo_dlen(gcry_md_get_algo(gcr->h_md));
        RETVAL = newSVpvn((const char *) output, len);
    OUTPUT:
        RETVAL

int
cg_digest_length(gcr)
    Crypt_GCrypt gcr;
    CODE:
        if (gcr->type != CG_TYPE_DIGEST)
            croak("Can't call digest_length when doing non-digest operations");
        RETVAL = gcry_md_get_algo_dlen(gcry_md_get_algo(gcr->h_md));
    OUTPUT:
        RETVAL

Crypt_GCrypt
cg_clone(gcr)
    Crypt_GCrypt gcr;
    CODE:
        if (gcr->type != CG_TYPE_DIGEST)
            croak("Crypt::GCrypt::clone() is only currently defined for digest objects");
        
        New(0, RETVAL, 1, struct Crypt_GCrypt_s);
        Copy(gcr, RETVAL, 1, struct Crypt_GCrypt_s);
        /* if we allow clone() for cipher objects, we should duplicate the buffer */
        RETVAL->err = gcry_md_copy(&RETVAL->h_md, gcr->h_md);
        if (RETVAL->h_md == NULL) XSRETURN_UNDEF;
    OUTPUT:
        RETVAL

int
cg_digest_algo_available(algo)
    SV *algo;
    PREINIT:
        const char *algo_s;
        int algo_id;
    CODE:
        algo_s = SvPV_nolen(algo);
        init_library();
        algo_id = gcry_md_map_name(algo_s);
        if (algo_id) {
            if (gcry_md_test_algo(algo_id))
                RETVAL = 0;
            else
                RETVAL = 1;
        } else {
            RETVAL = 0;
        }
    OUTPUT:
        RETVAL

int
cg_cipher_algo_available(algo)
    SV *algo;
    PREINIT:
        const char *algo_s;
        int algo_id;
    CODE:
        algo_s = SvPV_nolen(algo);
        init_library();
        algo_id = gcry_cipher_map_name(algo_s);
        if (algo_id) {
            if (gcry_cipher_algo_info(algo_id, GCRYCTL_TEST_ALGO, 0, 0))
                RETVAL = 0;
            else
                RETVAL = 1;
        } else {
            RETVAL = 0;
        }
    OUTPUT:
        RETVAL

void
cg_DESTROY(gcr)
    Crypt_GCrypt gcr;
    CODE:
        if (gcr->type == CG_TYPE_CIPHER) gcry_cipher_close(gcr->h);
/*
        if (gcr->type == CG_TYPE_ASYMM)  gcry_ac_close(gcr->h_ac);
*/
        if (gcr->type == CG_TYPE_DIGEST) gcry_md_close(gcr->h_md);
        
        if (gcr->need_to_call_finish == 1)
            warn("WARNING: the ->finish() method was not called after encryption/decryption.");
            
        Safefree(gcr->buffer);
        Safefree(gcr);

MODULE = Crypt::GCrypt        PACKAGE = Crypt::GCrypt::MPI    PREFIX = cgm_

BOOT:
    { /* found this method of storing constants in
         http://blogs.sun.com/akolb/entry/pitfals_of_the_perl_xs */
    HV *stash;
    
    stash = gv_stashpv("Crypt::GCrypt::MPI", TRUE);
    newCONSTSUB(stash, "FMT_STD", newSViv(GCRYMPI_FMT_STD));
    newCONSTSUB(stash, "FMT_PGP", newSViv(GCRYMPI_FMT_PGP));
    newCONSTSUB(stash, "FMT_SSH", newSViv(GCRYMPI_FMT_SSH));
    newCONSTSUB(stash, "FMT_HEX", newSViv(GCRYMPI_FMT_HEX));
    newCONSTSUB(stash, "FMT_USG", newSViv(GCRYMPI_FMT_USG));
    }

Crypt_GCrypt_MPI
cgm_new(...)
    PROTOTYPE: @
    PREINIT:
        char *s;
        int i, valix, secure, set, format;
        Crypt_GCrypt_MPI src;
        size_t len;
        gcry_error_t err;       
    CODE:
        RETVAL = NULL;
        secure = 0;
        valix = -1;
        format = GCRYMPI_FMT_STD;
        set = 0;
        s = SvPV_nolen(ST(0));
        if (strcmp(s, "Crypt::GCrypt::MPI") == 0) {
            i = 1;
        } else {
            i = 0;
        }
        if ((items-i > 1) && ((items-i % 2) == 1))
            croak("Wrong number of arguments for Crypt::GCrypt::MPI->new()");
        if (items-i == 1) {
           /* this is the value */
           valix = i;
        } else {
           /* this is a parameterized list */
           while (i < items) {
             s = SvPV_nolen(ST(i));

             if (strcmp(s, "secure") == 0)
                if (SvTRUE(ST(i+1)))
                  secure = 1;
             if (strcmp(s, "format") == 0)
                format = SvIV(ST((i+1)));
             if (strcmp(s, "value") == 0)
                valix = i + 1;
             i += 2;
           }
        }

        /* we're copying an mpi: */
        if ((valix >= 0) && sv_derived_from(ST(valix), "Crypt::GCrypt::MPI")) {
          IV tmp = SvIV((SV*)SvRV(ST(valix))); /* found this incantation at */
          src = INT2PTR(Crypt_GCrypt_MPI,tmp); /* http://cpansearch.perl.org/src/DSTH/Math-GSL-Linalg-SVD-0.0.2/SVD.c */
          if (secure && ! gcry_mpi_get_flag(src, GCRYMPI_FLAG_SECURE)) {
            /* we were asked for a secure MPI, but we were given an insecure one to copy */
            RETVAL=gcry_mpi_snew(gcry_mpi_get_nbits(src));
            if (RETVAL == NULL) XSRETURN_UNDEF;
            gcry_mpi_set(RETVAL, src);
          } else {
            /* this will give us a secure MPI if a secure MPI was passed in, even if we
               also got secure => 0 ; a bit weird, but on the safe side. */
            RETVAL=gcry_mpi_copy(src);
          }
        } else {
          if (secure) {
            RETVAL=gcry_mpi_snew(0);
          } else {
            RETVAL=gcry_mpi_new(0);
          }
          if (RETVAL == NULL) XSRETURN_UNDEF;

          /* do something with the info at valix */
          if (valix >= 0) {
            switch(SvTYPE(ST(valix))) {
              case SVt_PVIV:
                /* if negative value, we have to jump through some hoops: */
                if (SvIV(ST(valix)) < 0) {
                    RETVAL=gcry_mpi_set_ui(NULL, 0);
                    gcry_mpi_sub_ui(RETVAL, RETVAL, -1*(SvIV(ST(valix))));
                } else {
                /* this can be dealt with by regular unsigned ints */
                    gcry_mpi_set_ui(RETVAL, SvIV(ST(valix)));
                }
                break;
              case SVt_PV:
                /* handle bytestrings 
                   */
                s = SvPV(ST(valix), len);
                src = NULL;
                err = gcry_mpi_scan(&src, format, s, ((format == GCRYMPI_FMT_HEX) ? 0 : len), NULL);
                if (err != 0) croak("Crypt::GCrypt::MPI::new (from string, with format %d) libgcrypt internal failure %s", format, gcry_strerror(err));
                /* FIXME: can we "eat" the head of the the input string if format is FMT_PGP or FMT_SSH ? */
                /* avoid memory leak: */
                if (secure) {
                   gcry_mpi_set(RETVAL, src);
                   gcry_mpi_release(src);
                } else {
                   gcry_mpi_release(RETVAL);
                   RETVAL = src;
                }
                break;
              default:
                croak("value argument for Crypt::GCrypt::MPI->new() must currently be either an int or another Crypt::GCrypt::MPI (%d, %d, %d)", SvTYPE(ST(valix)), valix, format);
                break;
            }
          }
        }
    OUTPUT:
        RETVAL

void
cgm_swap(sv_gcma, gcmb)
    SV* sv_gcma;
    Crypt_GCrypt_MPI gcmb;
    PPCODE:
        Crypt_GCrypt_MPI gcma = dereference_gcm(sv_gcma);
        gcry_mpi_swap(gcma, gcmb);
        ST(0) = sv_gcma;
        XSRETURN(1);

void
cgm_set(sv_gcma, gcmb)
    SV* sv_gcma;
    Crypt_GCrypt_MPI gcmb;
    PPCODE:
        Crypt_GCrypt_MPI gcma = dereference_gcm(sv_gcma);
        gcry_mpi_set(gcma, gcmb);
        ST(0) = sv_gcma;
        XSRETURN(1);

bool
cgm_is_secure(gcm)
    Crypt_GCrypt_MPI gcm;
    CODE:
        RETVAL=gcry_mpi_get_flag(gcm, GCRYMPI_FLAG_SECURE);
    OUTPUT:
        RETVAL

int
cgm_cmp(gcma, gcmb)
    Crypt_GCrypt_MPI gcma;
    Crypt_GCrypt_MPI gcmb;
    CODE:
        RETVAL=gcry_mpi_cmp(gcma, gcmb);
    OUTPUT:
        RETVAL

Crypt_GCrypt_MPI
cgm_copy(gcm)
    Crypt_GCrypt_MPI gcm;
    CODE:
        RETVAL=gcry_mpi_copy(gcm);
    OUTPUT:
        RETVAL

void
cgm_add(sv_gcma, gcmb)
    SV* sv_gcma;
    Crypt_GCrypt_MPI gcmb;
    PPCODE:
        Crypt_GCrypt_MPI gcma = dereference_gcm(sv_gcma);
        gcry_mpi_add(gcma, gcma, gcmb);
        ST(0) = sv_gcma;
        XSRETURN(1);

void
cgm_addm(sv_gcma, gcmb, gcmm)
    SV* sv_gcma;
    Crypt_GCrypt_MPI gcmb;
    Crypt_GCrypt_MPI gcmm;
    PPCODE:
        Crypt_GCrypt_MPI gcma = dereference_gcm(sv_gcma);
        gcry_mpi_addm(gcma, gcma, gcmb, gcmm);
        ST(0) = sv_gcma;
        XSRETURN(1);

void
cgm_sub(sv_gcma, gcmb)
    SV* sv_gcma;
    Crypt_GCrypt_MPI gcmb;
    PPCODE:
        Crypt_GCrypt_MPI gcma = dereference_gcm(sv_gcma);
        gcry_mpi_sub(gcma, gcma, gcmb);
        ST(0) = sv_gcma;
        XSRETURN(1);

void
cgm_subm(sv_gcma, gcmb, gcmm)
    SV* sv_gcma;
    Crypt_GCrypt_MPI gcmb;
    Crypt_GCrypt_MPI gcmm;
    PPCODE:
        Crypt_GCrypt_MPI gcma = dereference_gcm(sv_gcma);
        gcry_mpi_subm(gcma, gcma, gcmb, gcmm);
        ST(0) = sv_gcma;
        XSRETURN(1);

void
cgm_mul(sv_gcma, gcmb)
    SV* sv_gcma;
    Crypt_GCrypt_MPI gcmb;
    PPCODE:
        Crypt_GCrypt_MPI gcma = dereference_gcm(sv_gcma);
        gcry_mpi_mul(gcma, gcma, gcmb);
        ST(0) = sv_gcma;
        XSRETURN(1);

void
cgm_mulm(sv_gcma, gcmb, gcmm)
    SV* sv_gcma;
    Crypt_GCrypt_MPI gcmb;
    Crypt_GCrypt_MPI gcmm;
    PPCODE:
        Crypt_GCrypt_MPI gcma = dereference_gcm(sv_gcma);
        gcry_mpi_mulm(gcma, gcma, gcmb, gcmm);
        ST(0) = sv_gcma;
        XSRETURN(1);

void
cgm_mul_2exp(sv_gcm, e)
    SV* sv_gcm;
    int e;
    PPCODE:
        Crypt_GCrypt_MPI gcm = dereference_gcm(sv_gcm);
        if (e >= 0) {
          /* this can be dealt with by regular unsigned ints */
          gcry_mpi_mul_2exp(gcm, gcm, e);
        } else {
          croak("exponent argument for Crypt::GCrypt::MPI::mul_2exp() must be an unsigned integer");
        }
        ST(0) = sv_gcm;
        XSRETURN(1);
            
void
cgm_div(sv_gcma, gcmb)
    SV* sv_gcma;
    Crypt_GCrypt_MPI gcmb;
    PPCODE:
        Crypt_GCrypt_MPI gcma = dereference_gcm(sv_gcma);
        gcry_mpi_div(gcma, NULL, gcma, gcmb, 0);
        ST(0) = sv_gcma;
        /* FIXME: should we return the remainder as well, if called in a list context? */
        XSRETURN(1);

void
cgm_mod(sv_gcma, gcmb)
    SV* sv_gcma;
    Crypt_GCrypt_MPI gcmb;
    PPCODE:
        Crypt_GCrypt_MPI gcma = dereference_gcm(sv_gcma);
        gcry_mpi_mod(gcma, gcma, gcmb);
        ST(0) = sv_gcma;
        XSRETURN(1);

void
cgm_powm(sv_gcma, gcme, gcmm)
    SV* sv_gcma;
    Crypt_GCrypt_MPI gcme;
    Crypt_GCrypt_MPI gcmm;
    PPCODE:
        Crypt_GCrypt_MPI gcma = dereference_gcm(sv_gcma);
        gcry_mpi_powm(gcma, gcma, gcme, gcmm);
        ST(0) = sv_gcma;
        XSRETURN(1);

void
cgm_invm(sv_gcma, gcmb)
    SV* sv_gcma;
    Crypt_GCrypt_MPI gcmb;
    PPCODE:
        Crypt_GCrypt_MPI gcma = dereference_gcm(sv_gcma);
        gcry_mpi_invm(gcma, gcma, gcmb);
        ST(0) = sv_gcma;
        /* FIXME: should we do anything with the return value (1 if invm actually exists)? */
        XSRETURN(1);

void
cgm_gcd(sv_gcma, gcmb)
    SV* sv_gcma;
    Crypt_GCrypt_MPI gcmb;
    PPCODE:
        Crypt_GCrypt_MPI gcma = dereference_gcm(sv_gcma);
        gcry_mpi_gcd(gcma, gcma, gcmb);
        ST(0) = sv_gcma;
        XSRETURN(1);

bool
cgm_mutually_prime(gcma, gcmb)
    Crypt_GCrypt_MPI gcma;
    Crypt_GCrypt_MPI gcmb;
    PREINIT:
        Crypt_GCrypt_MPI gcd;
    CODE:
        gcd = gcry_mpi_new(0);
        RETVAL=gcry_mpi_gcd(gcd, gcma, gcmb);
        gcry_mpi_release(gcd);
    OUTPUT:
        RETVAL

void
cgm_dump(sv_gcm)
    SV* sv_gcm;
    PPCODE:
        Crypt_GCrypt_MPI gcm = dereference_gcm(sv_gcm);
        gcry_mpi_dump(gcm);
        ST(0) = sv_gcm;
        XSRETURN(1);

SV *
cgm_print(gcm, format)
    Crypt_GCrypt_MPI gcm;
    int format;
    PREINIT:
        size_t size;
        unsigned char* buf;
        gcry_error_t err;
    CODE:
        /* FIXME: make format default to FMT_STD somehow (how do we not require a parameter?) */
        err = gcry_mpi_print(format, NULL, 0, &size,  gcm);
        if (err != 0) croak("GCrypt::MPI::print start: %s", gcry_strerror(err));
        /* FMT_HEX asks for an extra byte for the null char, but perl allocates that
           already, so we treat that case special */
        RETVAL = newSVpv("", ((format == GCRYMPI_FMT_HEX) ? size-1 : size));
        buf = (unsigned char*) SvPV_nolen(RETVAL);
        err = gcry_mpi_print(format, buf, size, &size,  gcm);
        if (err != 0) croak("GCrypt::MPI::print finish: %s", gcry_strerror(err));
    OUTPUT:
        RETVAL

void
cgm_DESTROY(gmpi)
    Crypt_GCrypt_MPI gmpi;
    CODE:
        gcry_mpi_release(gmpi);
        gmpi = NULL;