Permalink
Browse files

initial checkin.

  • Loading branch information...
0 parents commit 62ffc32e30d259e031223e732fef4cef8d4c2c62 @agentzh agentzh committed May 16, 2010
52 .gitignore
@@ -0,0 +1,52 @@
+*.mobi
+genmobi.sh
+.libs
+*.swp
+*.slo
+*.la
+*.swo
+*.lo
+*~
+*.o
+print.txt
+.rsync
+*.tar.gz
+dist
+build[78]
+build
+tags
+update-readme
+*.tmp
+test/Makefile
+test/blib
+test.sh
+t.sh
+t/t.sh
+test/t/servroot/
+releng
+reset
+*.t_
+src/handler.h
+src/util.c
+src/module.h
+src/module.c
+src/drizzle.c
+src/processor.h
+src/handler.c
+src/util.h
+src/drizzle.h
+src/processor.c
+src/output.c
+src/output.h
+libdrizzle
+ctags
+src/stream.h
+nginx
+keepalive
+reindex
+src/module.h
+src/module.c
+util/bench
+src/cipher.c
+src/cipher.h
+pack.sh
194 README
@@ -0,0 +1,194 @@
+Name
+ encrypted-session-nginx-module - more rewrite set commands
+
+ *This module is not distributed with the Nginx source.* See the
+ installation instructions.
+
+Status
+ This module is production ready.
+
+Synopsis
+
+ # key must be of 32 bytes long
+ encrypted_session_key "abcdefghijklmnopqrstuvwxyz123456";
+
+ # iv must not be longer than 16 bytes
+ # default: "deadbeefdeadbeef" (w/o quotes)
+ encrypted_session_iv "1234567812345678";
+
+ # default: 1d (1 day)
+ encrypted_session_expires 2; # in sec
+
+ location /encrypt {
+ set $raw 'text to encrypted'; # from the ngx_rewrite module
+ set_encrypt_session $session $raw;
+ set_encode_base32 $session; # from the ngx_set_misc module
+
+ add_header 'Set-Cookie: my-login=$session'; # from the ngx_headers module
+
+ # your content handler goes here...
+ }
+
+ location /decrypt {
+ set_decode_base32 $session $cookie_lz_login; # from the ngx_set_misc module
+ set_decrypt_session $raw $session;
+
+ if ($raw = '') {
+ # bad session
+ }
+
+ # your content handler goes here...
+ }
+
+Description
+ This module provides encryption and decryption support for
+ nginx variables based on AES-256 with Mac.
+
+ This module is usually used with the ngx_set_misc module
+ ( http://github.com/agentzh/set-misc-nginx-module )
+ and the standard rewrite module's directives.
+
+ This module can be used to implement simple user login and ACL.
+
+Directives
+ set_if_empty
+
+ set_quote_sql_value
+
+ set_unescape_uri
+
+ set_hashed_upstream
+
+ set_encode_base32
+
+ set_decode_base32
+
+Installation
+ 1. Grab the nginx source code from nginx.net (<http://nginx.net/ >), for
+ example, the version 0.8.29 (see nginx compatibility),
+
+ 2. Grab the NDK module from GitHub:
+ http://github.com/agentzh/ngx_devel_kit
+
+ 3. and then build the source with this module:
+
+ $ wget 'http://sysoev.ru/nginx/nginx-0.8.29.tar.gz'
+ $ tar -xzvf nginx-0.8.29.tar.gz
+ $ cd nginx-0.8.29/
+
+ # Here we assume you would install you nginx under /opt/nginx/.
+ $ ./configure --prefix=/opt/nginx \
+ --add-module=/path/to/ngx_devel_kit \
+ --add-module=/path/to/encrypted-session-nginx-module
+
+ $ make -j2
+ $ make install
+
+ Download the latest version of the release tarball of this module from
+ encrypted-session-nginx-module file list
+ (<http://github.com/agentzh/encrypted-session-nginx-module/downloads >).
+
+Compatibility
+ The following versions of Nginx should work with this module:
+
+ * 0.8.x (last tested version is 0.8.36)
+
+ * 0.7.x >= 0.7.46 (last tested version is 0.7.65)
+
+ Earlier versions of Nginx like 0.6.x and 0.5.x will *not* work.
+
+ If you find that any particular version of Nginx above 0.7.44 does not
+ work with this module, please consider reporting a bug.
+
+Report Bugs
+ Although a lot of effort has been put into testing and code tuning,
+ there must be some serious bugs lurking somewhere in this module. So
+ whenever you are bitten by any quirks, please don't hesitate to
+
+ 1. send a bug report or even patches to <agentzh@gmail.com>,
+
+ 2. or create a ticket on the issue tracking interface
+ (<http://github.com/agentzh/encrypted-session-nginx-module/issues >)
+ provided by GitHub.
+
+Source Repository
+ Available on github at agentzh/encrypted-session-nginx-module
+ (<http://github.com/agentzh/encrypted-session-nginx-module >).
+
+ChangeLog
+
+Test Suite
+ This module comes with a Perl-driven test suite. The test cases
+ (<http://github.com/agentzh/encrypted-session-nginx-module/tree/master/test/t/ >
+ ) are declarative
+ (<http://github.com/agentzh/encrypted-session-nginx-module/blob/master/test/t/sanity.t >)
+ too. Thanks to the Test::Base
+ (<http://search.cpan.org/perldoc?Test::Base >) module in the Perl world.
+
+ To run it on your side:
+
+ $ cd test
+ $ PATH=/path/to/your/nginx-with-encrypted-session-module:$PATH prove -r t
+
+ Test::Nginx (<http://search.cpan.org/perldoc?Test::Nginx >) is used by
+ the test scaffold.
+
+ You need to terminate any Nginx processes before running the test suite
+ if you have changed the Nginx server binary.
+
+ Because a single nginx server (by default, "localhost:1984") is used
+ across all the test scripts (".t" files), it's meaningless to run the
+ test suite in parallel by specifying "-jN" when invoking the "prove"
+ utility.
+
+ Some parts of the test suite requires modules rewrite, and echo
+ to be enabled as well when building Nginx.
+
+TODO
+
+Getting involved
+ You'll be very welcomed to submit patches to the author or just ask for
+ a commit bit to the source repository on GitHub.
+
+Author
+ agentzh (章亦春) *<agentzh@gmail.com>*
+
+Copyright & License
+ Copyright (c) 2010, Taobao Inc., Alibaba Group ( http://www.taobao.com
+ ).
+
+ Copyright (c) 2009, agentzh <agentzh@gmail.com>.
+
+ This module is licensed under the terms of the BSD license.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are
+ met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+
+ * Neither the name of the Taobao Inc. nor the names of its
+ contributors may be used to endorse or promote products derived from
+ this software without specific prior written permission.
+
+ 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 COPYRIGHT
+ HOLDER 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.
+
+See Also
+ * NDK: http://github.com/simpl-it/ngx_devel_kit
+ * ngx_set_misc module: http://github.com/agentzh/set-misc-nginx-module
+
7 config
@@ -0,0 +1,7 @@
+ngx_addon_name=ngx_http_encrypted_session_module
+HTTP_AUX_FILTER_MODULES="$HTTP_AUX_FILTER_MODULES ngx_http_encrypted_session_module"
+NGX_ADDON_SRCS="$NGX_ADDON_SRCS $ngx_addon_dir/src/ngx_http_encrypted_session_module.c $ngx_addon_dir/src/ngx_http_encrypted_session_cipher.c"
+NGX_ADDON_DEPS="$NGX_ADDON_DEPS $ngx_addon_dir/src/ddebug.h $ngx_addon_dir/src/ngx_http_encrypted_session_cipher.h"
+CFLAGS="$CFLAGS -DNDK_SET_VAR"
+CORE_LIBS="$CORE_LIBS -lssl"
+
71 src/ddebug.h
@@ -0,0 +1,71 @@
+#ifndef DDEBUG_H
+#define DDEBUG_H
+
+#include <ngx_core.h>
+
+#if defined(DDEBUG) && (DDEBUG)
+
+# if (NGX_HAVE_VARIADIC_MACROS)
+
+# define dd(...) fprintf(stderr, "encrypted-session *** "); \
+ fprintf(stderr, __VA_ARGS__); \
+ fprintf(stderr, " at %s line %d.\n", __FILE__, __LINE__)
+
+# else
+
+#include <stdarg.h>
+#include <stdio.h>
+
+#include <stdarg.h>
+
+static void dd(const char * fmt, ...) {
+}
+
+# endif
+
+#else
+
+# if (NGX_HAVE_VARIADIC_MACROS)
+
+# define dd(...)
+
+# else
+
+#include <stdarg.h>
+
+static void dd(const char * fmt, ...) {
+}
+
+# endif
+
+#endif
+
+#if defined(DDEBUG) && (DDEBUG)
+
+#define dd_check_read_event_handler(r) \
+ dd("r->read_event_handler = %s", \
+ r->read_event_handler == ngx_http_block_reading ? \
+ "ngx_http_block_reading" : \
+ r->read_event_handler == ngx_http_test_reading ? \
+ "ngx_http_test_reading" : \
+ r->read_event_handler == ngx_http_request_empty_handler ? \
+ "ngx_http_request_empty_handler" : "UNKNOWN")
+
+#define dd_check_write_event_handler(r) \
+ dd("r->write_event_handler = %s", \
+ r->write_event_handler == ngx_http_handler ? \
+ "ngx_http_handler" : \
+ r->write_event_handler == ngx_http_core_run_phases ? \
+ "ngx_http_core_run_phases" : \
+ r->write_event_handler == ngx_http_request_empty_handler ? \
+ "ngx_http_request_empty_handler" : "UNKNOWN")
+
+#else
+
+#define dd_check_read_event_handler(r)
+#define dd_check_write_event_handler(r)
+
+#endif
+
+#endif /* DDEBUG_H */
+
266 src/ngx_http_encrypted_session_cipher.c
@@ -0,0 +1,266 @@
+#define DDEBUG 0
+#include "ddebug.h"
+
+#include "ngx_http_encrypted_session_cipher.h"
+
+#include <openssl/evp.h>
+#include <openssl/md5.h>
+
+
+static inline uint64_t ngx_http_encrypted_session_ntohll(uint64_t n);
+static inline uint64_t ngx_http_encrypted_session_htonll(uint64_t n);
+
+
+ngx_int_t
+ngx_http_encrypted_session_3des_mac_encrypt(ngx_pool_t *pool, ngx_log_t *log,
+ const u_char *iv, size_t iv_len, const u_char *key,
+ size_t key_len, const u_char *in, size_t in_len,
+ ngx_uint_t expires, u_char **dst, size_t *dst_len)
+{
+ EVP_CIPHER_CTX ctx;
+ const EVP_CIPHER *cipher;
+ u_char *p, *data;
+ int ret;
+ size_t block_size, buf_size, data_size;
+ int len;
+ uint64_t expires_time;
+ time_t now;
+
+ if (key_len != ngx_http_encrypted_session_key_length)
+ {
+ return NGX_ERROR;
+ }
+
+ EVP_CIPHER_CTX_init(&ctx);
+
+ cipher = EVP_aes_256_cbc();
+
+ block_size = EVP_CIPHER_block_size(cipher);
+
+ data_size = in_len + sizeof(expires_time);
+
+ buf_size = MD5_DIGEST_LENGTH /* for the digest */
+ + (data_size + block_size - 1) /* for EVP_EncryptUpdate */
+ + block_size /* for EVP_EncryptFinal */
+ ;
+
+ p = ngx_palloc(pool, buf_size + data_size);
+ if (p == NULL) {
+ return NGX_ERROR;
+ }
+
+ *dst = p;
+
+ data = p + buf_size;
+
+ ngx_memcpy(data, in, in_len);
+
+ if (expires == 0) {
+ expires_time = 0;
+ } else {
+ now = time(NULL);
+ if (now == -1) {
+ goto evp_error;
+ }
+
+ expires_time = (uint64_t) now + (uint64_t) expires;
+ }
+
+ dd("expires before encryption: %lld", (long long) expires_time);
+
+ expires_time = ngx_http_encrypted_session_htonll(expires_time);
+
+ ngx_memcpy(data + in_len, (u_char *) &expires_time, sizeof(expires_time));
+
+ MD5(data, data_size, p);
+
+ p += MD5_DIGEST_LENGTH;
+
+ ret = EVP_EncryptInit(&ctx, cipher, key, iv);
+ if (! ret) {
+ goto evp_error;
+ }
+
+ /* encrypt the raw input data */
+
+ ret = EVP_EncryptUpdate(&ctx, p, &len, data, data_size);
+ if (! ret) {
+ goto evp_error;
+ }
+
+ p += len;
+
+ /* EVP_EncryptFinal clears ctx automatically */
+ ret = EVP_EncryptFinal(&ctx, p, &len);
+ if (! ret) {
+ return NGX_ERROR;
+ }
+
+ p += len;
+
+ *dst_len = p - *dst;
+
+ if (*dst_len > buf_size) {
+ ngx_log_error(NGX_LOG_ERR, log, 0,
+ "encrypted_session: 3des_mac_encrypt: buffer error");
+
+ return NGX_ERROR;
+ }
+
+ return NGX_OK;
+
+evp_error:
+
+ EVP_CIPHER_CTX_cleanup(&ctx);
+
+ return NGX_ERROR;
+}
+
+
+ngx_int_t
+ngx_http_encrypted_session_3des_mac_decrypt(ngx_pool_t *pool, ngx_log_t *log,
+ const u_char *iv, size_t iv_len, const u_char *key,
+ size_t key_len, const u_char *in, size_t in_len, u_char **dst,
+ size_t *dst_len)
+{
+ EVP_CIPHER_CTX ctx;
+ const EVP_CIPHER *cipher;
+ int ret;
+ size_t block_size, buf_size;
+ int len;
+ u_char *p;
+ const u_char *digest;
+ uint64_t expires_time;
+ time_t now;
+
+ u_char new_digest[MD5_DIGEST_LENGTH];
+
+ if (key_len != ngx_http_encrypted_session_key_length
+ || in_len < MD5_DIGEST_LENGTH)
+ {
+ return NGX_ERROR;
+ }
+
+ digest = in;
+
+ EVP_CIPHER_CTX_init(&ctx);
+
+ cipher = EVP_aes_256_cbc();
+
+ ret = EVP_DecryptInit(&ctx, cipher, key, iv);
+ if (! ret) {
+ goto evp_error;
+ }
+
+ block_size = EVP_CIPHER_block_size(cipher);
+
+ buf_size = in_len + block_size /* for EVP_DecryptUpdate */
+ + block_size /* for EVP_DecryptFinal */
+ ;
+
+ p = ngx_palloc(pool, buf_size);
+ if (p == NULL) {
+ return NGX_ERROR;
+ }
+
+ *dst = p;
+
+ ret = EVP_DecryptUpdate(&ctx, p, &len, in + MD5_DIGEST_LENGTH,
+ in_len - MD5_DIGEST_LENGTH);
+
+ if (! ret) {
+ dd("decrypt update failed");
+
+ goto evp_error;
+ }
+
+ p += len;
+
+ /* EVP_DecryptFinal clears ctx automatically */
+ ret = EVP_DecryptFinal(&ctx, p, &len);
+ if (! ret) {
+ dd("decrypt final failed");
+
+ return NGX_ERROR;
+ }
+
+ p += len;
+
+ *dst_len = p - *dst;
+
+ if (*dst_len > buf_size) {
+ ngx_log_error(NGX_LOG_ERR, log, 0,
+ "encrypted_session: 3des_mac_decrypt: buffer error");
+
+ return NGX_ERROR;
+ }
+
+ if (*dst_len < sizeof(expires_time)) {
+ return NGX_ERROR;
+ }
+
+ MD5(*dst, *dst_len, new_digest);
+
+ if (ngx_strncmp(digest, new_digest, MD5_DIGEST_LENGTH) != 0) {
+ dd("decrypt: digest mismatch");
+
+ return NGX_ERROR;
+ }
+
+ *dst_len -= sizeof(expires_time);
+
+ dd("dst len: %d", (int) *dst_len);
+ dd("dst: %.*s", (int) *dst_len, *dst);
+
+ p -= sizeof(expires_time);
+
+ expires_time = ngx_http_encrypted_session_ntohll(
+ *((uint64_t *) p));
+
+ now = time(NULL);
+ if (now == -1) {
+ return NGX_ERROR;
+ }
+
+ dd("expires after decryption: %lld", (long long) expires_time);
+
+ if (expires_time
+ && expires_time <= (uint64_t) now)
+ {
+ dd("session expired: %lld < %lld", (long long) expires_time,
+ (long long) now);
+
+ return NGX_ERROR;
+ }
+
+ dd("decrypted successfully");
+
+ return NGX_OK;
+
+evp_error:
+
+ EVP_CIPHER_CTX_cleanup(&ctx);
+
+ return NGX_ERROR;
+}
+
+
+static inline uint64_t
+ngx_http_encrypted_session_ntohll(uint64_t n) {
+#ifdef ntohll
+ return ntohll(n);
+#else
+ return ((uint64_t) ntohl(n) << 32) + ntohl(n >> 32);
+#endif
+}
+
+
+static inline uint64_t
+ngx_http_encrypted_session_htonll(uint64_t n) {
+#ifdef htonll
+ return htonll(n);
+#else
+ return ((uint64_t) htonl(n) << 32) + htonl(n >> 32);
+#endif
+}
+
28 src/ngx_http_encrypted_session_cipher.h
@@ -0,0 +1,28 @@
+#ifndef NGX_HTTP_ENCRYPTED_SESSION_CIPHER_H
+#define NGX_HTTP_ENCRYPTED_SESSION_CIPHER_H
+
+
+#include <ngx_core.h>
+#include <ngx_http.h>
+#include <openssl/evp.h>
+
+
+enum {
+ ngx_http_encrypted_session_key_length = 256 / 8,
+ ngx_http_encrypted_session_iv_length = EVP_MAX_IV_LENGTH
+};
+
+
+ngx_int_t ngx_http_encrypted_session_3des_mac_encrypt(ngx_pool_t *pool,
+ ngx_log_t *log, const u_char *iv, size_t iv_len, const u_char *key,
+ size_t key_len, const u_char *in, size_t in_len,
+ ngx_uint_t expires, u_char **dst, size_t *dst_len);
+
+ngx_int_t ngx_http_encrypted_session_3des_mac_decrypt(ngx_pool_t *pool,
+ ngx_log_t *log, const u_char *iv, size_t iv_len, const u_char *key,
+ size_t key_len, const u_char *in, size_t in_len, u_char **dst,
+ size_t *dst_len);
+
+
+#endif /* NGX_HTTP_ENCRYPTED_SESSION_CIPHER_H */
+
342 src/ngx_http_encrypted_session_module.c
@@ -0,0 +1,342 @@
+#define DDEBUG 0
+#include "ddebug.h"
+
+#include <ndk.h>
+#include "ngx_http_encrypted_session_cipher.h"
+
+#define ngx_http_encrypted_session_default_iv (u_char *) "deadbeefdeadbeef"
+
+#define ngx_http_encrypted_session_default_expires 86400
+
+
+typedef struct {
+ u_char *key;
+ u_char *iv;
+ time_t expires;
+
+} ngx_http_encrypted_session_conf_t;
+
+
+static ngx_int_t ngx_http_set_encode_encrypted_session(ngx_http_request_t *r,
+ ngx_str_t *res, ngx_http_variable_value_t *v);
+
+static ngx_int_t ngx_http_set_decode_encrypted_session(ngx_http_request_t *r,
+ ngx_str_t *res, ngx_http_variable_value_t *v);
+
+
+static char * ngx_http_encrypted_session_key(ngx_conf_t *cf, ngx_command_t *cmd,
+ void *conf);
+
+static char * ngx_http_encrypted_session_iv(ngx_conf_t *cf, ngx_command_t *cmd,
+ void *conf);
+
+static char * ngx_http_encrypted_session_expires(ngx_conf_t *cf, ngx_command_t *cmd,
+ void *conf);
+
+
+static void *ngx_http_encrypted_session_create_conf(ngx_conf_t *cf);
+
+static char *ngx_http_encrypted_session_merge_conf(ngx_conf_t *cf, void *parent,
+ void *child);
+
+
+static ndk_set_var_t ngx_http_set_encode_encrypted_session_filter = {
+ NDK_SET_VAR_VALUE,
+ ngx_http_set_encode_encrypted_session,
+ 1,
+ NULL
+};
+
+static ndk_set_var_t ngx_http_set_decode_encrypted_session_filter = {
+ NDK_SET_VAR_VALUE,
+ ngx_http_set_decode_encrypted_session,
+ 1,
+ NULL
+};
+
+
+static ngx_command_t ngx_http_encrypted_session_commands[] = {
+ {
+ ngx_string("encrypted_session_key"),
+ NGX_HTTP_MAIN_CONF|NGX_HTTP_SRV_CONF|NGX_HTTP_SIF_CONF
+ |NGX_HTTP_LOC_CONF|NGX_HTTP_LIF_CONF|NGX_CONF_TAKE1,
+ ngx_http_encrypted_session_key,
+ NGX_HTTP_LOC_CONF_OFFSET,
+ 0,
+ NULL
+ },
+ {
+ ngx_string("encrypted_session_iv"),
+ NGX_HTTP_MAIN_CONF|NGX_HTTP_SRV_CONF|NGX_HTTP_SIF_CONF
+ |NGX_HTTP_LOC_CONF|NGX_HTTP_LIF_CONF|NGX_CONF_TAKE1,
+ ngx_http_encrypted_session_iv,
+ NGX_HTTP_LOC_CONF_OFFSET,
+ 0,
+ NULL
+ },
+ {
+ ngx_string("encrypted_session_expires"),
+ NGX_HTTP_MAIN_CONF|NGX_HTTP_SRV_CONF|NGX_HTTP_SIF_CONF
+ |NGX_HTTP_LOC_CONF|NGX_HTTP_LIF_CONF|NGX_CONF_TAKE1,
+ ngx_http_encrypted_session_expires,
+ NGX_HTTP_LOC_CONF_OFFSET,
+ 0,
+ NULL
+ },
+ {
+ ngx_string("set_encrypt_session"),
+ NGX_HTTP_MAIN_CONF|NGX_HTTP_SRV_CONF|NGX_HTTP_SIF_CONF
+ |NGX_HTTP_LOC_CONF|NGX_HTTP_LIF_CONF|NGX_CONF_TAKE12,
+ ndk_set_var_value,
+ NGX_HTTP_LOC_CONF_OFFSET,
+ 0,
+ &ngx_http_set_encode_encrypted_session_filter
+ },
+ {
+ ngx_string("set_decrypt_session"),
+ NGX_HTTP_MAIN_CONF|NGX_HTTP_SRV_CONF|NGX_HTTP_SIF_CONF
+ |NGX_HTTP_LOC_CONF|NGX_HTTP_LIF_CONF|NGX_CONF_TAKE12,
+ ndk_set_var_value,
+ NGX_HTTP_LOC_CONF_OFFSET,
+ 0,
+ &ngx_http_set_decode_encrypted_session_filter
+ },
+
+ ngx_null_command
+};
+
+
+static ngx_http_module_t ngx_http_encrypted_session_module_ctx = {
+ NULL, /* preconfiguration */
+ NULL, /* postconfiguration */
+
+ NULL, /* create main configuration */
+ NULL, /* init main configuration */
+
+ NULL, /* create server configuration */
+ NULL, /* merge server configuration */
+
+ ngx_http_encrypted_session_create_conf, /* create location configuration */
+ ngx_http_encrypted_session_merge_conf, /* merge location configuration */
+};
+
+
+ngx_module_t ngx_http_encrypted_session_module = {
+ NGX_MODULE_V1,
+ &ngx_http_encrypted_session_module_ctx, // module context
+ ngx_http_encrypted_session_commands, // module directives
+ NGX_HTTP_MODULE, // module type
+ NULL, // init master
+ NULL, // init module
+ NULL, // init process
+ NULL, // init thread
+ NULL, // exit thread
+ NULL, // exit process
+ NULL, // exit master
+ NGX_MODULE_V1_PADDING
+};
+
+
+static ngx_int_t
+ngx_http_set_encode_encrypted_session(ngx_http_request_t *r,
+ ngx_str_t *res, ngx_http_variable_value_t *v)
+{
+ size_t len;
+ u_char *dst;
+ ngx_int_t rc;
+
+ ngx_http_encrypted_session_conf_t *conf;
+
+ conf = ngx_http_get_module_loc_conf(r, ngx_http_encrypted_session_module);
+
+ if (conf->key == NULL) {
+ ngx_log_error(NGX_LOG_ERR, r->connection->log, 0,
+ "encrypted_session: a key is required to be "
+ "defined by the encrypted_session_key directive");
+
+ return NGX_ERROR;
+ }
+
+ rc = ngx_http_encrypted_session_3des_mac_encrypt(r->pool, r->connection->log,
+ conf->iv, ngx_http_encrypted_session_iv_length,
+ conf->key, ngx_http_encrypted_session_key_length,
+ v->data, v->len, conf->expires, &dst, &len);
+
+ if (rc != NGX_OK) {
+ dst = NULL;
+ len = 0;
+
+ ngx_log_error(NGX_LOG_INFO, r->connection->log, 0,
+ "encrypted_session: failed to encrypt");
+ }
+
+ res->data = dst;
+ res->len = len;
+
+ return NGX_OK;
+}
+
+
+static ngx_int_t
+ngx_http_set_decode_encrypted_session(ngx_http_request_t *r,
+ ngx_str_t *res, ngx_http_variable_value_t *v)
+{
+ size_t len;
+ u_char *dst;
+ ngx_int_t rc;
+
+ ngx_http_encrypted_session_conf_t *conf;
+
+ conf = ngx_http_get_module_loc_conf(r, ngx_http_encrypted_session_module);
+
+ if (conf->key == NULL) {
+ ngx_log_error(NGX_LOG_ERR, r->connection->log, 0,
+ "encrypted_session: a key is required to be "
+ "defined by the encrypted_session_key directive");
+
+ return NGX_ERROR;
+ }
+
+ rc = ngx_http_encrypted_session_3des_mac_decrypt(r->pool, r->connection->log,
+ conf->iv, ngx_http_encrypted_session_iv_length,
+ conf->key, ngx_http_encrypted_session_key_length,
+ v->data, v->len, &dst, &len);
+
+ if (rc != NGX_OK) {
+ dst = NULL;
+ len = 0;
+
+ ngx_log_error(NGX_LOG_INFO, r->connection->log, 0,
+ "encrypted_session: failed to decrypt");
+
+ }
+
+ res->data = dst;
+ res->len = len;
+
+ return NGX_OK;
+}
+
+
+static char *
+ngx_http_encrypted_session_key(ngx_conf_t *cf, ngx_command_t *cmd, void *conf)
+{
+ ngx_str_t *value;
+ ngx_http_encrypted_session_conf_t *llcf = conf;
+
+ if (llcf->key != NGX_CONF_UNSET_PTR) {
+ return "is duplicate";
+ }
+
+ value = cf->args->elts;
+
+ if (value[1].len != ngx_http_encrypted_session_key_length) {
+ ngx_conf_log_error(NGX_LOG_EMERG, cf, 0,
+ "encrypted_session_key: the key must be of %d bytes long",
+ ngx_http_encrypted_session_key_length);
+
+ return NGX_CONF_ERROR;
+ }
+
+ llcf->key = value[1].data;
+
+ return NGX_CONF_OK;
+}
+
+
+static char *
+ngx_http_encrypted_session_iv(ngx_conf_t *cf, ngx_command_t *cmd, void *conf)
+{
+ ngx_str_t *value;
+ ngx_http_encrypted_session_conf_t *llcf = conf;
+
+ if (llcf->iv != NGX_CONF_UNSET_PTR) {
+ return "is duplicate";
+ }
+
+ value = cf->args->elts;
+
+ if (value[1].len > ngx_http_encrypted_session_iv_length) {
+ ngx_conf_log_error(NGX_LOG_EMERG, cf, 0,
+ "encrypted_session_iv: the init vector must NOT "
+ "be longer than %d bytes",
+ ngx_http_encrypted_session_iv_length);
+
+ return NGX_CONF_ERROR;
+ }
+
+ llcf->iv = ngx_pcalloc(cf->pool,
+ sizeof(ngx_http_encrypted_session_iv_length));
+
+ if (llcf->iv == NULL) {
+ return NGX_CONF_ERROR;
+ }
+
+ if (value[1].len) {
+ ngx_memcpy(llcf->iv, value[1].data, value[1].len);
+ }
+
+ return NGX_CONF_OK;
+}
+
+
+static char *
+ngx_http_encrypted_session_expires(ngx_conf_t *cf, ngx_command_t *cmd, void *conf)
+{
+ ngx_str_t *value;
+ ngx_http_encrypted_session_conf_t *llcf = conf;
+
+ if (llcf->expires != NGX_CONF_UNSET) {
+ return "is duplicate";
+ }
+
+ value = cf->args->elts;
+
+ llcf->expires = ngx_parse_time(&value[1], 1);
+
+ if (llcf->expires == NGX_ERROR) {
+ return "invalid value";
+ }
+
+ dd("expires: %d", (int)llcf->expires);
+
+ return NGX_CONF_OK;
+}
+
+
+static void *
+ngx_http_encrypted_session_create_conf(ngx_conf_t *cf)
+{
+ ngx_http_encrypted_session_conf_t *conf;
+
+ conf = ngx_palloc(cf->pool, sizeof(ngx_http_encrypted_session_conf_t));
+ if (conf == NULL) {
+ return NULL;
+ }
+
+ conf->key = NGX_CONF_UNSET_PTR;
+ conf->iv = NGX_CONF_UNSET_PTR;
+ conf->expires = NGX_CONF_UNSET;
+
+ return conf;
+}
+
+
+static char *
+ngx_http_encrypted_session_merge_conf(ngx_conf_t *cf, void *parent, void *child)
+{
+ ngx_http_encrypted_session_conf_t *prev = parent;
+ ngx_http_encrypted_session_conf_t *conf = child;
+
+ ngx_conf_merge_ptr_value(conf->key, prev->key,
+ NULL);
+
+ ngx_conf_merge_ptr_value(conf->iv, prev->iv,
+ ngx_http_encrypted_session_default_iv);
+
+ ngx_conf_merge_value(conf->expires, prev->expires,
+ ngx_http_encrypted_session_default_expires);
+
+ return NGX_CONF_OK;
+}
+
805 test/inc/Module/AutoInstall.pm
@@ -0,0 +1,805 @@
+#line 1
+package Module::AutoInstall;
+
+use strict;
+use Cwd ();
+use ExtUtils::MakeMaker ();
+
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = '1.03';
+}
+
+# special map on pre-defined feature sets
+my %FeatureMap = (
+ '' => 'Core Features', # XXX: deprecated
+ '-core' => 'Core Features',
+);
+
+# various lexical flags
+my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS );
+my (
+ $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps
+);
+my ( $PostambleActions, $PostambleUsed );
+
+# See if it's a testing or non-interactive session
+_accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN );
+_init();
+
+sub _accept_default {
+ $AcceptDefault = shift;
+}
+
+sub missing_modules {
+ return @Missing;
+}
+
+sub do_install {
+ __PACKAGE__->install(
+ [
+ $Config
+ ? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
+ : ()
+ ],
+ @Missing,
+ );
+}
+
+# initialize various flags, and/or perform install
+sub _init {
+ foreach my $arg (
+ @ARGV,
+ split(
+ /[\s\t]+/,
+ $ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || ''
+ )
+ )
+ {
+ if ( $arg =~ /^--config=(.*)$/ ) {
+ $Config = [ split( ',', $1 ) ];
+ }
+ elsif ( $arg =~ /^--installdeps=(.*)$/ ) {
+ __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) );
+ exit 0;
+ }
+ elsif ( $arg =~ /^--default(?:deps)?$/ ) {
+ $AcceptDefault = 1;
+ }
+ elsif ( $arg =~ /^--check(?:deps)?$/ ) {
+ $CheckOnly = 1;
+ }
+ elsif ( $arg =~ /^--skip(?:deps)?$/ ) {
+ $SkipInstall = 1;
+ }
+ elsif ( $arg =~ /^--test(?:only)?$/ ) {
+ $TestOnly = 1;
+ }
+ elsif ( $arg =~ /^--all(?:deps)?$/ ) {
+ $AllDeps = 1;
+ }
+ }
+}
+
+# overrides MakeMaker's prompt() to automatically accept the default choice
+sub _prompt {
+ goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault;
+
+ my ( $prompt, $default ) = @_;
+ my $y = ( $default =~ /^[Yy]/ );
+
+ print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] ';
+ print "$default\n";
+ return $default;
+}
+
+# the workhorse
+sub import {
+ my $class = shift;
+ my @args = @_ or return;
+ my $core_all;
+
+ print "*** $class version " . $class->VERSION . "\n";
+ print "*** Checking for Perl dependencies...\n";
+
+ my $cwd = Cwd::cwd();
+
+ $Config = [];
+
+ my $maxlen = length(
+ (
+ sort { length($b) <=> length($a) }
+ grep { /^[^\-]/ }
+ map {
+ ref($_)
+ ? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
+ : ''
+ }
+ map { +{@args}->{$_} }
+ grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} }
+ )[0]
+ );
+
+ # We want to know if we're under CPAN early to avoid prompting, but
+ # if we aren't going to try and install anything anyway then skip the
+ # check entirely since we don't want to have to load (and configure)
+ # an old CPAN just for a cosmetic message
+
+ $UnderCPAN = _check_lock(1) unless $SkipInstall;
+
+ while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) {
+ my ( @required, @tests, @skiptests );
+ my $default = 1;
+ my $conflict = 0;
+
+ if ( $feature =~ m/^-(\w+)$/ ) {
+ my $option = lc($1);
+
+ # check for a newer version of myself
+ _update_to( $modules, @_ ) and return if $option eq 'version';
+
+ # sets CPAN configuration options
+ $Config = $modules if $option eq 'config';
+
+ # promote every features to core status
+ $core_all = ( $modules =~ /^all$/i ) and next
+ if $option eq 'core';
+
+ next unless $option eq 'core';
+ }
+
+ print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n";
+
+ $modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' );
+
+ unshift @$modules, -default => &{ shift(@$modules) }
+ if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability
+
+ while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) {
+ if ( $mod =~ m/^-(\w+)$/ ) {
+ my $option = lc($1);
+
+ $default = $arg if ( $option eq 'default' );
+ $conflict = $arg if ( $option eq 'conflict' );
+ @tests = @{$arg} if ( $option eq 'tests' );
+ @skiptests = @{$arg} if ( $option eq 'skiptests' );
+
+ next;
+ }
+
+ printf( "- %-${maxlen}s ...", $mod );
+
+ if ( $arg and $arg =~ /^\D/ ) {
+ unshift @$modules, $arg;
+ $arg = 0;
+ }
+
+ # XXX: check for conflicts and uninstalls(!) them.
+ my $cur = _load($mod);
+ if (_version_cmp ($cur, $arg) >= 0)
+ {
+ print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n";
+ push @Existing, $mod => $arg;
+ $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
+ }
+ else {
+ if (not defined $cur) # indeed missing
+ {
+ print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n";
+ }
+ else
+ {
+ # no need to check $arg as _version_cmp ($cur, undef) would satisfy >= above
+ print "too old. ($cur < $arg)\n";
+ }
+
+ push @required, $mod => $arg;
+ }
+ }
+
+ next unless @required;
+
+ my $mandatory = ( $feature eq '-core' or $core_all );
+
+ if (
+ !$SkipInstall
+ and (
+ $CheckOnly
+ or ($mandatory and $UnderCPAN)
+ or $AllDeps
+ or _prompt(
+ qq{==> Auto-install the }
+ . ( @required / 2 )
+ . ( $mandatory ? ' mandatory' : ' optional' )
+ . qq{ module(s) from CPAN?},
+ $default ? 'y' : 'n',
+ ) =~ /^[Yy]/
+ )
+ )
+ {
+ push( @Missing, @required );
+ $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
+ }
+
+ elsif ( !$SkipInstall
+ and $default
+ and $mandatory
+ and
+ _prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', )
+ =~ /^[Nn]/ )
+ {
+ push( @Missing, @required );
+ $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
+ }
+
+ else {
+ $DisabledTests{$_} = 1 for map { glob($_) } @tests;
+ }
+ }
+
+ if ( @Missing and not( $CheckOnly or $UnderCPAN ) ) {
+ require Config;
+ print
+"*** Dependencies will be installed the next time you type '$Config::Config{make}'.\n";
+
+ # make an educated guess of whether we'll need root permission.
+ print " (You may need to do that as the 'root' user.)\n"
+ if eval '$>';
+ }
+ print "*** $class configuration finished.\n";
+
+ chdir $cwd;
+
+ # import to main::
+ no strict 'refs';
+ *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
+}
+
+sub _running_under {
+ my $thing = shift;
+ print <<"END_MESSAGE";
+*** Since we're running under ${thing}, I'll just let it take care
+ of the dependency's installation later.
+END_MESSAGE
+ return 1;
+}
+
+# Check to see if we are currently running under CPAN.pm and/or CPANPLUS;
+# if we are, then we simply let it taking care of our dependencies
+sub _check_lock {
+ return unless @Missing or @_;
+
+ my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING};
+
+ if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) {
+ return _running_under($cpan_env ? 'CPAN' : 'CPANPLUS');
+ }
+
+ require CPAN;
+
+ if ($CPAN::VERSION > '1.89') {
+ if ($cpan_env) {
+ return _running_under('CPAN');
+ }
+ return; # CPAN.pm new enough, don't need to check further
+ }
+
+ # last ditch attempt, this -will- configure CPAN, very sorry
+
+ _load_cpan(1); # force initialize even though it's already loaded
+
+ # Find the CPAN lock-file
+ my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" );
+ return unless -f $lock;
+
+ # Check the lock
+ local *LOCK;
+ return unless open(LOCK, $lock);
+
+ if (
+ ( $^O eq 'MSWin32' ? _under_cpan() : <LOCK> == getppid() )
+ and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore'
+ ) {
+ print <<'END_MESSAGE';
+
+*** Since we're running under CPAN, I'll just let it take care
+ of the dependency's installation later.
+END_MESSAGE
+ return 1;
+ }
+
+ close LOCK;
+ return;
+}
+
+sub install {
+ my $class = shift;
+
+ my $i; # used below to strip leading '-' from config keys
+ my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } );
+
+ my ( @modules, @installed );
+ while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) {
+
+ # grep out those already installed
+ if ( _version_cmp( _load($pkg), $ver ) >= 0 ) {
+ push @installed, $pkg;
+ }
+ else {
+ push @modules, $pkg, $ver;
+ }
+ }
+
+ return @installed unless @modules; # nothing to do
+ return @installed if _check_lock(); # defer to the CPAN shell
+
+ print "*** Installing dependencies...\n";
+
+ return unless _connected_to('cpan.org');
+
+ my %args = @config;
+ my %failed;
+ local *FAILED;
+ if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) {
+ while (<FAILED>) { chomp; $failed{$_}++ }
+ close FAILED;
+
+ my @newmod;
+ while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) {
+ push @newmod, ( $k => $v ) unless $failed{$k};
+ }
+ @modules = @newmod;
+ }
+
+ if ( _has_cpanplus() and not $ENV{PERL_AUTOINSTALL_PREFER_CPAN} ) {
+ _install_cpanplus( \@modules, \@config );
+ } else {
+ _install_cpan( \@modules, \@config );
+ }
+
+ print "*** $class installation finished.\n";
+
+ # see if we have successfully installed them
+ while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
+ if ( _version_cmp( _load($pkg), $ver ) >= 0 ) {
+ push @installed, $pkg;
+ }
+ elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) {
+ print FAILED "$pkg\n";
+ }
+ }
+
+ close FAILED if $args{do_once};
+
+ return @installed;
+}
+
+sub _install_cpanplus {
+ my @modules = @{ +shift };
+ my @config = _cpanplus_config( @{ +shift } );
+ my $installed = 0;
+
+ require CPANPLUS::Backend;
+ my $cp = CPANPLUS::Backend->new;
+ my $conf = $cp->configure_object;
+
+ return unless $conf->can('conf') # 0.05x+ with "sudo" support
+ or _can_write($conf->_get_build('base')); # 0.04x
+
+ # if we're root, set UNINST=1 to avoid trouble unless user asked for it.
+ my $makeflags = $conf->get_conf('makeflags') || '';
+ if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) {
+ # 0.03+ uses a hashref here
+ $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST};
+
+ } else {
+ # 0.02 and below uses a scalar
+ $makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
+ if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
+
+ }
+ $conf->set_conf( makeflags => $makeflags );
+ $conf->set_conf( prereqs => 1 );
+
+
+
+ while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) {
+ $conf->set_conf( $key, $val );
+ }
+
+ my $modtree = $cp->module_tree;
+ while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
+ print "*** Installing $pkg...\n";
+
+ MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
+
+ my $success;
+ my $obj = $modtree->{$pkg};
+
+ if ( $obj and _version_cmp( $obj->{version}, $ver ) >= 0 ) {
+ my $pathname = $pkg;
+ $pathname =~ s/::/\\W/;
+
+ foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
+ delete $INC{$inc};
+ }
+
+ my $rv = $cp->install( modules => [ $obj->{module} ] );
+
+ if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) {
+ print "*** $pkg successfully installed.\n";
+ $success = 1;
+ } else {
+ print "*** $pkg installation cancelled.\n";
+ $success = 0;
+ }
+
+ $installed += $success;
+ } else {
+ print << ".";
+*** Could not find a version $ver or above for $pkg; skipping.
+.
+ }
+
+ MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
+ }
+
+ return $installed;
+}
+
+sub _cpanplus_config {
+ my @config = ();
+ while ( @_ ) {
+ my ($key, $value) = (shift(), shift());
+ if ( $key eq 'prerequisites_policy' ) {
+ if ( $value eq 'follow' ) {
+ $value = CPANPLUS::Internals::Constants::PREREQ_INSTALL();
+ } elsif ( $value eq 'ask' ) {
+ $value = CPANPLUS::Internals::Constants::PREREQ_ASK();
+ } elsif ( $value eq 'ignore' ) {
+ $value = CPANPLUS::Internals::Constants::PREREQ_IGNORE();
+ } else {
+ die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n";
+ }
+ } else {
+ die "*** Cannot convert option $key to CPANPLUS version.\n";
+ }
+ }
+ return @config;
+}
+
+sub _install_cpan {
+ my @modules = @{ +shift };
+ my @config = @{ +shift };
+ my $installed = 0;
+ my %args;
+
+ _load_cpan();
+ require Config;
+
+ if (CPAN->VERSION < 1.80) {
+ # no "sudo" support, probe for writableness
+ return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) )
+ and _can_write( $Config::Config{sitelib} );
+ }
+
+ # if we're root, set UNINST=1 to avoid trouble unless user asked for it.
+ my $makeflags = $CPAN::Config->{make_install_arg} || '';
+ $CPAN::Config->{make_install_arg} =
+ join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
+ if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
+
+ # don't show start-up info
+ $CPAN::Config->{inhibit_startup_message} = 1;
+
+ # set additional options
+ while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) {
+ ( $args{$opt} = $arg, next )
+ if $opt =~ /^force$/; # pseudo-option
+ $CPAN::Config->{$opt} = $arg;
+ }
+
+ local $CPAN::Config->{prerequisites_policy} = 'follow';
+
+ while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
+ MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
+
+ print "*** Installing $pkg...\n";
+
+ my $obj = CPAN::Shell->expand( Module => $pkg );
+ my $success = 0;
+
+ if ( $obj and _version_cmp( $obj->cpan_version, $ver ) >= 0 ) {
+ my $pathname = $pkg;
+ $pathname =~ s/::/\\W/;
+
+ foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
+ delete $INC{$inc};
+ }
+
+ my $rv = $args{force} ? CPAN::Shell->force( install => $pkg )
+ : CPAN::Shell->install($pkg);
+ $rv ||= eval {
+ $CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, )
+ ->{install}
+ if $CPAN::META;
+ };
+
+ if ( $rv eq 'YES' ) {
+ print "*** $pkg successfully installed.\n";
+ $success = 1;
+ }
+ else {
+ print "*** $pkg installation failed.\n";
+ $success = 0;
+ }
+
+ $installed += $success;
+ }
+ else {
+ print << ".";
+*** Could not find a version $ver or above for $pkg; skipping.
+.
+ }
+
+ MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
+ }
+
+ return $installed;
+}
+
+sub _has_cpanplus {
+ return (
+ $HasCPANPLUS = (
+ $INC{'CPANPLUS/Config.pm'}
+ or _load('CPANPLUS::Shell::Default')
+ )
+ );
+}
+
+# make guesses on whether we're under the CPAN installation directory
+sub _under_cpan {
+ require Cwd;
+ require File::Spec;
+
+ my $cwd = File::Spec->canonpath( Cwd::cwd() );
+ my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} );
+
+ return ( index( $cwd, $cpan ) > -1 );
+}
+
+sub _update_to {
+ my $class = __PACKAGE__;
+ my $ver = shift;
+
+ return
+ if _version_cmp( _load($class), $ver ) >= 0; # no need to upgrade
+
+ if (
+ _prompt( "==> A newer version of $class ($ver) is required. Install?",
+ 'y' ) =~ /^[Nn]/
+ )
+ {
+ die "*** Please install $class $ver manually.\n";
+ }
+
+ print << ".";
+*** Trying to fetch it from CPAN...
+.
+
+ # install ourselves
+ _load($class) and return $class->import(@_)
+ if $class->install( [], $class, $ver );
+
+ print << '.'; exit 1;
+
+*** Cannot bootstrap myself. :-( Installation terminated.
+.
+}
+
+# check if we're connected to some host, using inet_aton
+sub _connected_to {
+ my $site = shift;
+
+ return (
+ ( _load('Socket') and Socket::inet_aton($site) ) or _prompt(
+ qq(
+*** Your host cannot resolve the domain name '$site', which
+ probably means the Internet connections are unavailable.
+==> Should we try to install the required module(s) anyway?), 'n'
+ ) =~ /^[Yy]/
+ );
+}
+
+# check if a directory is writable; may create it on demand
+sub _can_write {
+ my $path = shift;
+ mkdir( $path, 0755 ) unless -e $path;
+
+ return 1 if -w $path;
+
+ print << ".";
+*** You are not allowed to write to the directory '$path';
+ the installation may fail due to insufficient permissions.
+.
+
+ if (
+ eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt(
+ qq(
+==> Should we try to re-execute the autoinstall process with 'sudo'?),
+ ((-t STDIN) ? 'y' : 'n')
+ ) =~ /^[Yy]/
+ )
+ {
+
+ # try to bootstrap ourselves from sudo
+ print << ".";
+*** Trying to re-execute the autoinstall process with 'sudo'...
+.
+ my $missing = join( ',', @Missing );
+ my $config = join( ',',
+ UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
+ if $Config;
+
+ return
+ unless system( 'sudo', $^X, $0, "--config=$config",
+ "--installdeps=$missing" );
+
+ print << ".";
+*** The 'sudo' command exited with error! Resuming...
+.
+ }
+
+ return _prompt(
+ qq(
+==> Should we try to install the required module(s) anyway?), 'n'
+ ) =~ /^[Yy]/;
+}
+
+# load a module and return the version it reports
+sub _load {
+ my $mod = pop; # class/instance doesn't matter
+ my $file = $mod;
+
+ $file =~ s|::|/|g;
+ $file .= '.pm';
+
+ local $@;
+ return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 );
+}
+
+# Load CPAN.pm and it's configuration
+sub _load_cpan {
+ return if $CPAN::VERSION and $CPAN::Config and not @_;
+ require CPAN;
+ if ( $CPAN::HandleConfig::VERSION ) {
+ # Newer versions of CPAN have a HandleConfig module
+ CPAN::HandleConfig->load;
+ } else {
+ # Older versions had the load method in Config directly
+ CPAN::Config->load;
+ }
+}
+
+# compare two versions, either use Sort::Versions or plain comparison
+# return values same as <=>
+sub _version_cmp {
+ my ( $cur, $min ) = @_;
+ return -1 unless defined $cur; # if 0 keep comparing
+ return 1 unless $min;
+
+ $cur =~ s/\s+$//;
+
+ # check for version numbers that are not in decimal format
+ if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) {
+ if ( ( $version::VERSION or defined( _load('version') )) and
+ version->can('new')
+ ) {
+
+ # use version.pm if it is installed.
+ return version->new($cur) <=> version->new($min);
+ }
+ elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) )
+ {
+
+ # use Sort::Versions as the sorting algorithm for a.b.c versions
+ return Sort::Versions::versioncmp( $cur, $min );
+ }
+
+ warn "Cannot reliably compare non-decimal formatted versions.\n"
+ . "Please install version.pm or Sort::Versions.\n";
+ }
+
+ # plain comparison
+ local $^W = 0; # shuts off 'not numeric' bugs
+ return $cur <=> $min;
+}
+
+# nothing; this usage is deprecated.
+sub main::PREREQ_PM { return {}; }
+
+sub _make_args {
+ my %args = @_;
+
+ $args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing }
+ if $UnderCPAN or $TestOnly;
+
+ if ( $args{EXE_FILES} and -e 'MANIFEST' ) {
+ require ExtUtils::Manifest;
+ my $manifest = ExtUtils::Manifest::maniread('MANIFEST');
+
+ $args{EXE_FILES} =
+ [ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ];
+ }
+
+ $args{test}{TESTS} ||= 't/*.t';
+ $args{test}{TESTS} = join( ' ',
+ grep { !exists( $DisabledTests{$_} ) }
+ map { glob($_) } split( /\s+/, $args{test}{TESTS} ) );
+
+ my $missing = join( ',', @Missing );
+ my $config =
+ join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
+ if $Config;
+
+ $PostambleActions = (
+ ($missing and not $UnderCPAN)
+ ? "\$(PERL) $0 --config=$config --installdeps=$missing"
+ : "\$(NOECHO) \$(NOOP)"
+ );
+
+ return %args;
+}
+
+# a wrapper to ExtUtils::MakeMaker::WriteMakefile
+sub Write {
+ require Carp;
+ Carp::croak "WriteMakefile: Need even number of args" if @_ % 2;
+
+ if ($CheckOnly) {
+ print << ".";
+*** Makefile not written in check-only mode.
+.
+ return;
+ }
+
+ my %args = _make_args(@_);
+
+ no strict 'refs';
+
+ $PostambleUsed = 0;
+ local *MY::postamble = \&postamble unless defined &MY::postamble;
+ ExtUtils::MakeMaker::WriteMakefile(%args);
+
+ print << "." unless $PostambleUsed;
+*** WARNING: Makefile written with customized MY::postamble() without
+ including contents from Module::AutoInstall::postamble() --
+ auto installation features disabled. Please contact the author.
+.
+
+ return 1;
+}
+
+sub postamble {
+ $PostambleUsed = 1;
+
+ return <<"END_MAKE";
+
+config :: installdeps
+\t\$(NOECHO) \$(NOOP)
+
+checkdeps ::
+\t\$(PERL) $0 --checkdeps
+
+installdeps ::
+\t$PostambleActions
+
+END_MAKE
+
+}
+
+1;
+
+__END__
+
+#line 1056
430 test/inc/Module/Install.pm
@@ -0,0 +1,430 @@
+#line 1
+package Module::Install;
+
+# For any maintainers:
+# The load order for Module::Install is a bit magic.
+# It goes something like this...
+#
+# IF ( host has Module::Install installed, creating author mode ) {
+# 1. Makefile.PL calls "use inc::Module::Install"
+# 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install
+# 3. The installed version of inc::Module::Install loads
+# 4. inc::Module::Install calls "require Module::Install"
+# 5. The ./inc/ version of Module::Install loads
+# } ELSE {
+# 1. Makefile.PL calls "use inc::Module::Install"
+# 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install
+# 3. The ./inc/ version of Module::Install loads
+# }
+
+use 5.005;
+use strict 'vars';
+
+use vars qw{$VERSION $MAIN};
+BEGIN {
+ # All Module::Install core packages now require synchronised versions.
+ # This will be used to ensure we don't accidentally load old or
+ # different versions of modules.
+ # This is not enforced yet, but will be some time in the next few
+ # releases once we can make sure it won't clash with custom
+ # Module::Install extensions.
+ $VERSION = '0.91';
+
+ # Storage for the pseudo-singleton
+ $MAIN = undef;
+
+ *inc::Module::Install::VERSION = *VERSION;
+ @inc::Module::Install::ISA = __PACKAGE__;
+
+}
+
+
+
+
+
+# Whether or not inc::Module::Install is actually loaded, the
+# $INC{inc/Module/Install.pm} is what will still get set as long as
+# the caller loaded module this in the documented manner.
+# If not set, the caller may NOT have loaded the bundled version, and thus
+# they may not have a MI version that works with the Makefile.PL. This would
+# result in false errors or unexpected behaviour. And we don't want that.
+my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
+unless ( $INC{$file} ) { die <<"END_DIE" }
+
+Please invoke ${\__PACKAGE__} with:
+
+ use inc::${\__PACKAGE__};
+
+not:
+
+ use ${\__PACKAGE__};
+
+END_DIE
+
+
+
+
+
+# If the script that is loading Module::Install is from the future,
+# then make will detect this and cause it to re-run over and over
+# again. This is bad. Rather than taking action to touch it (which
+# is unreliable on some platforms and requires write permissions)
+# for now we should catch this and refuse to run.
+if ( -f $0 ) {
+ my $s = (stat($0))[9];
+
+ # If the modification time is only slightly in the future,
+ # sleep briefly to remove the problem.
+ my $a = $s - time;
+ if ( $a > 0 and $a < 5 ) { sleep 5 }
+
+ # Too far in the future, throw an error.
+ my $t = time;
+ if ( $s > $t ) { die <<"END_DIE" }
+
+Your installer $0 has a modification time in the future ($s > $t).
+
+This is known to create infinite loops in make.
+
+Please correct this, then run $0 again.
+
+END_DIE
+}
+
+
+
+
+
+# Build.PL was formerly supported, but no longer is due to excessive
+# difficulty in implementing every single feature twice.
+if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
+
+Module::Install no longer supports Build.PL.
+
+It was impossible to maintain duel backends, and has been deprecated.
+
+Please remove all Build.PL files and only use the Makefile.PL installer.
+
+END_DIE
+
+
+
+
+
+# To save some more typing in Module::Install installers, every...
+# use inc::Module::Install
+# ...also acts as an implicit use strict.
+$^H |= strict::bits(qw(refs subs vars));
+
+
+
+
+
+use Cwd ();
+use File::Find ();
+use File::Path ();
+use FindBin;
+
+sub autoload {
+ my $self = shift;
+ my $who = $self->_caller;
+ my $cwd = Cwd::cwd();
+ my $sym = "${who}::AUTOLOAD";
+ $sym->{$cwd} = sub {
+ my $pwd = Cwd::cwd();
+ if ( my $code = $sym->{$pwd} ) {
+ # Delegate back to parent dirs
+ goto &$code unless $cwd eq $pwd;
+ }
+ $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym";
+ my $method = $1;
+ if ( uc($method) eq $method ) {
+ # Do nothing
+ return;
+ } elsif ( $method =~ /^_/ and $self->can($method) ) {
+ # Dispatch to the root M:I class
+ return $self->$method(@_);
+ }
+
+ # Dispatch to the appropriate plugin
+ unshift @_, ( $self, $1 );
+ goto &{$self->can('call')};
+ };
+}
+
+sub import {
+ my $class = shift;
+ my $self = $class->new(@_);
+ my $who = $self->_caller;
+
+ unless ( -f $self->{file} ) {
+ require "$self->{path}/$self->{dispatch}.pm";
+ File::Path::mkpath("$self->{prefix}/$self->{author}");
+ $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
+ $self->{admin}->init;
+ @_ = ($class, _self => $self);
+ goto &{"$self->{name}::import"};
+ }
+
+ *{"${who}::AUTOLOAD"} = $self->autoload;
+ $self->preload;
+
+ # Unregister loader and worker packages so subdirs can use them again
+ delete $INC{"$self->{file}"};
+ delete $INC{"$self->{path}.pm"};
+
+ # Save to the singleton
+ $MAIN = $self;
+
+ return 1;
+}
+
+sub preload {
+ my $self = shift;
+ unless ( $self->{extensions} ) {
+ $self->load_extensions(
+ "$self->{prefix}/$self->{path}", $self
+ );
+ }
+
+ my @exts = @{$self->{extensions}};
+ unless ( @exts ) {
+ @exts = $self->{admin}->load_all_extensions;
+ }
+
+ my %seen;
+ foreach my $obj ( @exts ) {
+ while (my ($method, $glob) = each %{ref($obj) . '::'}) {
+ next unless $obj->can($method);
+ next if $method =~ /^_/;
+ next if $method eq uc($method);
+ $seen{$method}++;
+ }
+ }
+
+ my $who = $self->_caller;
+ foreach my $name ( sort keys %seen ) {
+ *{"${who}::$name"} = sub {
+ ${"${who}::AUTOLOAD"} = "${who}::$name";
+ goto &{"${who}::AUTOLOAD"};
+ };
+ }
+}
+
+sub new {
+ my ($class, %args) = @_;
+
+ # ignore the prefix on extension modules built from top level.
+ my $base_path = Cwd::abs_path($FindBin::Bin);
+ unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
+ delete $args{prefix};
+ }
+
+ return $args{_self} if $args{_self};
+
+ $args{dispatch} ||= 'Admin';
+ $args{prefix} ||= 'inc';
+ $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author');
+ $args{bundle} ||= 'inc/BUNDLES';
+ $args{base} ||= $base_path;
+ $class =~ s/^\Q$args{prefix}\E:://;
+ $args{name} ||= $class;
+ $args{version} ||= $class->VERSION;
+ unless ( $args{path} ) {
+ $args{path} = $args{name};
+ $args{path} =~ s!::!/!g;
+ }
+ $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm";
+ $args{wrote} = 0;
+
+ bless( \%args, $class );
+}
+
+sub call {
+ my ($self, $method) = @_;
+ my $obj = $self->load($method) or return;
+ splice(@_, 0, 2, $obj);
+ goto &{$obj->can($method)};
+}
+
+sub load {
+ my ($self, $method) = @_;
+
+ $self->load_extensions(
+ "$self->{prefix}/$self->{path}", $self
+ ) unless $self->{extensions};
+
+ foreach my $obj (@{$self->{extensions}}) {
+ return $obj if $obj->can($method);
+ }
+
+ my $admin = $self->{admin} or die <<"END_DIE";
+The '$method' method does not exist in the '$self->{prefix}' path!
+Please remove the '$self->{prefix}' directory and run $0 again to load it.
+END_DIE
+
+ my $obj = $admin->load($method, 1);
+ push @{$self->{extensions}}, $obj;
+
+ $obj;
+}
+
+sub load_extensions {
+ my ($self, $path, $top) = @_;
+
+ unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
+ unshift @INC, $self->{prefix};
+ }
+
+ foreach my $rv ( $self->find_extensions($path) ) {
+ my ($file, $pkg) = @{$rv};
+ next if $self->{pathnames}{$pkg};
+
+ local $@;
+ my $new = eval { require $file; $pkg->can('new') };
+ unless ( $new ) {
+ warn $@ if $@;
+ next;
+ }
+ $self->{pathnames}{$pkg} = delete $INC{$file};
+ push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
+ }
+
+ $self->{extensions} ||= [];
+}
+
+sub find_extensions {
+ my ($self, $path) = @_;
+
+ my @found;
+ File::Find::find( sub {
+ my $file = $File::Find::name;
+ return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
+ my $subpath = $1;
+ return if lc($subpath) eq lc($self->{dispatch});
+
+ $file = "$self->{path}/$subpath.pm";
+ my $pkg = "$self->{name}::$subpath";
+ $pkg =~ s!/!::!g;
+
+ # If we have a mixed-case package name, assume case has been preserved
+ # correctly. Otherwise, root through the file to locate the case-preserved
+ # version of the package name.
+ if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
+ my $content = Module::Install::_read($subpath . '.pm');
+ my $in_pod = 0;
+ foreach ( split //, $content ) {
+ $in_pod = 1 if /^=\w/;
+ $in_pod = 0 if /^=cut/;
+ next if ($in_pod || /^=cut/); # skip pod text
+ next if /^\s*#/; # and comments
+ if ( m/^\s*package\s+($pkg)\s*;/i ) {
+ $pkg = $1;
+ last;
+ }
+ }
+ }
+
+ push @found, [ $file, $pkg ];
+ }, $path ) if -d $path;
+
+ @found;
+}
+
+
+
+
+
+#####################################################################
+# Common Utility Functions
+
+sub _caller {
+ my $depth = 0;
+ my $call = caller($depth);
+ while ( $call eq __PACKAGE__ ) {
+ $depth++;
+ $call = caller($depth);
+ }
+ return $call;
+}
+
+sub _read {
+ local *FH;
+ if ( $] >= 5.006 ) {
+ open( FH, '<', $_[0] ) or die "open($_[0]): $!";
+ } else {
+ open( FH, "< $_[0]" ) or die "open($_[0]): $!";
+ }
+ my $string = do { local $/; <FH> };
+ close FH or die "close($_[0]): $!";
+ return $string;
+}
+
+sub _readperl {
+ my $string = Module::Install::_read($_[0]);
+ $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
+ $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s;
+ $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg;
+ return $string;
+}
+
+sub _readpod {
+ my $string = Module::Install::_read($_[0]);
+ $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
+ return $string if $_[0] =~ /\.pod\z/;
+ $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg;
+ $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg;
+ $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg;
+ $string =~ s/^\n+//s;
+ return $string;
+}
+
+sub _write {
+ local *FH;
+ if ( $] >= 5.006 ) {
+ open( FH, '>', $_[0] ) or die "open($_[0]): $!";
+ } else {
+ open( FH, "> $_[0]" ) or die "open($_[0]): $!";
+ }
+ foreach ( 1 .. $#_ ) {
+ print FH $_[$_] or die "print($_[0]): $!";
+ }
+ close FH or die "close($_[0]): $!";
+}
+
+# _version is for processing module versions (eg, 1.03_05) not
+# Perl versions (eg, 5.8.1).
+sub _version ($) {
+ my $s = shift || 0;
+ my $d =()= $s =~ /(\.)/g;
+ if ( $d >= 2 ) {
+ # Normalise multipart versions
+ $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
+ }
+ $s =~ s/^(\d+)\.?//;
+ my $l = $1 || 0;
+ my @v = map {
+ $_ . '0' x (3 - length $_)
+ } $s =~ /(\d{1,3})\D?/g;
+ $l = $l . '.' . join '', @v if @v;
+ return $l + 0;
+}
+
+sub _cmp ($$) {
+ _version($_[0]) <=> _version($_[1]);
+}
+
+# Cloned from Params::Util::_CLASS
+sub _CLASS ($) {
+ (
+ defined $_[0]
+ and
+ ! ref $_[0]
+ and
+ $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
+ ) ? $_[0] : undef;
+}
+
+1;
+
+# Copyright 2008 - 2009 Adam Kennedy.
61 test/inc/Module/Install/AutoInstall.pm
@@ -0,0 +1,61 @@
+#line 1
+package Module::Install::AutoInstall;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '0.91';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+sub AutoInstall { $_[0] }
+
+sub run {
+ my $self = shift;
+ $self->auto_install_now(@_);
+}
+
+sub write {
+ my $self = shift;
+ $self->auto_install(@_);
+}
+
+sub auto_install {
+ my $self = shift;
+ return if $self->{done}++;
+
+ # Flatten array of arrays into a single array
+ my @core = map @$_, map @$_, grep ref,
+ $self->build_requires, $self->requires;
+
+ my @config = @_;
+
+ # We'll need Module::AutoInstall
+ $self->include('Module::AutoInstall');
+ require Module::AutoInstall;
+
+ Module::AutoInstall->import(
+ (@config ? (-config => \@config) : ()),
+ (@core ? (-core => \@core) : ()),
+ $self->features,
+ );
+
+ $self->makemaker_args( Module::AutoInstall::_make_args() );
+
+ my $class = ref($self);
+ $self->postamble(
+ "# --- $class section:\n" .
+ Module::AutoInstall::postamble()
+ );
+}
+
+sub auto_install_now {
+ my $self = shift;
+ $self->auto_install(@_);
+ Module::AutoInstall::do_install();
+}
+
+1;
78 test/inc/Module/Install/Base.pm
@@ -0,0 +1,78 @@
+#line 1
+package Module::Install::Base;
+
+use strict 'vars';
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = '0.91';
+}
+
+# Suspend handler for "redefined" warnings
+BEGIN {
+ my $w = $SIG{__WARN__};
+ $SIG{__WARN__} = sub { $w };
+}
+
+#line 42
+
+sub new {
+ my $class = shift;
+ unless ( defined &{"${class}::call"} ) {
+ *{"${class}::call"} = sub { shift->_top->call(@_) };
+ }
+ unless ( defined &{"${class}::load"} ) {
+ *{"${class}::load"} = sub { shift->_top->load(@_) };
+ }
+ bless { @_ }, $class;
+}
+
+#line 61
+
+sub AUTOLOAD {
+ local $@;
+ my $func = eval { shift->_top->autoload } or return;
+ goto &$func;
+}
+
+#line 75
+
+sub _top {
+ $_[0]->{_top};
+}
+
+#line 90
+
+sub admin {
+ $_[0]->_top->{admin}
+ or
+ Module::Install::Base::FakeAdmin->new;
+}
+
+#line 106
+
+sub is_admin {
+ $_[0]->admin->VERSION;
+}
+
+sub DESTROY {}
+
+package Module::Install::Base::FakeAdmin;
+
+my $fake;
+
+sub new {
+ $fake ||= bless(\@_, $_[0]);
+}
+
+sub AUTOLOAD {}
+
+sub DESTROY {}
+
+# Restore warning handler
+BEGIN {
+ $SIG{__WARN__} = $SIG{__WARN__}->();
+}
+
+1;
+
+#line 154
81 test/inc/Module/Install/Can.pm
@@ -0,0 +1,81 @@
+#line 1
+package Module::Install::Can;
+
+use strict;
+use Config ();
+use File::Spec ();
+use ExtUtils::MakeMaker ();
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '0.91';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+# check if we can load some module
+### Upgrade this to not have to load the module if possible
+sub can_use {
+ my ($self, $mod, $ver) = @_;
+ $mod =~ s{::|\\}{/}g;
+ $mod .= '.pm' unless $mod =~ /\.pm$/i;
+
+ my $pkg = $mod;
+ $pkg =~ s{/}{::}g;
+ $pkg =~ s{\.pm$}{}i;
+
+ local $@;
+ eval { require $mod; $pkg->VERSION($ver || 0); 1 };
+}
+
+# check if we can run some command
+sub can_run {
+ my ($self, $cmd) = @_;
+
+ my $_cmd = $cmd;
+ return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
+
+ for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
+ next if $dir eq '';
+ my $abs = File::Spec->catfile($dir, $_[1]);
+ return $abs if (-x $abs or $abs = MM->maybe_command($abs));
+ }
+
+ return;
+}
+
+# can we locate a (the) C compiler
+sub can_cc {
+ my $self = shift;
+ my @chunks = split(/ /, $Config::Config{cc}) or return;
+
+ # $Config{cc} may contain args; try to find out the program part
+ while (@chunks) {
+ return $self->can_run("@chunks") || (pop(@chunks), next);
+ }
+
+ return;
+}
+
+# Fix Cygwin bug on maybe_command();
+if ( $^O eq 'cygwin' ) {
+ require ExtUtils::MM_Cygwin;
+ require ExtUtils::MM_Win32;
+ if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) {
+ *ExtUtils::MM_Cygwin::maybe_command = sub {
+ my ($self, $file) = @_;
+ if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) {
+ ExtUtils::MM_Win32->maybe_command($file);
+ } else {
+ ExtUtils::MM_Unix->maybe_command($file);
+ }
+ }
+ }
+}
+
+1;
+
+__END__
+
+#line 156
93 test/inc/Module/Install/Fetch.pm
@@ -0,0 +1,93 @@
+#line 1
+package Module::Install::Fetch;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '0.91';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+sub get_file {
+ my ($self, %args) = @_;
+ my ($scheme, $host, $path, $file) =
+ $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
+
+ if ( $scheme eq 'http' and !