Crypt-GCrypt-1.26/000755 000765 000024 00000000000 12150170166 013507 5ustar00alstaff000000 000000 Crypt-GCrypt-1.26/Changelog000644 000765 000024 00000005724 12150170053 015324 0ustar00alstaff000000 000000 version 1.26 (2013/05/13): - updated Devel::CheckLib for compatibility with perl 5.18 - POD encoding fix version 1.25 (2011/07/26): - setting CLONE_SKIP to avoid Crypt::GCrypt objects to be shared among threads (fixes #55127) version 1.24 (2010/02/02): - added multi-precision integers as Crypt::GCrypt::MPI (dkg) version 1.23_04 (2009/12/18): - Makefile.PL now requires libgcrypt being not older than 1.3.0 version 1.23_03 (2009/12/07): - fixes to make 07-thread.t pass (or skip) regardless of thread support or libgcrypt version version 1.23_02 (2009/11/24): - 07-thread.t now passes on MacOS X (dkg) - don't try to link to pthread.h if perl isn't compiled with ithreads and Pthread version 1.23_01 (2009/11/24): - added new version check functions gcrypt_version() and built_against_version() (Daniel Kahn Gillmor) - fixed a memory leak and other minor memory optimizations (Daniel Kahn Gillmor) - new cipher_algo_available() package function (Daniel Kahn Gillmor) - message digests (Daniel Kahn Gillmor) - new 07-thread.t test (Daniel Kahn Gillmor) version 1.22 (2009/11/01): - now thread-safe (patch by Daniel K. Gillmor) version 1.21 (2009/02/04): - added Devel::CheckLib to avoid FAIL reports from CPAN testers version 1.20 (2008/01/25): - new "none" padding method - added an optimization to make the new API a bit retrocompatible in some special cases - padding recognition is more robust - [API CHANGE] ->finish() is now required after decrypting, because the previous implementation contained a bug when decrypting data in multiple calls to ->decrypt(): the module tried to strip padding at every call, thus removing wrong bytes in some cases. Added the 06-multi.t test and a warning for users who don't call the ->finish() method. (thanks to Paul Kolano for bug report and test case) version 1.17 (2007/10/29): - removed warnings on platforms with signed chars (untested) version 1.16 (2006/12/20): - fixed compilation issue with GCC 2.95 - test compatibility with Crypt::CBC 2.17 - minor code cleanup version 1.15 (2006/01/06): - fixed t/05-size.t (now skips if we don't have Devel::Size) version 1.14 (2006/01/06): - fixed compilation on Solaris (thanks to Andre Schmidt for bug report) - fixed minor memory leaks - added t/05-size.t - changed version numbering format - minor changes and typo fixes in POD version 1.1.3 (2005/12/27): - fixed typo in Makefile.PL - fixed pointer types in XS code version 1.1.1 (2005/12/22): - minor bug fixes - fixed typo in POD - improved Makefile.PL for locating libgcrypt - added t/03-pod.t and t/04-podcoverage.t version 1.1 (2005/10/10): - added finish() to handle partial blocks - added padding with null and standard methods - added compatibility test with Crypt::CBC version 1.00 (2005/10/09): - new Crypt-GCrypt-1.26/GCrypt.xs000644 000765 000024 00000106561 11570001663 015304 0ustar00alstaff000000 000000 /* =========================================================================== Crypt::GCrypt Perl interface to the GNU Cryptographic library Author: Alessandro Ranellucci Use this software AT YOUR OWN RISK. =========================================================================== */ #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "ppport.h" #include #include #ifdef USE_ITHREADS #ifdef I_PTHREAD #include #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 "; 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 = (int) p - (int) 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 = (int) p - (int) 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, *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"); RETVAL->err = gcry_ac_name_to_id(algo_s, &ac_algo); if (RETVAL->err) croak("Unknown algorithm %s", algo_s); /* Init ac */ RETVAL->err = gcry_ac_open(&RETVAL->h_ac, ac_algo, ac_flags); if (RETVAL->h_ac == NULL) 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 SV * cg_sign(gcr, in) Crypt_GCrypt gcr; SV *in; PREINIT: gcry_mpi_t in_mpi, out_mpi; gcry_ac_data_t outdata; size_t len; const void *inbuf; const char *label; char* outbuf; CODE: /* in_mpi = gcry_mpi_new(0); out_mpi = gcry_mpi_new(0); inbuf = SvPV(in, len); printf("inbuf: %s\n", inbuf); gcry_mpi_scan( &in_mpi, GCRYMPI_FMT_STD, inbuf, strlen(inbuf), NULL ); printf("Key: %s\n", gcr->key_ac); gcr->err = gcry_ac_data_sign(gcr->h_ac, gcr->key_ac, in_mpi, &outdata); if (gcr->err) { croak( gcry_strerror(gcr->err) ); } printf("Here\n"); gcr->err = gcry_ac_data_get_index (outdata, 0, 0, &label, &out_mpi); printf("Before (%s)\n", label); gcry_mpi_print(GCRYMPI_FMT_STD, outbuf, 1024, NULL, out_mpi); printf("After\n"); RETVAL = newSVpv(outbuf, 0); */ 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) { k = SvPV(ST(2), len); /* Key type */ keytype = -1; s = SvPV(ST(1), len); if (strcmp(s, "private") == 0) keytype = GCRY_AC_KEY_SECRET; if (strcmp(s, "public") == 0) keytype = GCRY_AC_KEY_PUBLIC; if (keytype == -1) croak("Key must be private or public"); gcry_control(GCRYCTL_INIT_SECMEM, strlen(k)); mpi = gcry_mpi_snew(0); /* gcry_mpi_scan( &mpi, GCRYMPI_FMT_STD, k, NULL, NULL ); */ gcr->err = gcry_ac_data_new(&keydata); gcr->err = gcry_ac_data_set(keydata, GCRY_AC_FLAG_COPY, "s", mpi); gcr->err = gcry_ac_key_init(&gcr->key_ac, gcr->h_ac, keytype, keydata); } 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; Crypt-GCrypt-1.26/inc/000755 000765 000024 00000000000 12150170166 014260 5ustar00alstaff000000 000000 Crypt-GCrypt-1.26/lib/000755 000765 000024 00000000000 12150170166 014255 5ustar00alstaff000000 000000 Crypt-GCrypt-1.26/Makefile.PL000644 000765 000024 00000003775 12150167702 015477 0ustar00alstaff000000 000000 use lib qw(inc); use Devel::CheckLib; # Prompt the user here for any paths and other configuration check_lib_or_exit( # fill in what you prompted the user for here lib => [qw()] ); use lib qw(inc); use Devel::CheckLib; use ExtUtils::MakeMaker; use Config; use strict; use warnings; use 5.006000; my $gcrypt_libpath = ''; my $gcrypt_incpath = ''; # let's check for GCRYPTLIBPATH and GCRYPTINCPATH options # removing them from @ARGV foreach (@ARGV) { /^GCRYPTLIBPATH=(.+)/ && ($gcrypt_libpath = $1); /^GCRYPTINCPATH=(.+)/ && ($gcrypt_incpath = $1); } @ARGV = grep !/^GCRYPT(?:LIB|INC)PATH=/, @ARGV; # if we still need $gcrypt_libpath let's try the default # locations if (not $gcrypt_libpath and $] >= 5.006001) { require ExtUtils::Liblist; ($gcrypt_libpath) = ExtUtils::Liblist->ext('-lgcrypt'); } # let's check with Devel::CheckLib; we need version 1.3.0 or later # because earlier libgcrypt versions have broken message digest # calculations for HMAC of some members of the SHA-2 family (including # SHA-512) check_lib_or_exit( function => 'if (gcry_check_version("1.3.0")) return 0; else return 1;', lib => [qw(gcrypt)], libpath => $gcrypt_libpath ); # now build the options list for WriteMakefile() my @extras = $gcrypt_incpath ? (INC => "-I$gcrypt_incpath") : (); my $libs = $gcrypt_libpath ? "-L$gcrypt_libpath -lgcrypt" : '-lgcrypt'; WriteMakefile( 'NAME' => 'Crypt::GCrypt', 'ABSTRACT' => 'Perl interface to the GNU libgcrypt library', 'AUTHOR' => 'Alessandro Ranellucci ', 'VERSION_FROM' => 'lib/Crypt/GCrypt.pm', 'LIBS' => $libs, 'DEFINE' => '', 'CCFLAGS' => "-funsigned-char $Config{ccflags}", 'dist' => { COMPRESS => 'gzip', SUFFIX => 'gz' }, 'DISTNAME' => 'Crypt-GCrypt', 'LICENSE' => 'perl', 'test' => { 'TESTS' => 't/*.t' }, 'META_MERGE' => { resources => { repository => 'git://github.com/alexrj/Crypt-GCrypt.git', }, }, @extras ); Crypt-GCrypt-1.26/MANIFEST000644 000765 000024 00000000720 12150170166 014637 0ustar00alstaff000000 000000 Changelog GCrypt.xs inc/Devel/CheckLib.pm lib/Crypt/GCrypt.pm lib/Crypt/GCrypt/MPI.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP META.yml Module meta-data (added by MakeMaker) ppport.h README t/01-cipher.t t/02-compatibility.t t/03-pod.t t/04-podcoverage.t t/05-size.t t/06-multi.t t/07-thread.t t/08-digest.t t/09-clone-digest.t t/10-versions.t t/20-mpi.t typemap META.json Module JSON meta-data (added by MakeMaker) Crypt-GCrypt-1.26/MANIFEST.SKIP000644 000765 000024 00000000764 11613573426 015425 0ustar00alstaff000000 000000 makedocs.pl \.shipit \.brackup$ \.DS_Store$ # Avoid version control files. \bRCS\b \bCVS\b \bSCCS\b ,v$ \B\.svn\b \B\.git\b \b_darcs\b # Avoid Makemaker generated and utility files. \bMANIFEST\.bak \bMakefile$ \bblib/ \bMakeMaker-\d \bpm_to_blib\.ts$ \bpm_to_blib$ \bblibdirs\.ts$ # 6.18 through 6.25 generated this # Avoid Module::Build generated and utility files. \bBuild$ \b_build/ # Avoid temp and backup files. ~$ \.old$ \#$ \b\.# \.bak$ # Avoid Devel::Cover files. \bcover_db\b Crypt-GCrypt-1.26/META.json000644 000765 000024 00000001712 12150170166 015131 0ustar00alstaff000000 000000 { "abstract" : "Perl interface to the GNU libgcrypt library", "author" : [ "Alessandro Ranellucci " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.120630", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Crypt-GCrypt", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : {} } }, "release_status" : "stable", "resources" : { "repository" : { "url" : "git://github.com/alexrj/Crypt-GCrypt.git" } }, "version" : "1.26" } Crypt-GCrypt-1.26/META.yml000644 000765 000024 00000001060 12150170166 014755 0ustar00alstaff000000 000000 --- abstract: 'Perl interface to the GNU libgcrypt library' author: - 'Alessandro Ranellucci ' build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.120630' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Crypt-GCrypt no_index: directory: - t - inc requires: {} resources: repository: git://github.com/alexrj/Crypt-GCrypt.git version: 1.26 Crypt-GCrypt-1.26/ppport.h000644 000765 000024 00000034705 11570001663 015215 0ustar00alstaff000000 000000 /* ppport.h -- Perl/Pollution/Portability Version 2.0002 * * Automatically Created by Devel::PPPort on Sat Nov 30 14:37:45 2002 * * Do NOT edit this file directly! -- Edit PPPort.pm instead. * * Version 2.x, Copyright (C) 2001, Paul Marquess. * Version 1.x, Copyright (C) 1999, Kenneth Albanowski. * This code may be used and distributed under the same license as any * version of Perl. * * This version of ppport.h is designed to support operation with Perl * installations back to 5.004, and has been tested up to 5.8.0. * * If this version of ppport.h is failing during the compilation of this * module, please check if a newer version of Devel::PPPort is available * on CPAN before sending a bug report. * * If you are using the latest version of Devel::PPPort and it is failing * during compilation of this module, please send a report to perlbug@perl.com * * Include all following information: * * 1. The complete output from running "perl -V" * * 2. This file. * * 3. The name & version of the module you were trying to build. * * 4. A full log of the build that failed. * * 5. Any other information that you think could be relevant. * * * For the latest version of this code, please retreive the Devel::PPPort * module from CPAN. * */ /* * In order for a Perl extension module to be as portable as possible * across differing versions of Perl itself, certain steps need to be taken. * Including this header is the first major one, then using dTHR is all the * appropriate places and using a PL_ prefix to refer to global Perl * variables is the second. * */ /* If you use one of a few functions that were not present in earlier * versions of Perl, please add a define before the inclusion of ppport.h * for a static include, or use the GLOBAL request in a single module to * produce a global definition that can be referenced from the other * modules. * * Function: Static define: Extern define: * newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL * */ /* To verify whether ppport.h is needed for your module, and whether any * special defines should be used, ppport.h can be run through Perl to check * your source code. Simply say: * * perl -x ppport.h *.c *.h *.xs foo/bar*.c [etc] * * The result will be a list of patches suggesting changes that should at * least be acceptable, if not necessarily the most efficient solution, or a * fix for all possible problems. It won't catch where dTHR is needed, and * doesn't attempt to account for global macro or function definitions, * nested includes, typemaps, etc. * * In order to test for the need of dTHR, please try your module under a * recent version of Perl that has threading compiled-in. * */ /* #!/usr/bin/perl @ARGV = ("*.xs") if !@ARGV; %badmacros = %funcs = %macros = (); $replace = 0; foreach () { $funcs{$1} = 1 if /Provide:\s+(\S+)/; $macros{$1} = 1 if /^#\s*define\s+([a-zA-Z0-9_]+)/; $replace = $1 if /Replace:\s+(\d+)/; $badmacros{$2}=$1 if $replace and /^#\s*define\s+([a-zA-Z0-9_]+).*?\s+([a-zA-Z0-9_]+)/; $badmacros{$1}=$2 if /Replace (\S+) with (\S+)/; } foreach $filename (map(glob($_),@ARGV)) { unless (open(IN, "<$filename")) { warn "Unable to read from $file: $!\n"; next; } print "Scanning $filename...\n"; $c = ""; while () { $c .= $_; } close(IN); $need_include = 0; %add_func = (); $changes = 0; $has_include = ($c =~ /#.*include.*ppport/m); foreach $func (keys %funcs) { if ($c =~ /#.*define.*\bNEED_$func(_GLOBAL)?\b/m) { if ($c !~ /\b$func\b/m) { print "If $func isn't needed, you don't need to request it.\n" if $changes += ($c =~ s/^.*#.*define.*\bNEED_$func\b.*\n//m); } else { print "Uses $func\n"; $need_include = 1; } } else { if ($c =~ /\b$func\b/m) { $add_func{$func} =1 ; print "Uses $func\n"; $need_include = 1; } } } if (not $need_include) { foreach $macro (keys %macros) { if ($c =~ /\b$macro\b/m) { print "Uses $macro\n"; $need_include = 1; } } } foreach $badmacro (keys %badmacros) { if ($c =~ /\b$badmacro\b/m) { $changes += ($c =~ s/\b$badmacro\b/$badmacros{$badmacro}/gm); print "Uses $badmacros{$badmacro} (instead of $badmacro)\n"; $need_include = 1; } } if (scalar(keys %add_func) or $need_include != $has_include) { if (!$has_include) { $inc = join('',map("#define NEED_$_\n", sort keys %add_func)). "#include \"ppport.h\"\n"; $c = "$inc$c" unless $c =~ s/#.*include.*XSUB.*\n/$&$inc/m; } elsif (keys %add_func) { $inc = join('',map("#define NEED_$_\n", sort keys %add_func)); $c = "$inc$c" unless $c =~ s/^.*#.*include.*ppport.*$/$inc$&/m; } if (!$need_include) { print "Doesn't seem to need ppport.h.\n"; $c =~ s/^.*#.*include.*ppport.*\n//m; } $changes++; } if ($changes) { open(OUT,">/tmp/ppport.h.$$"); print OUT $c; close(OUT); open(DIFF, "diff -u $filename /tmp/ppport.h.$$|"); while () { s!/tmp/ppport\.h\.$$!$filename.patched!; print STDOUT; } close(DIFF); unlink("/tmp/ppport.h.$$"); } else { print "Looks OK\n"; } } __DATA__ */ #ifndef _P_P_PORTABILITY_H_ #define _P_P_PORTABILITY_H_ #ifndef PERL_REVISION # ifndef __PATCHLEVEL_H_INCLUDED__ # include "patchlevel.h" # endif # ifndef PERL_REVISION # define PERL_REVISION (5) /* Replace: 1 */ # define PERL_VERSION PATCHLEVEL # define PERL_SUBVERSION SUBVERSION /* Replace PERL_PATCHLEVEL with PERL_VERSION */ /* Replace: 0 */ # endif #endif #define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION) /* It is very unlikely that anyone will try to use this with Perl 6 (or greater), but who knows. */ #if PERL_REVISION != 5 # error ppport.h only works with Perl version 5 #endif /* PERL_REVISION != 5 */ #ifndef ERRSV # define ERRSV perl_get_sv("@",FALSE) #endif #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5)) /* Replace: 1 */ # define PL_Sv Sv # define PL_compiling compiling # define PL_copline copline # define PL_curcop curcop # define PL_curstash curstash # define PL_defgv defgv # define PL_dirty dirty # define PL_dowarn dowarn # define PL_hints hints # define PL_na na # define PL_perldb perldb # define PL_rsfp_filters rsfp_filters # define PL_rsfpv rsfp # define PL_stdingv stdingv # define PL_sv_no sv_no # define PL_sv_undef sv_undef # define PL_sv_yes sv_yes /* Replace: 0 */ #endif #ifdef HASATTRIBUTE # if defined(__GNUC__) && defined(__cplusplus) # define PERL_UNUSED_DECL # else # define PERL_UNUSED_DECL __attribute__((unused)) # endif #else # define PERL_UNUSED_DECL #endif #ifndef dNOOP # define NOOP (void)0 # define dNOOP extern int Perl___notused PERL_UNUSED_DECL #endif #ifndef dTHR # define dTHR dNOOP #endif #ifndef dTHX # define dTHX dNOOP # define dTHXa(x) dNOOP # define dTHXoa(x) dNOOP #endif #ifndef pTHX # define pTHX void # define pTHX_ # define aTHX # define aTHX_ #endif #ifndef UVSIZE # define UVSIZE IVSIZE #endif #ifndef NVTYPE # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) # define NVTYPE long double # else # define NVTYPE double # endif typedef NVTYPE NV; #endif #ifndef INT2PTR #if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE) # define PTRV UV # define INT2PTR(any,d) (any)(d) #else # if PTRSIZE == LONGSIZE # define PTRV unsigned long # else # define PTRV unsigned # endif # define INT2PTR(any,d) (any)(PTRV)(d) #endif #define NUM2PTR(any,d) (any)(PTRV)(d) #define PTR2IV(p) INT2PTR(IV,p) #define PTR2UV(p) INT2PTR(UV,p) #define PTR2NV(p) NUM2PTR(NV,p) #if PTRSIZE == LONGSIZE # define PTR2ul(p) (unsigned long)(p) #else # define PTR2ul(p) INT2PTR(unsigned long,p) #endif #endif /* !INT2PTR */ #ifndef boolSV # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) #endif #ifndef gv_stashpvn # define gv_stashpvn(str,len,flags) gv_stashpv(str,flags) #endif #ifndef newSVpvn # define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0)) #endif #ifndef newRV_inc /* Replace: 1 */ # define newRV_inc(sv) newRV(sv) /* Replace: 0 */ #endif /* DEFSV appears first in 5.004_56 */ #ifndef DEFSV # define DEFSV GvSV(PL_defgv) #endif #ifndef SAVE_DEFSV # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) #endif #ifndef newRV_noinc # ifdef __GNUC__ # define newRV_noinc(sv) \ ({ \ SV *nsv = (SV*)newRV(sv); \ SvREFCNT_dec(sv); \ nsv; \ }) # else # if defined(USE_THREADS) static SV * newRV_noinc (SV * sv) { SV *nsv = (SV*)newRV(sv); SvREFCNT_dec(sv); return nsv; } # else # define newRV_noinc(sv) \ (PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv) # endif # endif #endif /* Provide: newCONSTSUB */ /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */ #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63)) #if defined(NEED_newCONSTSUB) static #else extern void newCONSTSUB(HV * stash, char * name, SV *sv); #endif #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL) void newCONSTSUB(stash,name,sv) HV *stash; char *name; SV *sv; { U32 oldhints = PL_hints; HV *old_cop_stash = PL_curcop->cop_stash; HV *old_curstash = PL_curstash; line_t oldline = PL_curcop->cop_line; PL_curcop->cop_line = PL_copline; PL_hints &= ~HINT_BLOCK_SCOPE; if (stash) PL_curstash = PL_curcop->cop_stash = stash; newSUB( #if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22)) /* before 5.003_22 */ start_subparse(), #else # if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22) /* 5.003_22 */ start_subparse(0), # else /* 5.003_23 onwards */ start_subparse(FALSE, 0), # endif #endif newSVOP(OP_CONST, 0, newSVpv(name,0)), newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */ newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv)) ); PL_hints = oldhints; PL_curcop->cop_stash = old_cop_stash; PL_curstash = old_curstash; PL_curcop->cop_line = oldline; } #endif #endif /* newCONSTSUB */ #ifndef START_MY_CXT /* * Boilerplate macros for initializing and accessing interpreter-local * data from C. All statics in extensions should be reworked to use * this, if you want to make the extension thread-safe. See ext/re/re.xs * for an example of the use of these macros. * * Code that uses these macros is responsible for the following: * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts" * 2. Declare a typedef named my_cxt_t that is a structure that contains * all the data that needs to be interpreter-local. * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t. * 4. Use the MY_CXT_INIT macro such that it is called exactly once * (typically put in the BOOT: section). * 5. Use the members of the my_cxt_t structure everywhere as * MY_CXT.member. * 6. Use the dMY_CXT macro (a declaration) in all the functions that * access MY_CXT. */ #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \ defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT) /* This must appear in all extensions that define a my_cxt_t structure, * right after the definition (i.e. at file scope). The non-threads * case below uses it to declare the data as static. */ #define START_MY_CXT #if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 )) /* Fetches the SV that keeps the per-interpreter data. */ #define dMY_CXT_SV \ SV *my_cxt_sv = perl_get_sv(MY_CXT_KEY, FALSE) #else /* >= perl5.004_68 */ #define dMY_CXT_SV \ SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \ sizeof(MY_CXT_KEY)-1, TRUE) #endif /* < perl5.004_68 */ /* This declaration should be used within all functions that use the * interpreter-local data. */ #define dMY_CXT \ dMY_CXT_SV; \ my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv)) /* Creates and zeroes the per-interpreter data. * (We allocate my_cxtp in a Perl SV so that it will be released when * the interpreter goes away.) */ #define MY_CXT_INIT \ dMY_CXT_SV; \ /* newSV() allocates one more than needed */ \ my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ Zero(my_cxtp, 1, my_cxt_t); \ sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) /* This macro must be used to access members of the my_cxt_t structure. * e.g. MYCXT.some_data */ #define MY_CXT (*my_cxtp) /* Judicious use of these macros can reduce the number of times dMY_CXT * is used. Use is similar to pTHX, aTHX etc. */ #define pMY_CXT my_cxt_t *my_cxtp #define pMY_CXT_ pMY_CXT, #define _pMY_CXT ,pMY_CXT #define aMY_CXT my_cxtp #define aMY_CXT_ aMY_CXT, #define _aMY_CXT ,aMY_CXT #else /* single interpreter */ #define START_MY_CXT static my_cxt_t my_cxt; #define dMY_CXT_SV dNOOP #define dMY_CXT dNOOP #define MY_CXT_INIT NOOP #define MY_CXT my_cxt #define pMY_CXT void #define pMY_CXT_ #define _pMY_CXT #define aMY_CXT #define aMY_CXT_ #define _aMY_CXT #endif #endif /* START_MY_CXT */ #ifndef IVdf # if IVSIZE == LONGSIZE # define IVdf "ld" # define UVuf "lu" # define UVof "lo" # define UVxf "lx" # define UVXf "lX" # else # if IVSIZE == INTSIZE # define IVdf "d" # define UVuf "u" # define UVof "o" # define UVxf "x" # define UVXf "X" # endif # endif #endif #ifndef NVef # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \ defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */ # define NVef PERL_PRIeldbl # define NVff PERL_PRIfldbl # define NVgf PERL_PRIgldbl # else # define NVef "e" # define NVff "f" # define NVgf "g" # endif #endif #ifndef AvFILLp /* Older perls (<=5.003) lack AvFILLp */ # define AvFILLp AvFILL #endif #ifdef SvPVbyte # if PERL_REVISION == 5 && PERL_VERSION < 7 /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */ # undef SvPVbyte # define SvPVbyte(sv, lp) \ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \ ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp)) static char * my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp) { sv_utf8_downgrade(sv,0); return SvPV(sv,*lp); } # endif #else # define SvPVbyte SvPV #endif #endif /* _P_P_PORTABILITY_H_ */ /* End of File ppport.h */ Crypt-GCrypt-1.26/README000644 000765 000024 00000004234 11570001663 014372 0ustar00alstaff000000 000000 $Id -------- Abstract -------- Crypt::GCrypt provides a Perl interface to the libgcrypt cryptographic functions. It currently supports symmetric ciphers such as AES/Rikndael, Twofish, Triple DES, Arcfour etc., while asymmetric cryptography is being developed. ------------ Requirements ------------ Crypt::GCrypt requires that libgcrypt is installed on your system. You can use your favourite package manager or download the latest version of libgcrypt at the GNU site: ftp://ftp.gnupg.org/gcrypt/libgcrypt/ and then you can install it just doing: $ ./configure $ make # make install Crypt::GCrypt was tested with libgcrypt 1.2.4. If libgcrypt is installed, but in a non-standard directory, then use the following options to Makefile.PL: GCRYPTLIBPATH=... To set the directory in which to find libgcrypt GCRYPTINCPATH=... To set the directory in which to find gcrypt.h For example: perl Makefile.PL GCRYPTLIBPATH=/home/me/lib GCRYPTINCPATH=/home/me/include Note that if you build against a shareable library in a non-standard location you may (on some platforms) also have to set your LD_LIBRARY_PATH environment variable at run time for perl to find the library. ------------------ Basic Installation ------------------ Crypt::GCrypt may be installed through the CPAN shell in the usual manner. Typically: $ perl -MCPAN -e 'install Crypt::GCrypt' You can also read this README from the CPAN shell: $ perl -MCPAN -e shell cpan> readme Crypt::GCrypt And you can install the component from the CPAN prompt as well: cpan> install Crypt::GCrypt ------------------- Manual Installation ------------------- This module may also be installed manually. Its distribution is available from the author's CPAN directory, , or a similarly named directory at your favorite CPAN mirror. Downloading and unpacking the distribution are left as exercises for the reader. To build and test it: perl Makefile.PL make test When you're ready to install the component: make install It should now be ready to use. Thanks for reading! -- Alessandro Ranellucci / aar@cpan.org / http://alex.primafila.net Crypt-GCrypt-1.26/t/000755 000765 000024 00000000000 12150170166 013752 5ustar00alstaff000000 000000 Crypt-GCrypt-1.26/typemap000644 000765 000024 00000000625 11570001663 015114 0ustar00alstaff000000 000000 TYPEMAP Crypt_GCrypt T_PTROBJ_SPECIAL Crypt_GCrypt_MPI T_PTROBJ_SPECIAL INPUT T_PTROBJ_SPECIAL if (sv_derived_from($arg, \"${(my $ntt=$ntype)=~s/_/::/g;\$ntt}\")) { IV tmp = SvIV((SV*)SvRV($arg)); $var = ($type) tmp; } else croak(\"$var is not of type ${(my $ntt=$ntype)=~s/_/::/g;\$ntt}\"); OUTPUT T_PTROBJ_SPECIAL sv_setref_pv($arg, \"${(my $ntt=$ntype)=~s/_/::/g;\$ntt}\", (void *)$var); Crypt-GCrypt-1.26/t/01-cipher.t000644 000765 000024 00000005723 11570001663 015636 0ustar00alstaff000000 000000 # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 01-use.t' ######################### use Test; BEGIN { plan tests => 20 }; # <--- number of tests use ExtUtils::testlib; use Crypt::GCrypt; ok(1); ######################### ok(Crypt::GCrypt::cipher_algo_available('aes')); ok(Crypt::GCrypt::cipher_algo_available('arcfour')); ok(Crypt::GCrypt::cipher_algo_available('twofish')); my $c = Crypt::GCrypt->new( type => 'cipher', algorithm => 'aes', mode => 'cbc', padding => 'null' ); ok(defined $c && $c->isa('Crypt::GCrypt')); ok($c->keylen == 16); ok($c->blklen == 16); $c->start('encrypting'); $c->setkey(my $key = "the key, the key"); my $p = 'plain text'; my ($e0, $e, $d); $e0 = pack('H*', 'c796843558cefa157bf108ab79823a5a'); $e = $c->encrypt($p); $e .= $c->finish; ok($e eq $e0) or print STDERR "[",unpack('H*',$e),"]\n"; $c->setiv(); $c->start('decrypting'); $d = $c->decrypt($e); $d .= $c->finish; ok(substr($d, 0, length $p) eq $p) or print STDERR "[",unpack('H*',$d),"]\n";; $c = Crypt::GCrypt->new( type => 'cipher', algorithm => 'aes', mode => 'ecb', padding => 'null' ); $c->start('encrypting'); $c->setkey($key); $e = $c->encrypt($p); $e .= $c->finish; ok($e eq $e0) or print STDERR "[",unpack('H*',$e),"]\n"; $c = Crypt::GCrypt->new( type => 'cipher', algorithm => 'twofish', padding => 'null' ); ok($c->keylen == 32); ok($c->blklen == 16); $c->start('encrypting'); $c->setkey($key); $c->setiv(my $iv = 'explicit iv'); $e = $c->encrypt($p); $e .= $c->finish; ok($e eq pack('H*', '9c93705d7b3348c73cd2047ce5ecc1a8')) or print STDERR "[",unpack('H*',$e),"]\n"; $c->start('decrypting'); $c->setiv($iv); $d = $c->decrypt($e); $d .= $c->finish; ok(substr($d, 0, length $p) eq $p) or print STDERR "[$d|",unpack('H*',$d),"]\n"; $c = Crypt::GCrypt->new( type => 'cipher', algorithm => 'arcfour', padding => 'null' ); ok($c->keylen == 16); ok($c->blklen == 1); $c->start('encrypting'); $c->setkey($key); $e = $c->encrypt($p); ok($e eq pack('H*', '02a98d20a176729ea7cd')) or print STDERR "[",unpack('H*',$e),"]\n"; $c->setkey($key); $c->start('decrypting'); $d = $c->decrypt($e); $d .= $c->finish; ok(substr($d, 0, length $p) eq $p) or print STDERR "[$d|",unpack('H*',$d),"]\n"; ### 'none' padding { $c = Crypt::GCrypt->new( type => 'cipher', algorithm => 'aes', padding => 'none' ); $c->start('encrypting'); ok(!eval {my $e2 = $c->encrypt('aaa'); 1}); # this should die ok(eval { my $e2 = $c->encrypt('aaaaaaaaaaaaaaaa') . $c->finish; 1 }); # this should not die } Crypt-GCrypt-1.26/t/02-compatibility.t000644 000765 000024 00000002700 11570001663 017226 0ustar00alstaff000000 000000 # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 01-use.t' ######################### use Test; BEGIN { plan tests => 1; # <--- number of tests $HAVE_CRYPT_CBC = eval "use Crypt::CBC (); 1;"; $HAVE_CAST5 = eval "use Crypt::CAST5 (); 1;"; }; use ExtUtils::testlib; use Crypt::GCrypt; ######################### skip(!($HAVE_CRYPT_CBC && $HAVE_CAST5), sub { my $c = Crypt::GCrypt->new( type => 'cipher', algorithm => 'cast5', mode => 'cbc', padding => 'standard' ); $c->start('encrypting'); $c->setkey(my $key = "the key, the key"); $c->setiv("12345678"); my $p = 'plain text'; my $e = $c->encrypt($p); $e .= $c->finish; my $cipher = Crypt::CBC->new( -key => $key, -literal_key => 1, -cipher => 'CAST5', -padding => 'standard', -iv => "12345678", -header => "none" ); $cipher->start('decrypting'); my $d = $cipher->crypt($e); $d .= $cipher->finish; return ($d eq $p); }); Crypt-GCrypt-1.26/t/03-pod.t000644 000765 000024 00000000201 11570001663 015132 0ustar00alstaff000000 000000 use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); Crypt-GCrypt-1.26/t/04-podcoverage.t000644 000765 000024 00000000275 11570001663 016662 0ustar00alstaff000000 000000 use Test::More; eval "use Test::Pod::Coverage 1.00"; plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@; all_pod_coverage_ok({ also_private => ['sign'] }); Crypt-GCrypt-1.26/t/05-size.t000644 000765 000024 00000001231 11570001663 015330 0ustar00alstaff000000 000000 use Test::More; if (eval "use Devel::Size qw[total_size]; 1") { plan tests => 1; } else { plan skip_all => "Devel::Size required for testing memory"; } use ExtUtils::testlib; use Crypt::GCrypt; my $c = Crypt::GCrypt->new( type => 'cipher', algorithm => 'aes', mode => 'cbc', padding => 'null' ); $c->start('encrypting'); $c->setkey("the key, the key"); my $fp = total_size($c); my $e; for (1..50) { print "$_\n"; $e .= $c->encrypt('plain text' x 4); } $e .= $c->finish; my $fp2 = total_size($c); ok($fp == $fp2, 'constant memory allocation'); Crypt-GCrypt-1.26/t/06-multi.t000644 000765 000024 00000002763 11570001663 015524 0ustar00alstaff000000 000000 use Test::More; plan tests => 4; use ExtUtils::testlib; use Crypt::GCrypt; my $c = Crypt::GCrypt->new( type => 'cipher', algorithm => 'aes', # blklen == 16 mode => 'cbc', padding => 'standard' ); $c->setkey('b' x 32); { my $text = 'a' x 999; $c->start('encrypting'); my $t1 = substr($text, 0, 512); my $t2 = substr($text, 512); printf "length of original text is %d\n", length($text); my $e = $c->encrypt($t1); $e .= $c->encrypt($t2); $e .= $c->finish; printf "length of encrypted text is %d\n", length($e); $c->start('decrypting'); my $e1 = substr($e, 0, 512); my $e2 = substr($e, 512); my $d = $c->decrypt($e1); $d .= $c->decrypt($e2); $d .= $c->finish; printf "length of decrypted text is %d\n", length($d); ok($d eq $text); ok(length $d == length $text); } # compatibility with <= 1.17 for applications which don't call ->finish() { my $text = <<'EOF'; Lorem ipsum dolor sit amet, con EOF printf "length of original text is %d\n", length($text); $c->start('encrypting'); my $e = $c->encrypt($text) . $c->finish; printf "length of encrypted text is %d\n", length($e); $c->start('decrypting'); my $d = $c->decrypt($e); my $d2 = $c->finish; # discarding finish() output printf "length of decrypted text is %d\n", length($d); ok($d eq $text); ok(length $d == length $text); } __END__ Crypt-GCrypt-1.26/t/07-thread.t000644 000765 000024 00000006703 11570001663 015640 0ustar00alstaff000000 000000 # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 07-thread.t' ######################### use strict; use warnings; use Config; use Test::More; use ExtUtils::testlib; use Crypt::GCrypt; ######################### my @algos = qw(aes twofish blowfish arcfour cast5 des serpent seed); my @available_algos; if ($Config{useithreads} && eval "use threads; use Thread::Queue; 1") { # test as many algorithms as we have. @available_algos = grep Crypt::GCrypt::cipher_algo_available($_), @algos; plan tests => 3 * @available_algos; } else { plan skip_all => "Skipping because your perl is not compiled with thread support"; } my $str = 'Four Score and Seven years ago, our fore-monkeys created a great blah blah blah'; my $key = 'monkeymonkeymonkey'; sub nonthreadtest { my $algo = shift; my $enc = Crypt::GCrypt->new( type => 'cipher', algorithm => $algo, #mode => 'cbc', #padding => 'null' ); $enc->start('encrypting'); $enc->setkey($key); my $dec = Crypt::GCrypt->new( type => 'cipher', algorithm => $algo, #mode => 'cbc', #padding => 'null' ); $dec->start('decrypting'); $dec->setkey($key); my $out = ''; my $buf = $enc->encrypt($str); $out .= $dec->decrypt($buf) if (length($buf)); # should we need to test this length() ? $buf = $enc->finish(); $out .= $dec->decrypt($buf) if (length($buf)); # should we need to test this length() ? $out .= $dec->finish(); warn sprintf("Non-threaded: Failed to match output with algorithm '%s'\n", $algo) if ($str ne $out); return ($str eq $out); } sub producer_thread { my $q = shift; my $algo = shift; my $enc = Crypt::GCrypt->new( type => 'cipher', algorithm => $algo, #mode => 'cbc', #padding => 'null' ); $enc->start('encrypting'); $enc->setkey($key); $q->enqueue($enc->encrypt($str)); $q->enqueue($enc->finish()); $q->enqueue(undef); return 1; } sub consumer_thread { my $q = shift; my $algo = shift; my $dec = Crypt::GCrypt->new( type => 'cipher', algorithm => $algo, #mode => 'cbc', #padding => 'null' ); $dec->start('decrypting'); $dec->setkey($key); my $buf; my $out = ''; do { $buf = $q->dequeue(); $out .= $dec->decrypt($buf) if (defined $buf); } while (defined $buf); $out .= $dec->finish(); warn sprintf("Threaded: failed to match output with algorithm '%s'\n". "Wanted: %s\n Got: %s\n", $algo, unpack('H*', $str), unpack('H*', $out)) if ($str ne $out); return $str eq $out; } sub testalgo { my $algo = shift; ok(nonthreadtest($algo)); my $queue = Thread::Queue->new(); # create in scalar context so that the result is the returned scalar: my $con = threads->create('consumer_thread', $queue, $algo); my $pro = threads->create('producer_thread', $queue, $algo); } testalgo($_) for @available_algos; ok($_->join()) for threads->list(); Crypt-GCrypt-1.26/t/08-digest.t000644 000765 000024 00000036473 11570001663 015660 0ustar00alstaff000000 000000 # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 08-digest.t' ######################### use strict; use warnings; use Test; use ExtUtils::testlib; use Crypt::GCrypt; ######################### # generated this list with the following shell snippet: # for str in '' a 38 abc "message digest" abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789 12345678901234567890123456789012345678901234567890123456789012345678901234567890 ; do printf " '%s' => {\n" "$str"; for digest in md4 md5 ripemd160 sha1 sha224 sha256 sha384 sha512; do printf " %s => '%s', \n" "$digest" $(printf "%s" "$str" | openssl dgst -"$digest") ; done ; printf " whirlpool => '%s',\n" $(printf "%s" "$str" | whirlpool) ; printf " },\n" ; done # tiger192 digests are not currently tested as it is unclear if gcrypt # implements tiger properly. For more details, read: # http://lists.gnupg.org/pipermail/gcrypt-devel/2009-November/001512.html my %dgsts = ( '' => { md4 => '31d6cfe0d16ae931b73c59d7e0c089c0', md5 => 'd41d8cd98f00b204e9800998ecf8427e', ripemd160 => '9c1185a5c5e9fc54612808977ee8f548b2258d31', sha1 => 'da39a3ee5e6b4b0d3255bfef95601890afd80709', sha224 => 'd14a028c2a3a2bc9476102bb288234c415a2b01f828ea62ac5b3e42f', sha256 => 'e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855', sha384 => '38b060a751ac96384cd9327eb1b1e36a21fdb71114be07434c0cc7bf63f6e1da274edebfe76f65fbd51ad2f14898b95b', sha512 => 'cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e', # tiger192 => '3293ac630c13f0245f92bbb1766e16167a4e58492dde73f3', whirlpool => '19fa61d75522a4669b44e39c1d2e1726c530232130d407f89afee0964997f7a73e83be698b288febcf88e3e03c4f0757ea8964e59b63d93708b138cc42a66eb3', }, 'a' => { md4 => 'bde52cb31de33e46245e05fbdbd6fb24', md5 => '0cc175b9c0f1b6a831c399e269772661', ripemd160 => '0bdc9d2d256b3ee9daae347be6f4dc835a467ffe', sha1 => '86f7e437faa5a7fce15d1ddcb9eaeaea377667b8', sha224 => 'abd37534c7d9a2efb9465de931cd7055ffdb8879563ae98078d6d6d5', sha256 => 'ca978112ca1bbdcafac231b39a23dc4da786eff8147c4e72b9807785afee48bb', sha384 => '54a59b9f22b0b80880d8427e548b7c23abd873486e1f035dce9cd697e85175033caa88e6d57bc35efae0b5afd3145f31', sha512 => '1f40fc92da241694750979ee6cf582f2d5d7d28e18335de05abc54d0560e0f5302860c652bf08d560252aa5e74210546f369fbbbce8c12cfc7957b2652fe9a75', # tiger192 => '77befbef2e7ef8ab2ec8f93bf587a7fc613e247f5f247809', whirlpool => '8aca2602792aec6f11a67206531fb7d7f0dff59413145e6973c45001d0087b42d11bc645413aeff63a42391a39145a591a92200d560195e53b478584fdae231a', }, '38' => { md4 => 'ae9c7ebfb68ea795483d270f5934b71d', md5 => 'a5771bce93e200c36f7cd9dfd0e5deaa', ripemd160 => '6b2d075b1cd34cd1c3e43a995f110c55649dad0e', sha1 => '5b384ce32d8cdef02bc3a139d4cac0a22bb029e8', sha224 => '4cfca6da32da647198225460722b7ea1284f98c4b179e8dbae3f93d5', sha256 => 'aea92132c4cbeb263e6ac2bf6c183b5d81737f179f21efdc5863739672f0f470', sha384 => 'c071d202ad950b6a04a5f15c24596a993af8b212467958d570a3ffd4780060638e3a3d06637691d3012bd31122071b2c', sha512 => 'caae34a5e81031268bcdaf6f1d8c04d37b7f2c349afb705b575966f63e2ebf0fd910c3b05160ba087ab7af35d40b7c719c53cd8b947c96111f64105fd45cc1b2', # tiger192 => 'a8e518a0c62a98f9ac4aa426c3534494fa67a0728b9304d3', whirlpool => 'b89f9f0485e8a03e6c8aaa97b29c41479351e4906bdcdef05f0568d3eeed180962bf983c8be65153da0df05b10fa4156d8d8af309245a252a3cb5467faee09d1', }, 'abc' => { md4 => 'a448017aaf21d8525fc10ae87aa6729d', md5 => '900150983cd24fb0d6963f7d28e17f72', ripemd160 => '8eb208f7e05d987a9b044a8e98c6b087f15a0bfc', sha1 => 'a9993e364706816aba3e25717850c26c9cd0d89d', sha224 => '23097d223405d8228642a477bda255b32aadbce4bda0b3f7e36c9da7', sha256 => 'ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad', sha384 => 'cb00753f45a35e8bb5a03d699ac65007272c32ab0eded1631a8b605a43ff5bed8086072ba1e7cc2358baeca134c825a7', sha512 => 'ddaf35a193617abacc417349ae20413112e6fa4e89a97ea20a9eeee64b55d39a2192992a274fc1a836ba3c23a3feebbd454d4423643ce80e2a9ac94fa54ca49f', # tiger192 => '2aab1484e8c158f2bfb8c5ff41b57a525129131c957b5f93', whirlpool => '4e2448a4c6f486bb16b6562c73b4020bf3043e3a731bce721ae1b303d97e6d4c7181eebdb6c57e277d0e34957114cbd6c797fc9d95d8b582d225292076d4eef5', }, 'message digest' => { md4 => 'd9130a8164549fe818874806e1c7014b', md5 => 'f96b697d7cb7938d525a2f31aaf161d0', ripemd160 => '5d0689ef49d2fae572b881b123a85ffa21595f36', sha1 => 'c12252ceda8be8994d5fa0290a47231c1d16aae3', sha224 => '2cb21c83ae2f004de7e81c3c7019cbcb65b71ab656b22d6d0c39b8eb', sha256 => 'f7846f55cf23e14eebeab5b4e1550cad5b509e3348fbc4efa3a1413d393cb650', sha384 => '473ed35167ec1f5d8e550368a3db39be54639f828868e9454c239fc8b52e3c61dbd0d8b4de1390c256dcbb5d5fd99cd5', sha512 => '107dbf389d9e9f71a3a95f6c055b9251bc5268c2be16d6c13492ea45b0199f3309e16455ab1e96118e8a905d5597b72038ddb372a89826046de66687bb420e7c', # tiger192 => 'd981f8cb78201a950dcf3048751e441c517fca1aa55a29f6', whirlpool => '378c84a4126e2dc6e56dcc7458377aac838d00032230f53ce1f5700c0ffb4d3b8421557659ef55c106b4b52ac5a4aaa692ed920052838f3362e86dbd37a8903e', }, 'abcdefghijklmnopqrstuvwxyz' => { md4 => 'd79e1c308aa5bbcdeea8ed63df412da9', md5 => 'c3fcd3d76192e4007dfb496cca67e13b', ripemd160 => 'f71c27109c692c1b56bbdceb5b9d2865b3708dbc', sha1 => '32d10c7b8cf96570ca04ce37f2a19d84240d3a89', sha224 => '45a5f72c39c5cff2522eb3429799e49e5f44b356ef926bcf390dccc2', sha256 => '71c480df93d6ae2f1efad1447c66c9525e316218cf51fc8d9ed832f2daf18b73', sha384 => 'feb67349df3db6f5924815d6c3dc133f091809213731fe5c7b5f4999e463479ff2877f5f2936fa63bb43784b12f3ebb4', sha512 => '4dbff86cc2ca1bae1e16468a05cb9881c97f1753bce3619034898faa1aabe429955a1bf8ec483d7421fe3c1646613a59ed5441fb0f321389f77f48a879c7b1f1', # tiger192 => '1714a472eee57d30040412bfcc55032a0b11602ff37beee9', whirlpool => 'f1d754662636ffe92c82ebb9212a484a8d38631ead4238f5442ee13b8054e41b08bf2a9251c30b6a0b8aae86177ab4a6f68f673e7207865d5d9819a3dba4eb3b', }, 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789' => { md4 => '043f8582f241db351ce627e153e7f0e4', md5 => 'd174ab98d277d9f5a5611c2c9f419d9f', ripemd160 => 'b0e20b6e3116640286ed3a87a5713079b21f5189', sha1 => '761c457bf73b14d27e9e9265c46f4b4dda11f940', sha224 => 'bff72b4fcb7d75e5632900ac5f90d219e05e97a7bde72e740db393d9', sha256 => 'db4bfcbd4da0cd85a60c3c37d3fbd8805c77f15fc6b1fdfe614ee0a7c8fdb4c0', sha384 => '1761336e3f7cbfe51deb137f026f89e01a448e3b1fafa64039c1464ee8732f11a5341a6f41e0c202294736ed64db1a84', sha512 => '1e07be23c26a86ea37ea810c8ec7809352515a970e9253c26f536cfc7a9996c45c8370583e0a78fa4a90041d71a4ceab7423f19c71b9d5a3e01249f0bebd5894', # tiger192 => '8dcea680a17583ee502ba38a3c368651890ffbccdc49a8cc', whirlpool => 'dc37e008cf9ee69bf11f00ed9aba26901dd7c28cdec066cc6af42e40f82f3a1e08eba26629129d8fb7cb57211b9281a65517cc879d7b962142c65f5a7af01467', }, '12345678901234567890123456789012345678901234567890123456789012345678901234567890' => { md4 => 'e33b4ddc9c38f2199c3e7b164fcc0536', md5 => '57edf4a22be3c955ac49da2e2107b67a', ripemd160 => '9b752e45573d4b39f4dbd3323cab82bf63326bfb', sha1 => '50abf5706a150990a08b2c5ea40fa0e585554732', sha224 => 'b50aecbe4e9bb0b57bc5f3ae760a8e01db24f203fb3cdcd13148046e', sha256 => 'f371bc4a311f2b009eef952dd83ca80e2b60026c8e935592d0f9c308453c813e', sha384 => 'b12932b0627d1c060942f5447764155655bd4da0c9afa6dd9b9ef53129af1b8fb0195996d2de9ca0df9d821ffee67026', sha512 => '72ec1ef1124a45b047e8b7c75a932195135bb61de24ec0d1914042246e0aec3a2354e093d76f3048b456764346900cb130d2a4fd5dd16abb5e30bcb850dee843', # tiger192 => '1c14795529fd9f207a958f84c52f11e887fa0cabdfd91bfd', whirlpool => '466ef18babb0154d25b9d38a6414f5c08784372bccb204d6549c4afadb6014294d5bd8df2a6c44e538cd047b2681a51a2c60481e88c5a20b2c2a80cf3a9a083b', nosuchdigest => 'no such digest', # testing digest_algo_available() }, ); # generated HMAC test vectors against openssl with: # for str in '' a 38 abc "message digest" abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789 12345678901234567890123456789012345678901234567890123456789012345678901234567890 ; do printf " '%s' => {\n" "$str"; for digest in md4 md5 ripemd160 sha1 sha224 sha256 sha384 sha512; do printf " %s => '%s',\n" "$digest" $(printf "%s" "$str" | openssl dgst -"$digest" -hmac "monkey monkey monkey monkey") ; done ; printf " },\n" ; done # (i don't have HMAC test vectors for tiger or whirlpool) my %hmacs = ( '' => { md4 => 'e5183d531f4d6db5ff14e9121c6fccd5', md5 => 'e84db42a188813f30a15e611d64c7869', ripemd160 => '8ba1e37d3c7b96281469d9e03aa83add3d0b15ef', sha1 => 'e6e99434623d60a28c9f6061993af2c4da8a51c5', sha224 => 'd12a49ae38177ffeaa548b2148bb523860849772d9391e675b103d89', sha256 => '5c780648c90d121c50091c3a0c3afc1f4ab847528005d99d9821ad3f341b651a', sha384 => '2c87a2f446b3bab07c595054490f618d33a3bade1f889b4b3502091d76bf93389cd8b77c9162d8717e420c3257ae7b2e', sha512 => '34316413c2d6940572d0bbbf099d529d148b424533cf562bc1b365f530e21a31799fc51cef78060cc6f448a8e5d780c26cdf20d4c3e6f27fe5ef576bbd05e855', }, 'a' => { md4 => 'bda51a1eca0bc702c2cbc44567815520', md5 => '123662062e67c2aab371cc49db0df134', ripemd160 => '82ad9b8e37b22fe42e730eea14dd07dfc6426dfd', sha1 => 'ff563a68ac9d592e5b1c3f266a8decc932af96f2', sha224 => 'b04ff8522f904f553970bfa8ad3f0086bce1e8580affd8a12c94e31a', sha256 => '6142364c0646b0cfe426866f21d613e055a136a7d9b45d85685e080a09cec463', sha384 => '69b97247988d6149bdd74ad4ba6fbae04bf1bbea69e08468e9617a293d69e0a984a0192e84b6c51fadbf43491203af2b', sha512 => 'cf1948507378bc3ab58cb6ec87f4d456b90d3298395c29873f1ded1e111b50fec336ed24684bf19716efc309212f37aa715cfb9ecccf3af13691ded167b4b336', }, '38' => { md4 => '0ca7953fffdb3d2015fa01e50376ae5c', md5 => '0a46cc10a49d4b7025c040c597bf5d76', ripemd160 => '72bff3575250411bfba81441664ce249c734142d', sha1 => 'bdb97422a2c70e8c7d27976b1415e7e132b3e5f7', sha224 => 'afcfb5511f710334f9350f57faec3c08764b4bd126a6840f4347f116', sha256 => 'e49aa7839977e130ad87b63da9d4eb7b263cd5a27c54a7604b6044eb35901171', sha384 => '321b3a353a11effc1557728022644ed9216f7d9eef4fdaec205d1faf6e7395b805020dd31d9f8550635b5a4414ba1aff', sha512 => 'b8201784216ce01b83cdd282616c6e89644c6dfd1269ed8580bbc39b92add364c2b2a2018cffb1915e8625e473b67d0fe54a50e475dfa0e2b1a97bac1383792c', }, 'abc' => { md4 => '34d8e18874f96e8ed74e3d9d333e2bc6', md5 => 'd1f4d89f0e8b2b6ed0623c99ec298310', ripemd160 => '7f3a47544440050bd0f81c8d40d503c5aa1b3aeb', sha1 => '9b07e65129605e7577fc1953fc9415fb97da2efb', sha224 => '9df9907af127900c909376893565c6cf2d7db244fdc4277da1e0b679', sha256 => 'e5ef49f545c7af933a9d18c7c562bc9108583fd5cf00d9e0db351d6d8f8e41bc', sha384 => '5451e87820025c58f06512db53b576484d5b0a0a311d496f7499f311f4729e76e49b799102cf5fbe9d8b105eea14b048', sha512 => 'f097ee08b8c44e847a384f9fd645e35e4816baa9791ba39d3dc611210500b044873ee296bf1047dc06daa201a57671925b73b4ea59c60114881c8287d0699c83', }, 'message digest' => { md4 => '008791fd0be992b8005c3984e3db57a1', md5 => '1627207b9bed5009a4f6e9ca8d2ca01e', ripemd160 => '883403138f019b85629b3bedefd06c1774ab452a', sha1 => '8f76dfeeec9d71e6217f4fae1f15601859583904', sha224 => '254ebf6b8ddd7a3271b3d9aca1699b0c0bfb7df61e8a114922c88d27', sha256 => '373b04877180fea27a41a8fb8f88201ca6268411ee3c80b01a424483eb9156e1', sha384 => 'ae91a02c88918da8b3215a0ce419736b88744806f33476e8a8fce61fe43a8fad66a0b6dd1c0c21fb0f2c7c3a04b8267b', sha512 => '921a441a884b83c76a8526da8e60d60d17ded4eee5c29375e0d93717669a4c3eeba7473e95f7c1a2a85afc24a0adbc4d6c2bdd6ca6cab8b18d19f82d4a6c51bc', }, 'abcdefghijklmnopqrstuvwxyz' => { md4 => '246dedc8c42870e0fbe230d0bad32420', md5 => '922aae6ab3b3a29202e21ce5f916ae9a', ripemd160 => 'b639506a560f73cd0f61df738596af65d557946d', sha1 => '7c0c34c8be298c229d8cf9c610e8d6ba7947eb03', sha224 => '6ec5bffba5880c3234a6cf257816e4d535ab178a7f12929769e378fb', sha256 => 'eb5945d56eefbdb41602946ea6448d5386b08d7d801a87f439fab52f8bb9736e', sha384 => 'f7398e453013e5af5c40e07cb4a8109b83b60395499b6ca67e4301df0fafff26c39140a8199167d172b131ab1b7ab999', sha512 => '640054c96f35815095617d0a8c9560661a6ff46bfb39110333b2c52c8866abfb59d9152c9b0948c1ed65c3fd72a8fb82190acc8830770afe5b0c5b6414c75a77', }, 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789' => { md4 => 'dc5f6b13f54f31e7a8276d4540ec6e99', md5 => 'ede9cb83679ba82d88fbeae865b3f8fc', ripemd160 => '94964ed4c1155b62b668c241d67279e58a711676', sha1 => 'c7b5a631e3aac975c4ededfcd346e469dbc5f2d1', sha224 => '5f768179dbb29ca722875d0f461a2e2f597d0210340a84df1a8e9c63', sha256 => '3798f363c57afa6edaffe39016ca7badefd1e670afb0e3987194307dec3197db', sha384 => 'd218680a6032d33dccd9882d6a6a716464f26623be257a9b2919b185294f4a499e54b190bfd6bc5cedd2cd05c7e65e82', sha512 => '835a4f5b3750b4c1fccfa88da2f746a4900160c9f18964309bb736c13b59491b8e32d37b724cc5aebb0f554c6338a3b594c4ba26862b2dadb59b7ede1d08d53e', }, '12345678901234567890123456789012345678901234567890123456789012345678901234567890' => { md4 => 'aa8a5a5bbe444c106e46b6314409e231', md5 => '939dd45512ee3a594b6654f6b8de27f7', ripemd160 => '619dddf49f3584da4f7d17da8bb606dc8d69f3e1', sha1 => '095f08d37e4b726e049e989f1f29e0fa2407b18e', sha224 => 'c7667b0d7e56b2b4f6fcc1d8da9e22daa1556f44c47132a87303c6a2', sha256 => 'c89a7039a62985ff813fe4509b918a436d7b1ffd8778e2c24dec464849fb6128', sha384 => '5197498af7797baf158c2cfe0dcfc7fea5a5065cfb4009524b55293c56758f8810da4750c21d0a2a3986d09030751f83', sha512 => 'fdf83dc879e3476c8e8aceff2bf6fece2e4f39c7e1a167845465bb549dfa5ffe997e6c7cf3720eae51ed2b00ad2a8225375092290edfa9d48ec7e4bc8e276088', nosuchdigest => 'no such digest', # testing digest_algo_available() }, ); plan tests => scalar grep Crypt::GCrypt::digest_algo_available($_), map keys %$_, values %dgsts, values %hmacs; my $data; my $algo; for $data (sort keys %dgsts) { for $algo (sort keys %{$dgsts{$data}}) { next unless Crypt::GCrypt::digest_algo_available($algo); my $md = Crypt::GCrypt->new( type => 'digest', algorithm => $algo, ); die "failed to create digest object with algorithm $algo" unless defined $md; $md->write($data); my $result = unpack('H*', $md->read()); warn sprintf("(%s) '%s': %s != %s\n", $algo, $data, $result, $dgsts{$data}{$algo}) unless ($result eq $dgsts{$data}{$algo}); ok($result eq $dgsts{$data}{$algo}); } } for $data (sort keys %hmacs) { for $algo (sort keys %{$hmacs{$data}}) { next unless Crypt::GCrypt::digest_algo_available($algo); my $md = Crypt::GCrypt->new( type => 'digest', algorithm => $algo, hmac => 'monkey monkey monkey monkey', ); die "failed to create HMAC digest object with algorithm $algo" unless defined $md; $md->write($data); my $result = unpack('H*', $md->read()); warn sprintf("HMAC (%s) '%s': %s != %s\n", $algo, $data, $result, $hmacs{$data}{$algo}) unless ($result eq $hmacs{$data}{$algo}); ok($result eq $hmacs{$data}{$algo}); } } Crypt-GCrypt-1.26/t/09-clone-digest.t000644 000765 000024 00000002526 11570001663 016747 0ustar00alstaff000000 000000 # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 09-clone-digest.t' ######################### use Test; use ExtUtils::testlib; use Crypt::GCrypt; ######################### # SHA1 progressive digests (can we read what the digest should be along the way?): my %dgsts = ( '' => 'da39a3ee5e6b4b0d3255bfef95601890afd80709', 'a' => '86f7e437faa5a7fce15d1ddcb9eaeaea377667b8', 'abc' => 'a9993e364706816aba3e25717850c26c9cd0d89d', 'abcdefghijklmnopqrstuvwxyz' => '32d10c7b8cf96570ca04ce37f2a19d84240d3a89', ); plan tests => 5; my $md0 = Crypt::GCrypt->new( type => 'digest', algorithm => 'sha1', ); my $result; my $md1 = $md0->clone(); $result = unpack('H*', $md1->read()); ok($result eq $dgsts{''}); $md0->write('a'); my $md2 = $md0->clone(); $result = unpack('H*', $md2->read()); ok($result eq $dgsts{'a'}); $md0->write('bc'); my $md3 = $md0->clone(); $result = unpack('H*', $md3->read()); ok($result eq $dgsts{'abc'}); $md0->write('defghijklmnopqrstuvwxyz'); my $md4 = $md0->clone(); $result = unpack('H*', $md4->read()); ok($result eq $dgsts{'abcdefghijklmnopqrstuvwxyz'}); $result = unpack('H*', $md0->read()); ok($result eq $dgsts{'abcdefghijklmnopqrstuvwxyz'}); Crypt-GCrypt-1.26/t/10-versions.t000644 000765 000024 00000001461 11570001663 016227 0ustar00alstaff000000 000000 # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 20-versions.t' ######################### use Test; use ExtUtils::testlib; use Crypt::GCrypt; ######################### BEGIN { plan tests => 3 }; # <--- number of tests; my $g = Crypt::GCrypt::gcrypt_version(); my $x = Crypt::GCrypt::built_against_version(); warn sprintf("gcrypt version: %s\n built against: %s\n", $g, $x); ok($g); ok($x); # since this is presumably being run at build time, we expect these # versions to be the same. Note that in a running environment, it # might be possible for gcrypt to be a newer version than the version # the package was built against. (i.e. the admin might have upgraded # libgcrypt without rebuilding Crypt::GCrypt) ok($g eq $x); Crypt-GCrypt-1.26/t/20-mpi.t000644 000765 000024 00000007027 11570001663 015151 0ustar00alstaff000000 000000 # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 20-mpi.t' ######################### use Test; BEGIN { plan tests => 39 }; # <--- number of tests use ExtUtils::testlib; use Crypt::GCrypt::MPI; ######################### my $empty = Crypt::GCrypt::MPI->new(); # make simple MPI (defaults to zero?) ok(defined $empty); my $thirtysix = Crypt::GCrypt::MPI->new(36); # make simple MPI with integer assignment ok(defined $thirtysix); my $minusforty = Crypt::GCrypt::MPI->new(-40); # make simple MPI with negative integer assignment ok(defined $minusforty); my $zero = Crypt::GCrypt::MPI->new(0); ok(defined $zero); ok($empty->set($zero)->cmp($zero) == 0); ok($zero->cmp($thirtysix) < 0); ok($thirtysix->cmp($zero) > 0); ok($zero->cmp($minusforty) > 0); ok($minusforty->cmp($zero) < 0); ok($thirtysix->cmp($minusforty) > 0); ok($minusforty->cmp($thirtysix) < 0); ok(!$zero->is_secure()); # basic test calculations: my $x = Crypt::GCrypt::MPI->new(29); $x->add(Crypt::GCrypt::MPI->new(7)); ok(0 == $x->cmp($thirtysix)); $x->mul(Crypt::GCrypt::MPI->new(-1)); $x->sub(Crypt::GCrypt::MPI->new(4)); ok(0 == $x->cmp($minusforty)); # modulo calculations: $x = Crypt::GCrypt::MPI->new(29); $x->addm(Crypt::GCrypt::MPI->new(12), $thirtysix); ok(0 == $x->cmp(Crypt::GCrypt::MPI->new(5))); $x->subm(Crypt::GCrypt::MPI->new(60), $thirtysix); ok(0 == $x->cmp(Crypt::GCrypt::MPI->new(17))); $x->mulm(Crypt::GCrypt::MPI->new(25), $thirtysix); ok(0 == $x->cmp(Crypt::GCrypt::MPI->new(29))); $x->mul_2exp(6); ok(0 == $x->cmp(Crypt::GCrypt::MPI->new(1856))); my $twentysix = Crypt::GCrypt::MPI->new(26); my $y = Crypt::GCrypt::MPI->new(1856); $x->mod($twentysix); ok(0 == $x->cmp(Crypt::GCrypt::MPI->new(10))); $y->div($twentysix); ok(0 == $y->cmp(Crypt::GCrypt::MPI->new(71))); # powm, invm, gcd: $x = Crypt::GCrypt::MPI->new(84); $y = Crypt::GCrypt::MPI->new(24); $y->gcd($x); ok(0 == $y->cmp(Crypt::GCrypt::MPI->new(12))); $x = Crypt::GCrypt::MPI->new(17); my $z = Crypt::GCrypt::MPI->new(7); $y->powm($z, $x); ok(0 == $y->cmp(Crypt::GCrypt::MPI->new(7))); $x = Crypt::GCrypt::MPI->new(12); $y = Crypt::GCrypt::MPI->new(17); $x->invm($y); ok(0 == $x->cmp(Crypt::GCrypt::MPI->new(10))); ok("0a" eq unpack('H*', $x->print(Crypt::GCrypt::MPI::FMT_STD))); ok("0A" eq $x->print(Crypt::GCrypt::MPI::FMT_HEX)); ok("0a" eq unpack('H*', $x->print(Crypt::GCrypt::MPI::FMT_USG))); $x = Crypt::GCrypt::MPI->new(pack('H*', '0a0a')); ok(0 == $x->cmp(Crypt::GCrypt::MPI->new(2570))); $x = Crypt::GCrypt::MPI->new(value => pack('H*', '00000003010002'), format => Crypt::GCrypt::MPI::FMT_SSH); ok(0 == $x->cmp(Crypt::GCrypt::MPI->new(65538))); $x = Crypt::GCrypt::MPI->new(value => pack('H*', '0011010001'), format => Crypt::GCrypt::MPI::FMT_PGP); ok(0 == $x->cmp(Crypt::GCrypt::MPI->new(65537))); # test copy constructor: $y = Crypt::GCrypt::MPI->new($x); ok(0 == $y->cmp($x)); $y->sub($thirtysix); ok(0 == $y->cmp(Crypt::GCrypt::MPI->new(65501))); ok(0 == $x->cmp(Crypt::GCrypt::MPI->new(65537))); # test copy method: $y = $x->copy(); ok(0 == $y->cmp($x)); $y->sub($thirtysix); ok(0 == $y->cmp(Crypt::GCrypt::MPI->new(65501))); ok(0 == $x->cmp(Crypt::GCrypt::MPI->new(65537))); { my $a = $y; $a->sub($thirtysix); }; $y->sub($thirtysix); ok(0 == $y->cmp(Crypt::GCrypt::MPI->new(65429))); $x = Crypt::GCrypt::MPI->new(15); $y = Crypt::GCrypt::MPI->new(16); $z = Crypt::GCrypt::MPI->new(3); ok($x->mutually_prime($y)); ok($y->mutually_prime($z)); ok(!$x->mutually_prime($z)); Crypt-GCrypt-1.26/lib/Crypt/000755 000765 000024 00000000000 12150170166 015356 5ustar00alstaff000000 000000 Crypt-GCrypt-1.26/lib/Crypt/GCrypt/000755 000765 000024 00000000000 12150170166 016566 5ustar00alstaff000000 000000 Crypt-GCrypt-1.26/lib/Crypt/GCrypt.pm000644 000765 000024 00000026502 12150170064 017126 0ustar00alstaff000000 000000 # =========================================================================== # Crypt::GCrypt # # Perl interface to the GNU Cryptographic library # # Author: Alessandro Ranellucci # Copyright (c) 2005-06. # # Use this software AT YOUR OWN RISK. # See below for documentation. # package Crypt::GCrypt; use strict; use warnings; our $VERSION = '1.26'; require XSLoader; XSLoader::load('Crypt::GCrypt', $VERSION); sub CLONE_SKIP { 1 } 1; __END__ =head1 NAME Crypt::GCrypt - Perl interface to the GNU Cryptographic library =head1 SYNOPSIS use Crypt::GCrypt; my $cipher = Crypt::GCrypt->new( type => 'cipher', algorithm => 'aes', mode => 'cbc' ); $cipher->start('encrypting'); $cipher->setkey('my secret key'); $cipher->setiv('my init vector'); my $ciphertext = $cipher->encrypt('plaintext'); $ciphertext .= $cipher->finish; my $plaintext = $cipher->decrypt($ciphertext); $plaintext .= $cipher->finish; =head1 ABSTRACT Crypt::GCrypt provides an object interface to the C libgcrypt library. It currently supports symmetric encryption/decryption and message digests, while asymmetric cryptography is being worked on. =head1 BINDING INFO =head2 gcrypt_version() Returns a string indicating the running version of gcrypt. =head2 built_against_version() Returns a string indicating the version of gcrypt that this module was built against. This is likely only to be useful in a debugging situation. =head1 SYMMETRIC CRYPTOGRAPHY =head2 cipher_algo_available() Determines whether a given cipher algorithm is available in the local gcrypt installation: if (Crypt::GCrypt::cipher_algo_available('aes')) { # do stuff with aes } =head2 new() In order to encrypt/decrypt your data using a symmetric cipher you first have to build a Crypt::GCrypt object: my $cipher = Crypt::GCrypt->new( type => 'cipher', algorithm => 'aes', mode => 'cbc' ); The I argument must be "cipher" and I is required too. See below for a description of available algorithms and other initialization parameters: =over 4 =item algorithm This may be one of the following: =over 8 =item B<3des> Triple-DES with 3 Keys as EDE. The key size of this algorithm is 168 but you have to pass 192 bits because the most significant bits of each byte are ignored. =item B AES (Rijndael) with a 128 bit key. =item B AES (Rijndael) with a 192 bit key. =item B AES (Rijndael) with a 256 bit key. =item B The blowfish algorithm. The current implementation allows only for a key size of 128 bits (and thus is not compatible with Crypt::Blowfish). =item B CAST128-5 block cipher algorithm. The key size is 128 bits. =item B Standard DES with a 56 bit key. You need to pass 64 bit but the high bits of each byte are ignored. Note, that this is a weak algorithm which can be broken in reasonable time using a brute force approach. =item B The Twofish algorithm with a 256 bit key. =item B The Twofish algorithm with a 128 bit key. =item B An algorithm which is 100% compatible with RSA Inc.'s RC4 algorithm. Note that this is a stream cipher and must be used very carefully to avoid a couple of weaknesses. =back =item mode This is a string specifying one of the following encryption/decryption modes: =over 8 =item B only available for stream ciphers =item B doesn't use an IV, encrypts each block independently =item B the current ciphertext block is encryption of current plaintext block xor-ed with last ciphertext block =item B the current ciphertext block is the current plaintext block xor-ed with the current keystream block, which is the encryption of the last ciphertext block =item B the current ciphertext block is the current plaintext block xor-ed with the current keystream block, which is the encryption of the last keystream block =back If no mode is specified then B is selected for block ciphers, and B for stream ciphers. =item padding When the last block of plaintext is shorter than the block size, it must be padded before encryption. Padding should permit a safe unpadding after decryption. Crypt::GCrypt currently supports two methods: =over 8 =item B This is also known as PKCS#5 padding, as it's binary safe. The string is padded with the number of bytes that should be truncated. It's compatible with Crypt::CBC. =item B Only for text strings. The block will be padded with null bytes (00). If the last block is a full block and blocksize is 8, a block of "0000000000000000" will be appended. =item B By setting the padding method to "none", Crypt::GCrypt will only accept a multiple of blklen as input for L. =back =item secure If this option is set to a true value, all data associated with this cipher will be put into non-swappable storage, if possible. =item enable_sync Enable the CFB sync operation. =back Once you've got your cipher object the following methods are available: =head2 start() $cipher->start('encrypting'); $cipher->start('decrypting'); This method must be called before any call to setkey() or setiv(). It prepares the cipher for encryption or decryption, resetting the internal state. =head2 setkey() $cipher->setkey('my secret key'); Encryption and decryption operations will use this key until a different one is set. If your key is shorter than the cipher's keylen (see the C method) it will be zero-padded, if it is longer it will be truncated. =head2 setiv() $cipher->setiv('my iv'); Set the initialisation vector for the next encrypt/decrypt operation. If I is missing a "standard" IV of all zero is used. The same IV is set in newly created cipher objects. =head2 encrypt() $ciphertext = $cipher->encrypt($plaintext); This method encrypts I<$plaintext> with I<$cipher>, returning the corresponding ciphertext. The output is buffered; this means that you'll only get multiples of $cipher's block size and that at the end you'll have to call L. =head2 finish() $ciphertext .= $cipher->finish; $plaintext .= $cipher->finish; The CBC algorithm must buffer data blocks internally until there are even multiples of the encryption algorithm's blocksize (typically 8 or 16 bytes). After the last call to encrypt() or decrypt() you should call finish() to flush the internal buffer and return any leftover data. This method will also take care of padding/unpadding of data (see the L option above). =head2 decrypt() $plaintext = $cipher->decrypt($ciphertext); The counterpart to encrypt, decrypt takes a I<$ciphertext> and produces the original plaintext (given that the right key was used, of course). The output is buffered; this means that you'll only get multiples of $cipher's block size and that at the end you'll have to call L. =head2 keylen() print "Key length is " . $cipher->keylen(); Returns the number of bytes of keying material this cipher needs. =head2 blklen() print "Block size is " . $cipher->blklen(); As their name implies, block ciphers operate on blocks of data. This method returns the size of this blocks in bytes for this particular cipher. For stream ciphers C<1> is returned, since this implementation does not feed less than a byte into the cipher. =head2 sync() $cipher->sync(); Apply the CFB sync operation. =head1 MESSAGE DIGESTS =head2 digest_algo_available() Determines whether a given digest algorithm is available in the local gcrypt installation: if (Crypt::GCrypt::digest_algo_available('sha256')) { # do stuff with sha256 } =head2 new() In order to create a message digest, you first have to build a Crypt::GCrypt object: my $digest = Crypt::GCrypt->new( type => 'digest', algorithm => 'sha256', ); The I argument must be "digest" and I is required too. See below for a description of available algorithms and other initialization parameters: =over 4 =item algorithm Depending on your available version of gcrypt, this can be one of the following hash algorithms. Note that some gcrypt installations do not implement certain algorithms (see digest_algo_available()). =over 8 =item B =item B =item B =item B =item B =item B =item B =item B =item B =item B =back =item secure If this option is set to a true value, all data associated with this digest will be put into non-swappable storage, if possible. =item hmac If the digest is expected to be used as a keyed-Hash Message Authentication Code (HMAC), supply the key with this argument. It is good practice to ensure that the key is at least as long as the digest used. =back Once you've got your digest object the following methods are available: =head2 digest_length() my $len = $digest->digest_length(); Returns the length in bytes of the digest produced by this algorithm. =head2 write() $digest->write($data); Feeds data into the hash context. Once you have called read(), this method can't be called anymore. =head2 reset() Re-initializes the digest with the same parameters it was initially created with. This allows write()ing again, after a call to read(). =head2 clone() Creates a new digest object with the exact same internal state. This is useful if you want to retrieve intermediate digests (i.e. read() from the copy and continue write()ing to the original). =head2 read() my $md = $digest->read(); Completes the digest and return the resultant string. You can call this multiple times, and it will return the same information. Once a digest object has been read(), it may not be written to. =head1 THREAD SAFETY libgcrypt is initialized with support for Pthread, so this module should be thread safe. =head1 SEE ALSO Crypt::GCrypt::MPI supports Multi-precision integers (bignum math) using libgcrypt as the backend implementation. =head1 BUGS AND FEEDBACK There are no known bugs. You are very welcome to write mail to the author (aar@cpan.org) with your contributions, comments, suggestions, bug reports or complaints. =head1 AUTHORS AND CONTRIBUTORS Alessandro Ranellucci Eaar@cpan.orgE Daniel Kahn Gillmor (message digests) Edkg@fifthhorseman.netE =head1 COPYRIGHT AND LICENSE Copyright (c) Alessandro Ranellucci. Crypt::GCrypt is free software, you may redistribute it and/or modify it under the same terms as Perl itself. =head1 ACKNOWLEDGEMENTS This module was initially inspired by the GCrypt.pm bindings made by Robert Bihlmeyer in 2002. Thanks to users who give feedback and submit patches (see Changelog). =head1 DISCLAIMER This software is provided by the copyright holders and contributors ``as is'' and any express or implied warranties, including, but not limited to, the implied warranties of merchantability and fitness for a particular purpose are disclaimed. In no event shall the regents or contributors be liable for any direct, indirect, incidental, special, exemplary, or consequential damages (including, but not limited to, procurement of substitute goods or services; loss of use, data, or profits; or business interruption) however caused and on any theory of liability, whether in contract, strict liability, or tort (including negligence or otherwise) arising in any way out of the use of this software, even if advised of the possibility of such damage. =cut Crypt-GCrypt-1.26/lib/Crypt/GCrypt/MPI.pm000644 000765 000024 00000015035 12150167702 017557 0ustar00alstaff000000 000000 # =========================================================================== # Crypt::GCrypt:MPI # # Perl interface to multi-precision integers from the GNU Cryptographic library # # Author: Daniel Kahn Gillmor Edkg@fifthhorseman.netE, # Alessandro Ranellucci Eaar@cpan.orgE # Copyright © 2009. # # Use this software AT YOUR OWN RISK. # See below for documentation. # package Crypt::GCrypt::MPI; use strict; use warnings; use Crypt::GCrypt; 1; __END__ =encoding utf8 =head1 NAME Crypt::GCrypt::MPI - Perl interface to multi-precision integers from the GNU Cryptographic library =head1 SYNOPSIS use Crypt::GCrypt::MPI; my $mpi = Crypt::GCrypt::MPI->new(); =head1 ABSTRACT Crypt::GCrypt::MPI provides an object interface to multi-precision integers from the C libgcrypt library. =head1 BASIC OPERATIONS =head2 new() Create a new multi-precision integer. my $mpi = Crypt::GCrypt::MPI::new( secure => 1, value => 20, ); No parameters are required. If only one parameter is given, it is treated as the "value" parameter. Available parameters: =over 4 =item value The initial value of the MPI. This can be an integer, a string, or another Crypt::GCrypt::MPI. (It would also be nice to be able to initialize it with a Math::Int). =item secure If this parameter evaluates to non-zero, initialize the MPI using secure memory, if possible. =item format If the value is a string, the format parameter suggests how to convert the string. See CONVERSION FORMATS for the available formats. Defaults to Crypt::GCrypt::MPI::FMT_STD. =back =head2 set() Copies the value of the other Crypt::GCrypt::MPI object. $mpi->set($othermpi); =head2 swap() Exchanges the value with the value of another Crypt::GCrpyt::MPI object: $mpi->swap($othermpi); =head2 is_secure() Returns true if the Crypt::GCrypt::MPI uses secure memory, where possible. =head2 cmp($other) Compares this object against another Crypt::GCrypt::MPI object, returning 0 if the two values are equal, positive if this value is greater, negative if $other is greater. =head2 mutually_prime($other) Compares this object against another Crypt::GCrypt::MPI object, returning true only if the two values share no factors in common other than 1. =head2 copy() Returns a new Crypt::GCrypt::MPI object, with the contents identical to this one. This is different from using the assignment operator (=), which just makes two references to the same object. For example: $b = new Crypt::GCrypt::MPI(15); $a = $b; $b->add(1); # $a points to the same object, # so both $a and $b contain 16. $a = $b->copy(); # $a and $b are both 16, but # different objects; no risk of # double-free. $b->add(1); # $a == 16, $b == 17 If $b is a Crypt::GCrypt::MPI object, then "$a = $b->copy();" is identical to "$a = Crypt::GCrypt::MPI->new($b);" =head1 CALCULATIONS All calculation operations modify the object they are called on, and return the same object, so you can chain them like this: $g->addm($a, $m)->mulm($b, $m)->gcd($x); If you don't want an operation to affect the initial object, use the copy() operator: $h = $g->copy()->addm($a, $m)->mulm($b, $m)->gcd($x); =head2 add($other) Adds the value of $other to this MPI. =head2 addm($other, $modulus) Adds the value of $other to this MPI, modulo the value of $modulus. =head2 sub($other) Subtracts the value of $other from this MPI. =head2 subm($other, $modulus) Subtracts the value of $other from this MPI, modulo the value of $modulus. =head2 mul($other) Multiply this MPI by the value of $other. =head2 mulm($other, $modulus) Multiply this MPI by the value of $other, modulo the value of $modulus. =head2 mul_2exp($e) Multiply this MPI by 2 raised to the power of $e (this is a leftward bitshift) =head2 div($other) Divide this MPI by the value of $other, leaving the integer quotient. (This is integer division) =head2 mod($other) Divide this MPI by the value of $other, leaving the integer remainder. (This is the modulus operation) =head2 powm($other, $modulus) Raise this MPI to the power of $other, modulo the value of $modulus. =head2 invm($modulus) Find the multiplicative inverse of this MPI, modulo $modulus. =head2 gcd($other) Find the greatest common divisor of this MPI and $other. =head1 OUTPUT AND DEBUGGING =head2 dump() Send the MPI to the libgcrypt debugging stream. =head2 print($format) Return a string with the data of this MPI, in a given format. See CONVERSION FORMATS for the available formats. =head1 CONVERSION FORMATS The available printing and scanning formats are all in the Crypt::GCrypt::MPI namespace, and have the same meanings as in gcrypt. =head2 FMT_STD Two's complement representation. =head2 FMT_PGP Same as FMT_STD, but with two-byte length header, as used in OpenPGP. (Only works for non-negative values) =head2 FMT_SSH Same as FMT_STD, but with four-byte length header, as used by OpenSSH. =head2 FMT_HEX Hexadecimal string in ASCII. =head2 FMT_USG Simple unsigned integer. =head1 BUGS AND FEEDBACK Crypt::GCrypt::MPI does not currently auto-convert to and from Math::BigInt objects, even though it should. Other than that, here are no known bugs. You are very welcome to write mail to the maintainer (aar@cpan.org) with your contributions, comments, suggestions, bug reports or complaints. =head1 AUTHORS AND CONTRIBUTORS Daniel Kahn Gillmor Edkg@fifthhorseman.netE Alessandro Ranellucci Eaar@cpan.orgE =head1 COPYRIGHT AND LICENSE Copyright © Daniel Kahn Gillmor. Crypt::GCrypt::MPI is free software, you may redistribute it and/or modify it under the same terms as Perl itself. =head1 ACKNOWLEDGEMENTS This module was initially inspired by the GCrypt.pm bindings made by Robert Bihlmeyer in 2002. Thanks to users who give feedback and submit patches (see Changelog). =head1 DISCLAIMER This software is provided by the copyright holders and contributors ``as is'' and any express or implied warranties, including, but not limited to, the implied warranties of merchantability and fitness for a particular purpose are disclaimed. In no event shall the regents or contributors be liable for any direct, indirect, incidental, special, exemplary, or consequential damages (including, but not limited to, procurement of substitute goods or services; loss of use, data, or profits; or business interruption) however caused and on any theory of liability, whether in contract, strict liability, or tort (including negligence or otherwise) arising in any way out of the use of this software, even if advised of the possibility of such damage. =cut Crypt-GCrypt-1.26/inc/Devel/000755 000765 000024 00000000000 12150170166 015317 5ustar00alstaff000000 000000 Crypt-GCrypt-1.26/inc/Devel/CheckLib.pm000644 000765 000024 00000035441 12150167702 017332 0ustar00alstaff000000 000000 # $Id: CheckLib.pm,v 1.25 2008/10/27 12:16:23 drhyde Exp $ package # Devel::CheckLib; use 5.00405; #postfix foreach use strict; use vars qw($VERSION @ISA @EXPORT); $VERSION = '0.99'; use Config qw(%Config); use Text::ParseWords 'quotewords'; use File::Spec; use File::Temp; require Exporter; @ISA = qw(Exporter); @EXPORT = qw(assert_lib check_lib_or_exit check_lib); # localising prevents the warningness leaking out of this module local $^W = 1; # use warnings is a 5.6-ism _findcc(); # bomb out early if there's no compiler =head1 NAME Devel::CheckLib - check that a library is available =head1 DESCRIPTION Devel::CheckLib is a perl module that checks whether a particular C library and its headers are available. =head1 SYNOPSIS use Devel::CheckLib; check_lib_or_exit( lib => 'jpeg', header => 'jpeglib.h' ); check_lib_or_exit( lib => [ 'iconv', 'jpeg' ] ); # or prompt for path to library and then do this: check_lib_or_exit( lib => 'jpeg', libpath => $additional_path ); =head1 USING IT IN Makefile.PL or Build.PL If you want to use this from Makefile.PL or Build.PL, do not simply copy the module into your distribution as this may cause problems when PAUSE and search.cpan.org index the distro. Instead, use the use-devel-checklib script. =head1 HOW IT WORKS You pass named parameters to a function, describing to it how to build and link to the libraries. It works by trying to compile some code - which defaults to this: int main(void) { return 0; } and linking it to the specified libraries. If something pops out the end which looks executable, it gets executed, and if main() returns 0 we know that it worked. That tiny program is built once for each library that you specify, and (without linking) once for each header file. If you want to check for the presence of particular functions in a library, or even that those functions return particular results, then you can pass your own function body for main() thus: check_lib_or_exit( function => 'foo();if(libversion() > 5) return 0; else return 1;' incpath => ... libpath => ... lib => ... header => ... ); In that case, it will fail to build if either foo() or libversion() don't exist, and main() will return the wrong value if libversion()'s return value isn't what you want. =head1 FUNCTIONS All of these take the same named parameters and are exported by default. To avoid exporting them, C. =head2 assert_lib This takes several named parameters, all of which are optional, and dies with an error message if any of the libraries listed can not be found. B: dying in a Makefile.PL or Build.PL may provoke a 'FAIL' report from CPAN Testers' automated smoke testers. Use C instead. The named parameters are: =over =item lib Must be either a string with the name of a single library or a reference to an array of strings of library names. Depending on the compiler found, library names will be fed to the compiler either as C<-l> arguments or as C<.lib> file names. (E.g. C<-ljpeg> or C) =item libpath a string or an array of strings representing additional paths to search for libraries. =item LIBS a C-style space-seperated list of libraries (each preceded by '-l') and directories (preceded by '-L'). This can also be supplied on the command-line. =item debug If true - emit information during processing that can be used for debugging. =back And libraries are no use without header files, so ... =over =item header Must be either a string with the name of a single header file or a reference to an array of strings of header file names. =item incpath a string or an array of strings representing additional paths to search for headers. =item INC a C-style space-seperated list of incpaths, each preceded by '-I'. This can also be supplied on the command-line. =back =head2 check_lib_or_exit This behaves exactly the same as C except that instead of dieing, it warns (with exactly the same error message) and exits. This is intended for use in Makefile.PL / Build.PL when you might want to prompt the user for various paths and things before checking that what they've told you is sane. If any library or header is missing, it exits with an exit value of 0 to avoid causing a CPAN Testers 'FAIL' report. CPAN Testers should ignore this result -- which is what you want if an external library dependency is not available. =head2 check_lib This behaves exactly the same as C except that it is silent, returning false instead of dieing, or true otherwise. =cut sub check_lib_or_exit { eval 'assert_lib(@_)'; if($@) { warn $@; exit; } } sub check_lib { eval 'assert_lib(@_)'; return $@ ? 0 : 1; } sub assert_lib { my %args = @_; my (@libs, @libpaths, @headers, @incpaths); # FIXME: these four just SCREAM "refactor" at me @libs = (ref($args{lib}) ? @{$args{lib}} : $args{lib}) if $args{lib}; @libpaths = (ref($args{libpath}) ? @{$args{libpath}} : $args{libpath}) if $args{libpath}; @headers = (ref($args{header}) ? @{$args{header}} : $args{header}) if $args{header}; @incpaths = (ref($args{incpath}) ? @{$args{incpath}} : $args{incpath}) if $args{incpath}; # work-a-like for Makefile.PL's LIBS and INC arguments # if given as command-line argument, append to %args for my $arg (@ARGV) { for my $mm_attr_key (qw(LIBS INC)) { if (my ($mm_attr_value) = $arg =~ /\A $mm_attr_key = (.*)/x) { # it is tempting to put some \s* into the expression, but the # MM command-line parser only accepts LIBS etc. followed by =, # so we should not be any more lenient with whitespace than that $args{$mm_attr_key} .= " $mm_attr_value"; } } } # using special form of split to trim whitespace if(defined($args{LIBS})) { foreach my $arg (split(' ', $args{LIBS})) { die("LIBS argument badly-formed: $arg\n") unless($arg =~ /^-[lLR]/); push @{$arg =~ /^-l/ ? \@libs : \@libpaths}, substr($arg, 2); } } if(defined($args{INC})) { foreach my $arg (split(' ', $args{INC})) { die("INC argument badly-formed: $arg\n") unless($arg =~ /^-I/); push @incpaths, substr($arg, 2); } } my ($cc, $ld) = _findcc(); my @missing; my @wrongresult; my @use_headers; # first figure out which headers we can't find ... for my $header (@headers) { push @use_headers, $header; my($ch, $cfile) = File::Temp::tempfile( 'assertlibXXXXXXXX', SUFFIX => '.c' ); my $ofile = $cfile; $ofile =~ s/\.c$/$Config{_o}/; print $ch qq{#include <$_>\n} for @use_headers; print $ch qq{int main(void) { return 0; }\n}; close($ch); my $exefile = File::Temp::mktemp( 'assertlibXXXXXXXX' ) . $Config{_exe}; my @sys_cmd; # FIXME: re-factor - almost identical code later when linking if ( $Config{cc} eq 'cl' ) { # Microsoft compiler require Win32; @sys_cmd = ( @$cc, $cfile, "/Fe$exefile", (map { '/I'.Win32::GetShortPathName($_) } @incpaths), "/link", @$ld ); } elsif($Config{cc} =~ /bcc32(\.exe)?/) { # Borland @sys_cmd = ( @$cc, @$ld, (map { "-I$_" } @incpaths), "-o$exefile", $cfile ); } else { # Unix-ish: gcc, Sun, AIX (gcc, cc), ... @sys_cmd = ( @$cc, @$ld, $cfile, (map { "-I$_" } @incpaths), "-o", "$exefile" ); } warn "# @sys_cmd\n" if $args{debug}; my $rv = $args{debug} ? system(@sys_cmd) : _quiet_system(@sys_cmd); push @missing, $header if $rv != 0 || ! -x $exefile; _cleanup_exe($exefile); unlink $ofile if -e $ofile; unlink $cfile; } # now do each library in turn with headers my($ch, $cfile) = File::Temp::tempfile( 'assertlibXXXXXXXX', SUFFIX => '.c' ); my $ofile = $cfile; $ofile =~ s/\.c$/$Config{_o}/; print $ch qq{#include <$_>\n} foreach (@headers); print $ch "int main(void) { ".($args{function} || 'return 0;')." }\n"; close($ch); for my $lib ( @libs ) { my $exefile = File::Temp::mktemp( 'assertlibXXXXXXXX' ) . $Config{_exe}; my @sys_cmd; if ( $Config{cc} eq 'cl' ) { # Microsoft compiler require Win32; my @libpath = map { q{/libpath:} . Win32::GetShortPathName($_) } @libpaths; # this is horribly sensitive to the order of arguments @sys_cmd = ( @$cc, $cfile, "${lib}.lib", "/Fe$exefile", (map { '/I'.Win32::GetShortPathName($_) } @incpaths), "/link", @$ld, (map {'/libpath:'.Win32::GetShortPathName($_)} @libpaths), ); } elsif($Config{cc} eq 'CC/DECC') { # VMS } elsif($Config{cc} =~ /bcc32(\.exe)?/) { # Borland @sys_cmd = ( @$cc, @$ld, "-o$exefile", (map { "-I$_" } @incpaths), (map { "-L$_" } @libpaths), "-l$lib", $cfile); } else { # Unix-ish # gcc, Sun, AIX (gcc, cc) @sys_cmd = ( @$cc, @$ld, $cfile, "-o", "$exefile", (map { "-I$_" } @incpaths), (map { "-L$_" } @libpaths), "-l$lib", ); } warn "# @sys_cmd\n" if $args{debug}; my $rv = $args{debug} ? system(@sys_cmd) : _quiet_system(@sys_cmd); push @missing, $lib if $rv != 0 || ! -x $exefile; my $absexefile = File::Spec->rel2abs($exefile); $absexefile = '"'.$absexefile.'"' if $absexefile =~ m/\s/; push @wrongresult, $lib if $rv == 0 && -x $exefile && system($absexefile) != 0; unlink $ofile if -e $ofile; _cleanup_exe($exefile); } unlink $cfile; my $miss_string = join( q{, }, map { qq{'$_'} } @missing ); die("Can't link/include C library $miss_string, aborting.\n") if @missing; my $wrong_string = join( q{, }, map { qq{'$_'} } @wrongresult); die("wrong result: $wrong_string\n") if @wrongresult; } sub _cleanup_exe { my ($exefile) = @_; my $ofile = $exefile; $ofile =~ s/$Config{_exe}$/$Config{_o}/; unlink $exefile if -f $exefile; unlink $ofile if -f $ofile; unlink "$exefile\.manifest" if -f "$exefile\.manifest"; if ( $Config{cc} eq 'cl' ) { # MSVC also creates foo.ilk and foo.pdb my $ilkfile = $exefile; $ilkfile =~ s/$Config{_exe}$/.ilk/; my $pdbfile = $exefile; $pdbfile =~ s/$Config{_exe}$/.pdb/; unlink $ilkfile if -f $ilkfile; unlink $pdbfile if -f $pdbfile; } return } # return ($cc, $ld) # where $cc is an array ref of compiler name, compiler flags # where $ld is an array ref of linker flags sub _findcc { # Need to use $keep=1 to work with MSWin32 backslashes and quotes my $Config_ccflags = $Config{ccflags}; # use copy so ASPerl will compile my @Config_ldflags = (); for my $config_val ( @Config{qw(ldflags perllibs)} ){ push @Config_ldflags, $config_val if ( $config_val =~ /\S/ ); } my @ccflags = grep { length } quotewords('\s+', 1, $Config_ccflags||''); my @ldflags = grep { length } quotewords('\s+', 1, @Config_ldflags); my @paths = split(/$Config{path_sep}/, $ENV{PATH}); my @cc = split(/\s+/, $Config{cc}); return ( [ @cc, @ccflags ], \@ldflags ) if -x $cc[0]; foreach my $path (@paths) { my $compiler = File::Spec->catfile($path, $cc[0]) . $Config{_exe}; return ([ $compiler, @cc[1 .. $#cc], @ccflags ], \@ldflags) if -x $compiler; } die("Couldn't find your C compiler\n"); } # code substantially borrowed from IPC::Run3 sub _quiet_system { my (@cmd) = @_; # save handles local *STDOUT_SAVE; local *STDERR_SAVE; open STDOUT_SAVE, ">&STDOUT" or die "CheckLib: $! saving STDOUT"; open STDERR_SAVE, ">&STDERR" or die "CheckLib: $! saving STDERR"; # redirect to nowhere local *DEV_NULL; open DEV_NULL, ">" . File::Spec->devnull or die "CheckLib: $! opening handle to null device"; open STDOUT, ">&" . fileno DEV_NULL or die "CheckLib: $! redirecting STDOUT to null handle"; open STDERR, ">&" . fileno DEV_NULL or die "CheckLib: $! redirecting STDERR to null handle"; # run system command my $rv = system(@cmd); # restore handles open STDOUT, ">&" . fileno STDOUT_SAVE or die "CheckLib: $! restoring STDOUT handle"; open STDERR, ">&" . fileno STDERR_SAVE or die "CheckLib: $! restoring STDERR handle"; return $rv; } =head1 PLATFORMS SUPPORTED You must have a C compiler installed. We check for C<$Config{cc}>, both literally as it is in Config.pm and also in the $PATH. It has been tested with varying degrees on rigourousness on: =over =item gcc (on Linux, *BSD, Mac OS X, Solaris, Cygwin) =item Sun's compiler tools on Solaris =item IBM's tools on AIX =item SGI's tools on Irix 6.5 =item Microsoft's tools on Windows =item MinGW on Windows (with Strawberry Perl) =item Borland's tools on Windows =item QNX =back =head1 WARNINGS, BUGS and FEEDBACK This is a very early release intended primarily for feedback from people who have discussed it. The interface may change and it has not been adequately tested. Feedback is most welcome, including constructive criticism. Bug reports should be made using L or by email. When submitting a bug report, please include the output from running: perl -V perl -MDevel::CheckLib -e0 =head1 SEE ALSO L L =head1 AUTHORS David Cantrell Edavid@cantrell.org.ukE David Golden Edagolden@cpan.orgE Yasuhiro Matsumoto Emattn@cpan.orgE Thanks to the cpan-testers-discuss mailing list for prompting us to write it in the first place; to Chris Williams for help with Borland support; to Tony Cook for help with Microsoft compiler command-line options =head1 COPYRIGHT and LICENCE Copyright 2007 David Cantrell. Portions copyright 2007 David Golden. This module is free-as-in-speech software, and may be used, distributed, and modified under the same conditions as perl itself. =head1 CONSPIRACY This module is also free-as-in-mason software. =cut 1;