![[site community profile]](https://www.dreamwidth.org/img/comm_staff.png){kind=small}
[perlbal] Import the latest Perlbal code.
[commit: http://hg.dwscoalition.org/perlbal/rev/8a470e6627c0]
Import the latest Perlbal code.
Patch by![[staff profile]](https://www.dreamwidth.org/img/silk/identity/user_staff.png)
mark.
Files modified:
Import the latest Perlbal code.
Patch by
mark.Files modified:
- .shipit
- CHANGES
- CONTRIBUTING
- MANIFEST
- META.yml
- Perlbal.spec
- conf/echoservice.conf
- conf/load-balancer.conf
- conf/perlbal.conf
- conf/ssl.conf
- conf/virtual-hosts.conf
- conf/webserver.conf
- doc/service-parameters.txt
- lib/Perlbal.pm
- lib/Perlbal/BackendHTTP.pm
- lib/Perlbal/Cache.pm
- lib/Perlbal/ClientHTTP.pm
- lib/Perlbal/ClientHTTPBase.pm
- lib/Perlbal/ClientProxy.pm
- lib/Perlbal/HTTPHeaders.pm
- lib/Perlbal/Plugin/AccessControl.pm
- lib/Perlbal/Plugin/Redirect.pm
- lib/Perlbal/Plugin/Vhosts.pm
- lib/Perlbal/Pool.pm
- lib/Perlbal/Service.pm
- lib/Perlbal/Socket.pm
- lib/Perlbal/SocketSSL.pm
- lib/Perlbal/TCPListener.pm
- lib/Perlbal/Test/WebServer.pm
- perlbal
- t/12-headers.t
- t/31-realworld.t
- t/32-selector.t
- t/35-reproxy.t
- t/45-buffereduploads.t
- t/75-plugin-include.t
- t/76-plugin-redirect.t
--------------------------------------------------------------------------------
diff -r c449697b30d9 -r 8a470e6627c0 .shipit
--- a/.shipit Mon Oct 26 05:06:01 2009 +0000
+++ b/.shipit Sun May 02 00:21:22 2010 +0000
@@ -1,3 +1,3 @@ steps = FindVersion, ChangeVersion, Chan
-steps = FindVersion, ChangeVersion, ChangeRPMVersion, CheckChangeLog, DistTest, Commit, Tag, MakeDist, UploadCPAN
+steps = FindVersion, ChangeVersion, CheckChangeLog, DistTest, Commit, Tag, MakeDist, UploadCPAN
svn.tagpattern = Perlbal-%v
diff -r c449697b30d9 -r 8a470e6627c0 CHANGES
--- a/CHANGES Mon Oct 26 05:06:01 2009 +0000
+++ b/CHANGES Sun May 02 00:21:22 2010 +0000
@@ -1,9 +1,89 @@
+ -- Cap our read buffers before AIO file operations to 1MB, this will prevent
+ memory over-use on systems with slow disks for PUT, or buffered upload temp
+ files. Assuming you system is fast enough to keep up with the writes this
+ will not harm upload speeds.
+
+1.75: 2010-04-02
+
+ -- Stop doubleforking on daemonization. Seems useless and triggered a bug
+ with newer IO::AIO's.
+
+ -- Fix tests on OSX. (plugin loader doesn't play nicely with a case-
+ insensitive filesystem)
+
+ -- added links to http://contributing.appspot.com/perlbal
+
+1.74: 2010-03-20
+
+ -- Change headers->headers_list method to return original case for PP
+
+ -- Add Slaven Rezic's SSL Client cert verification patch.
+
+ -- Change all the example configs to use a lower port
+ (Andreas J Koenig <andreas.j.koenig@gmail.com>)
+
+ -- Fix typo in help for MIME command (Jeremy James <jeremy.james@gmail.com>)
+
+ -- Allow HEADER command on all service roles
+
+ -- Switch Redirect plugin to use ->send_full_response, which fixes
+ keep-alive handling for this plugin.
+
+ -- Add a ClientHTTPBase method ->send_full_response, which is intended
+ as a plugin's interface to send full http responses back while still
+ having perlbal handle things like keepalives correctly.
+
+ -- Make keep-alive results during reproxy work even if the initial
+ response doesn't have a content-length.
+
+ -- Fix SSL socket close race crash. (Jab <jk@ciphron.de>)
+
+ -- Make service selectors have the 'observed_ip' concept available to
+ them.
+
+ -- Add extra_config awareness for plugin added tunables to dumpconfig.
+
+ -- Plugins may now use the $set argument of add_tunable's interface
+ to automatically set an extra_config value from within a setter
+ override. Previously this would result in an error.
+
+ -- Split the persist_client_timeout into two other options;
+ persist_client_idle_timeout and idle_timeout. Depricate and
+ add compatability for the old option.
+
+ -- Silence a warning in PERLBAL_DEBUG >= 4 that we really don't
+ need to see.
+
+ -- Fix chained service selectors to have their 'start_http_request'
+ hook to be called.
+
+ -- Fix reproxy to not skip urls when the previous URL is a 'failure'
+ HTTP status response. IE. don't skip the second url when the first
+ one is a 404.
+
+ -- Don't require a space after the HTTP status in responses. In some
+ situations a server may not give it.
+
+ -- Perlbal::log should act the same whether it is calling syslog or
+ printf. Make it a little more DWIM.
+
+ -- Let's make SSL clients work with service selectors, and even
+ chained service selectors, when serving static files.
+
+ -- Fix a fields glitch in Perlbal::Cache which would sometimes
+ cause errors and abnormal shutdown.
+
+1.73: 2009-10-05
+
+ -- Add 'dumpconfig' command and related framework.
+ *** BETA FEATURE STATUS ***
+
-- Fix obscure race condition (spontaneously closed keepalives
after POST requests, Andreas J Koenig)
-- make Perlbal::Test be more robust and only use free ports.
(Bart van der Schans <herengracht@gmail.com>)
-
+
-- Make Content-Range replies work (Ask Bjørn Hansen)
-- Make Redirect plugin more standards compliant (Ask Bjørn Hansen)
diff -r c449697b30d9 -r 8a470e6627c0 CONTRIBUTING
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/CONTRIBUTING Sun May 02 00:21:22 2010 +0000
@@ -0,0 +1,5 @@
+Want to contribute? Current instructions should be at:
+
+ http://contributing.appspot.com/perlbal
+
+Thanks!
diff -r c449697b30d9 -r 8a470e6627c0 MANIFEST
--- a/MANIFEST Mon Oct 26 05:06:01 2009 +0000
+++ b/MANIFEST Sun May 02 00:21:22 2010 +0000
@@ -1,4 +1,5 @@ CHANGES
CHANGES
+CONTRIBUTING
conf/echoservice.conf
conf/load-balancer.conf
conf/nodelist.dat
@@ -55,7 +56,6 @@ lib/Perlbal/Util.pm
lib/Perlbal/Util.pm
Makefile.PL
MANIFEST
-META.yml Module meta-data (added by MakeMaker)
perlbal
t/00-use.t
t/10-testharness.t
@@ -76,4 +76,5 @@ t/60-child-httpd.t
t/60-child-httpd.t
t/75-plugin-include.t
t/90-accesscontrol.t
+t/76-plugin-redirect.t
t/helper/child-httpd.pl
diff -r c449697b30d9 -r 8a470e6627c0 META.yml
--- a/META.yml Mon Oct 26 05:06:01 2009 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,18 +0,0 @@
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
-name: Perlbal
-version: 1.70
-version_from: lib/Perlbal.pm
-installdirs: site
-requires:
- BSD::Resource: 0
- Danga::Socket: 1.44
- File::Find: 0
- HTTP::Date: 0
- HTTP::Response: 0
- Sys::Syscall: 0
- Test::More: 0
- Time::HiRes: 0
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.17
diff -r c449697b30d9 -r 8a470e6627c0 Perlbal.spec
--- a/Perlbal.spec Mon Oct 26 05:06:01 2009 +0000
+++ b/Perlbal.spec Sun May 02 00:21:22 2010 +0000
@@ -1,8 +1,8 @@ name: Perlbal
name: Perlbal
summary: Perlbal - High efficiency reverse proxy and web server.
-version: 1.72
-release: 1
-vendor: Brad Fitzpatrick <brad@danga.com>
+version: 1.75
+release: 1%{?dist}
+vendor: Alan Kasindorf <dormando@rydia.net>
packager: Jonathan Steinert <rpm@hachi.kuiki.net>
license: Artistic
group: Applications/CPAN
@@ -18,7 +18,7 @@ buildrequires: perl(Time::HiRes)
buildrequires: perl(Time::HiRes)
autoreq: no
-requires: perl(Perlbal) = %{version}-%{release}
+requires: perl-Perlbal = %{version}-%{release}
%description
High efficiency reverse proxy and web server.
diff -r c449697b30d9 -r 8a470e6627c0 conf/echoservice.conf
--- a/conf/echoservice.conf Mon Oct 26 05:06:01 2009 +0000
+++ b/conf/echoservice.conf Sun May 02 00:21:22 2010 +0000
@@ -21,5 +21,5 @@ ENABLE echo_delayed
# always good to keep an internal management port open:
CREATE SERVICE mgmt
SET role = management
- SET listen = 127.0.0.1:60000
+ SET listen = 127.0.0.1:16000
ENABLE mgmt
diff -r c449697b30d9 -r 8a470e6627c0 conf/load-balancer.conf
--- a/conf/load-balancer.conf Mon Oct 26 05:06:01 2009 +0000
+++ b/conf/load-balancer.conf Sun May 02 00:21:22 2010 +0000
@@ -42,5 +42,5 @@ ENABLE balancer2
# always good to keep an internal management port open:
CREATE SERVICE mgmt
SET role = management
- SET listen = 127.0.0.1:60000
+ SET listen = 127.0.0.1:16000
ENABLE mgmt
diff -r c449697b30d9 -r 8a470e6627c0 conf/perlbal.conf
--- a/conf/perlbal.conf Mon Oct 26 05:06:01 2009 +0000
+++ b/conf/perlbal.conf Sun May 02 00:21:22 2010 +0000
@@ -25,5 +25,5 @@ ENABLE balancer
# always good to keep an internal management port open:
CREATE SERVICE mgmt
SET role = management
- SET listen = 127.0.0.1:60000
+ SET listen = 127.0.0.1:16000
ENABLE mgmt
diff -r c449697b30d9 -r 8a470e6627c0 conf/ssl.conf
--- a/conf/ssl.conf Mon Oct 26 05:06:01 2009 +0000
+++ b/conf/ssl.conf Sun May 02 00:21:22 2010 +0000
@@ -48,5 +48,5 @@ ENABLE site
# always good to keep an internal management port open:
CREATE SERVICE mgmt
SET role = management
- SET listen = 127.0.0.1:60000
+ SET listen = 127.0.0.1:16000
ENABLE mgmt
diff -r c449697b30d9 -r 8a470e6627c0 conf/virtual-hosts.conf
--- a/conf/virtual-hosts.conf Mon Oct 26 05:06:01 2009 +0000
+++ b/conf/virtual-hosts.conf Sun May 02 00:21:22 2010 +0000
@@ -33,5 +33,5 @@ ENABLE vdemo
# always good to keep an internal management port open:
CREATE SERVICE mgmt
SET role = management
- SET listen = 127.0.0.1:60000
+ SET listen = 127.0.0.1:16000
ENABLE mgmt
diff -r c449697b30d9 -r 8a470e6627c0 conf/webserver.conf
--- a/conf/webserver.conf Mon Oct 26 05:06:01 2009 +0000
+++ b/conf/webserver.conf Sun May 02 00:21:22 2010 +0000
@@ -17,5 +17,5 @@ ENABLE docs
# always good to keep an internal management port open:
CREATE SERVICE mgmt
SET role = management
- SET listen = 127.0.0.1:60000
+ SET listen = 127.0.0.1:16000
ENABLE mgmt
diff -r c449697b30d9 -r 8a470e6627c0 doc/service-parameters.txt
--- a/doc/service-parameters.txt Mon Oct 26 05:06:01 2009 +0000
+++ b/doc/service-parameters.txt Sun May 02 00:21:22 2010 +0000
@@ -11,319 +11,394 @@
For all services:
- +------------------------------------------------------------------------+
- | Param | type | Default | Description |
- |-----------------+------+-----------------------+-----------------------|
- | enable_ssl | bool | false | Enable SSL to the |
- | | | | client. |
- |-----------------+------+-----------------------+-----------------------|
- | | | | The ip:port to listen |
- | | | | on. For a service to |
- | | | | work, you must either |
- | listen | | | make it listen, or |
- | | | | make another selector |
- | | | | service map to a |
- | | | | non-listening |
- | | | | service. |
- |-----------------+------+-----------------------+-----------------------|
- | | | | Whether to enable |
- | persist_client | bool | false | HTTP keep-alives to |
- | | | | the end user. |
- |-----------------+------+-----------------------+-----------------------|
- | | | | Timeout in secs for |
- | persist_client_ | int | 30 | HTTP keep-alives to |
- | timeout | | | the end user. |
- |-----------------+------+-----------------------+-----------------------|
- | | | | What type of service. |
- | | | | One of |
- | | | | 'reverse_proxy' for a |
- | | | | service that load |
- | | | | balances to a pool of |
- | | | | backend webserver |
- | | | | nodes, 'web_server' |
- | | | | for a typical |
- | role | | | webserver', |
- | | | | 'management' for a |
- | | | | Perlbal management |
- | | | | interface (speaks |
- | | | | both command-line or |
- | | | | HTTP, auto-detected), |
- | | | | or 'selector', for a |
- | | | | virtual service that |
- | | | | maps onto other |
- | | | | services. |
- |-----------------+------+-----------------------+-----------------------|
- | ssl_cert_file | | certs/server-cert.pem | Path to certificate |
- | | | | PEM file for SSL. |
- | | | | Include any needed |
- | | | | chain PEMs here, too. |
- |-----------------+------+-----------------------+-----------------------|
- | ssl_cipher_list | | ALL:!LOW:!EXP | OpenSSL-style cipher |
- | | | | list. |
- |-----------------+------+-----------------------+-----------------------|
- | ssl_key_file | | certs/server-key.pem | Path to private key |
- | | | | PEM file for SSL. |
- +------------------------------------------------------------------------+
++----------------------------------------------------------------------------------+
+| Param |type| Default | Description |
+|---------------------------+----+---------------------+---------------------------|
+| | | |Whether to trust all |
+| | | |incoming requests' |
+| | | |X-Forwarded-For and related|
+|always_trusted |bool|false |headers. Set to true only |
+| | | |if you know that all |
+| | | |incoming requests from your|
+| | | |own proxy servers that |
+| | | |clean/set those headers. |
+|---------------------------+----+---------------------+---------------------------|
+|client_sndbuf_size |size|0 |How large to set the |
+| | | |client's socket SNDBUF. |
+|---------------------------+----+---------------------+---------------------------|
+|enable_ssl |bool|false |Enable SSL to the client. |
+|---------------------------+----+---------------------+---------------------------|
+| | | |Timeout in seconds for idle|
+|idle_timeout |int |30 |connections to the end user|
+| | | |(default is 30) |
+|---------------------------+----+---------------------+---------------------------|
+| | | |The ip:port to listen on. |
+| | | |For a service to work, you |
+|listen | | |must either make it listen,|
+| | | |or make another selector |
+| | | |service map to a |
+| | | |non-listening service. |
+|---------------------------+----+---------------------+---------------------------|
+| | | |The maximum size that will |
+| | | |be accepted for a chunked |
+| | | |request. Default is 200MB |
+|max_chunked_request_size |size|209715200 |(which is written to disk, |
+| | | |buffered uploads must be |
+| | | |on). A value of 0 means no |
+| | | |limit. |
+|---------------------------+----+---------------------+---------------------------|
+| | | |Whether to enable HTTP |
+|persist_client |bool|false |keep-alives to the end |
+| | | |user. |
+|---------------------------+----+---------------------+---------------------------|
+| | | |Timeout in seconds for HTTP|
+|persist_client_idle_timeout|int |30 |keep-alives to the end user|
+| | | |(default is 30) |
+|---------------------------+----+---------------------+---------------------------|
+| | | |Set both the |
+|persist_client_timeout |int | |persist_client_idle_timeout|
+| | | |and idle_timeout |
+| | | |(deprecated) |
+|---------------------------+----+---------------------+---------------------------|
+| | | |What type of service. One |
+| | | |of 'reverse_proxy' for a |
+| | | |service that load balances |
+| | | |to a pool of backend |
+| | | |webserver nodes, |
+| | | |'web_server' for a typical |
+|role | | |webserver', 'management' |
+| | | |for a Perlbal management |
+| | | |interface (speaks both |
+| | | |command-line or HTTP, |
+| | | |auto-detected), or |
+| | | |'selector', for a virtual |
+| | | |service that maps onto |
+| | | |other services. |
+|---------------------------+----+---------------------+---------------------------|
+|ssl_cert_file | |certs/server-cert.pem|Path to certificate PEM |
+| | | |file for SSL. |
+|---------------------------+----+---------------------+---------------------------|
+|ssl_cipher_list | |ALL:!LOW:!EXP |OpenSSL-style cipher list. |
+|---------------------------+----+---------------------+---------------------------|
+|ssl_key_file | |certs/server-key.pem |Path to private key PEM |
+| | | |file for SSL. |
+|---------------------------+----+---------------------+---------------------------|
+| | | |A Net::Netmask filter (e.g.|
+| | | |10.0.0.0/24, see |
+| | | |Net::Netmask) that |
+|trusted_upstream_proxies | | |determines whether upstream|
+| | | |clients are trusted or not,|
+| | | |where trusted means their |
+| | | |X-Forwarded-For/etc headers|
+| | | |are not munged. |
++----------------------------------------------------------------------------------+
Only for 'reverse_proxy' services:
-+----------------------------------------------------------------------------------+
-| Param |type| Default | Description |
-|-----------------------------+----+-------------------+---------------------------|
-| | | |Whether to trust all |
-| | | |incoming requests' |
-| | | |X-Forwarded-For and related|
-|always_trusted |bool|false |headers. Set to true only |
-| | | |if you know that all |
-| | | |incoming requests from your|
-| | | |own proxy servers that |
-| | | |clean/set those headers. |
-|-----------------------------+----+-------------------+---------------------------|
-| | | |The number of backend |
-|backend_persist_cache |int |2 |connections to keep alive |
-| | | |on reserve while there are |
-| | | |no clients. |
-|-----------------------------+----+-------------------+---------------------------|
-| | | |How much content-body |
-| | | |(POST/PUT/etc) data we read|
-| | | |from a client before we |
-| | | |start sending it to a |
-| | | |backend web node. If |
-|buffer_backend_connect |size|100k |'buffer_uploads' is |
-| | | |enabled, this value is used|
-| | | |to determine how many bytes|
-| | | |are read before Perlbal |
-| | | |makes a determination on |
-| | | |whether or not to spool the|
-| | | |upload to disk. |
-|-----------------------------+----+-------------------+---------------------------|
-| | | |How much we'll ahead of a |
-| | | |client we'll get while |
-| | | |copying from a backend to a|
-|buffer_size |size|256k |client. If a client gets |
-| | | |behind this much, we stop |
-| | | |reading from the backend |
-| | | |for a bit. |
-|-----------------------------+----+-------------------+---------------------------|
-| | | |How much we'll get ahead of|
-| | | |a client we'll get while |
-| | | |copying from a reproxied |
-| | | |URL to a client. If a |
-| | | |client gets behind this |
-| | | |much, we stop reading from |
-| | | |the reproxied URL for a |
-| | | |bit. The default is lower |
-| | | |than the regular |
-|buffer_size_reproxy_url |size|50k |buffer_size (50k instead of|
-| | | |256k) because it's assumed |
-| | | |that you're only reproxying|
-| | | |to large files on |
-| | | |event-based webservers, |
-| | | |which are less sensitive to|
-| | | |many open connections, |
-| | | |whereas the 256k buffer |
-| | | |size is good for keeping |
-| | | |heavy process-based free of|
-| | | |slow clients. |
-|-----------------------------+----+-------------------+---------------------------|
-| | | |If an upload is coming in |
-| | | |at a rate less than this |
-|buffer_upload_threshold_rate |int |0 |value in bytes per second, |
-| | | |it will be buffered to |
-| | | |disk. Set to 0 to not check|
-| | | |rate. |
-|-----------------------------+----+-------------------+---------------------------|
-| | | |If an upload is larger than|
-|buffer_upload_threshold_size |size|250k |this size in bytes, it will|
-| | | |be buffered to disk. Set to|
-| | | |0 to not check size. |
-|-----------------------------+----+-------------------+---------------------------|
-| | | |If an upload is estimated |
-| | | |to take more than this |
-|buffer_upload_threshold_time |int |5 |number of seconds, it will |
-| | | |be buffered to disk. Set to|
-| | | |0 to not check estimated |
-| | | |time. |
-|-----------------------------+----+-------------------+---------------------------|
-| | | |Used to enable or disable |
-| | | |the buffer uploads to disk |
-| | | |system. If enabled, |
-| | | |'buffer_backend_connect' |
-| | | |bytes worth of the upload |
-|buffer_uploads |bool|false |will be stored in memory. |
-| | | |At that point, the buffer |
-| | | |upload thresholds will be |
-| | | |checked to see if we should|
-| | | |just send this upload to |
-| | | |the backend, or if we |
-| | | |should spool it to disk. |
-|-----------------------------+----+-------------------+---------------------------|
-| | | |Directory root for storing |
-|buffer_uploads_path | | |files used to buffer |
-| | | |uploads. |
-|-----------------------------+----+-------------------+---------------------------|
-| | | |How many extra backend |
-| | | |connections we keep alive |
-|connect_ahead |int |0 |in addition to the current |
-| | | |ones, in anticipation of |
-| | | |new client connections. |
-|-----------------------------+----+-------------------+---------------------------|
-| | | |Whether Perlbal should |
-| | | |transparently retry |
-|enable_error_retries |bool|false |requests to backends if a |
-| | | |backend returns a 500 |
-| | | |server error. |
-|-----------------------------+----+-------------------+---------------------------|
-| | | |Enable 'reproxying' |
-| | | |(end-user-transparent |
-| | | |internal redirects) to |
-| | | |either local files or other|
-| | | |URLs. When enabled, the |
-| | | |backend servers in the pool|
-| | | |that this service is |
-|enable_reproxy |bool|false |configured for will have |
-| | | |access to tell this Perlbal|
-| | | |instance to serve any local|
-| | | |readable file, or connect |
-| | | |to any other URL that this |
-| | | |Perlbal can connect to. |
-| | | |Only enable this if you |
-| | | |trust the backend web |
-| | | |nodes. |
-|-----------------------------+----+-------------------+---------------------------|
-| | | |String of comma-separated |
-| | | |seconds (full or partial) |
-| | | |to delay between retries. |
-| | | |For example "0,2" would |
-| | | |mean do at most two |
-|error_retry_schedule | |0,.25,.50,1,1,1,1,1|retries, the first zero |
-| | | |seconds after the first |
-| | | |failure, and the second 2 |
-| | | |seconds after the 2nd |
-| | | |failure. You probably don't|
-| | | |need to modify the default |
-| | | |value |
-|-----------------------------+----+-------------------+---------------------------|
-| | | |The cookie name to inspect |
-|high_priority_cookie | | |to determine if the client |
-| | | |goes onto the high-priority|
-| | | |queue. |
-|-----------------------------+----+-------------------+---------------------------|
-| | | |A string that the |
-|high_priority_cookie_contents| | |high_priority_cookie must |
-| | | |contain to go onto the |
-| | | |high-priority queue. |
-|-----------------------------+----+-------------------+---------------------------|
-| | | |The max number of requests |
-| | | |to be made on a single |
-| | | |persistent backend |
-| | | |connection before releasing|
-| | | |the connection. The default|
-|max_backend_uses | |0 |value of 0 means no limit, |
-| | | |and the connection will |
-| | | |only be discarded once the |
-| | | |backend asks it to be, or |
-| | | |when Perlbal is |
-| | | |sufficiently idle. |
-|-----------------------------+----+-------------------+---------------------------|
-| | | |Whether to enable HTTP |
-| | | |keep-alives to the backend |
-| | | |webnodes. (Off by default, |
-| | | |but highly recommended if |
-|persist_backend |bool|false |Perlbal will be the only |
-| | | |client to your backends. If|
-| | | |not, beware that Perlbal |
-| | | |will hog the connections, |
-| | | |starving other clients.) |
-|-----------------------------+----+-------------------+---------------------------|
-| | | |Name of previously-created |
-| | | |pool object containing the |
-|pool | | |backend nodes that this |
-| | | |reverse proxy sends |
-| | | |requests to. |
-|-----------------------------+----+-------------------+---------------------------|
-|queue_relief_chance | |0 | |
-|-----------------------------+----+-------------------+---------------------------|
-|queue_relief_size |int |0 | |
-|-----------------------------+----+-------------------+---------------------------|
-| | | |A Net::Netmask filter (e.g.|
-| | | |10.0.0.0/24, see |
-| | | |Net::Netmask) that |
-|trusted_upstream_proxies | | |determines whether upstream|
-| | | |clients are trusted or not,|
-| | | |where trusted means their |
-| | | |X-Forwarded-For/etc headers|
-| | | |are not munged. |
-|-----------------------------+----+-------------------+---------------------------|
-| | | |Comma separated list of |
-| | | |hosts in form |
-| | | |'a.b.c.d:port' which will |
-| | | |receive UDP upload status |
-| | | |packets no faster than once|
-| | | |a second per HTTP request |
-| | | |(PUT/POST) from clients |
-|upload_status_listeners | | |that have requested an |
-| | | |upload status bar, which |
-| | | |they request by appending |
-| | | |the URL get argument |
-| | | |?client_up_session=[xxxxxx]|
-| | | |where xxxxx is 5-50 'word' |
-| | | |characters (a-z, A-Z, 0-9, |
-| | | |underscore). |
-|-----------------------------+----+-------------------+---------------------------|
-| | | |Whether Perlbal should send|
-| | | |a quick OPTIONS request to |
-| | | |the backends before sending|
-| | | |an actual client request to|
-| | | |them. If your backend is |
-| | | |Apache or some other |
-| | | |process-based webserver, |
-| | | |this is HIGHLY recommended.|
-|verify_backend |bool|false |All too often a loaded |
-| | | |backend box will reply to |
-| | | |new TCP connections, but |
-| | | |it's the kernel's TCP stack|
-| | | |Perlbal is talking to, not |
-| | | |an actual Apache process |
-| | | |yet. Using this option |
-| | | |reduces end-user latency a |
-| | | |ton on loaded sites. |
-|-----------------------------+----+-------------------+---------------------------|
-|verify_backend_path | |* |Path in the OPTIONS request|
-| | | |sent by verify_backend. |
-+----------------------------------------------------------------------------------+
++-------------------------------------------------------------------------------+
+| Param |type| Default | Description |
+|-----------------------------+----+-------------------+------------------------|
+| | | |The number of backend |
+|backend_persist_cache |int |2 |connections to keep |
+| | | |alive on reserve while |
+| | | |there are no clients. |
+|-----------------------------+----+-------------------+------------------------|
+| | | |Flag to disable any |
+| | | |modification of |
+|blind_proxy |bool|false |X-Forwarded-For, X-Host,|
+| | | |and X-Forwarded-Host |
+| | | |headers. |
+|-----------------------------+----+-------------------+------------------------|
+| | | |How much content-body |
+| | | |(POST/PUT/etc) data we |
+| | | |read from a client |
+| | | |before we start sending |
+| | | |it to a backend web |
+| | | |node. If |
+|buffer_backend_connect |size|100k |'buffer_uploads' is |
+| | | |enabled, this value is |
+| | | |used to determine how |
+| | | |many bytes are read |
+| | | |before Perlbal makes a |
+| | | |determination on whether|
+| | | |or not to spool the |
+| | | |upload to disk. |
+|-----------------------------+----+-------------------+------------------------|
+| | | |How much we'll ahead of |
+| | | |a client we'll get while|
+| | | |copying from a backend |
+|buffer_size |size|256k |to a client. If a client|
+| | | |gets behind this much, |
+| | | |we stop reading from the|
+| | | |backend for a bit. |
+|-----------------------------+----+-------------------+------------------------|
+| | | |How much we'll get ahead|
+| | | |of a client we'll get |
+| | | |while copying from a |
+| | | |reproxied URL to a |
+| | | |client. If a client gets|
+| | | |behind this much, we |
+| | | |stop reading from the |
+| | | |reproxied URL for a bit.|
+| | | |The default is lower |
+| | | |than the regular |
+|buffer_size_reproxy_url |size|50k |buffer_size (50k instead|
+| | | |of 256k) because it's |
+| | | |assumed that you're only|
+| | | |reproxying to large |
+| | | |files on event-based |
+| | | |webservers, which are |
+| | | |less sensitive to many |
+| | | |open connections, |
+| | | |whereas the 256k buffer |
+| | | |size is good for keeping|
+| | | |heavy process-based free|
+| | | |of slow clients. |
+|-----------------------------+----+-------------------+------------------------|
+| | | |If an upload is coming |
+| | | |in at a rate less than |
+|buffer_upload_threshold_rate |int |0 |this value in bytes per |
+| | | |second, it will be |
+| | | |buffered to disk. Set to|
+| | | |0 to not check rate. |
+|-----------------------------+----+-------------------+------------------------|
+| | | |If an upload is larger |
+| | | |than this size in bytes,|
+|buffer_upload_threshold_size |size|250k |it will be buffered to |
+| | | |disk. Set to 0 to not |
+| | | |check size. |
+|-----------------------------+----+-------------------+------------------------|
+| | | |If an upload is |
+| | | |estimated to take more |
+| | | |than this number of |
+|buffer_upload_threshold_time |int |5 |seconds, it will be |
+| | | |buffered to disk. Set to|
+| | | |0 to not check estimated|
+| | | |time. |
+|-----------------------------+----+-------------------+------------------------|
+| | | |Used to enable or |
+| | | |disable the buffer |
+| | | |uploads to disk system. |
+| | | |If enabled, |
+| | | |'buffer_backend_connect'|
+| | | |bytes worth of the |
+| | | |upload will be stored in|
+|buffer_uploads |bool|false |memory. At that point, |
+| | | |the buffer upload |
+| | | |thresholds will be |
+| | | |checked to see if we |
+| | | |should just send this |
+| | | |upload to the backend, |
+| | | |or if we should spool it|
+| | | |to disk. |
+|-----------------------------+----+-------------------+------------------------|
+| | | |Directory root for |
+|buffer_uploads_path | | |storing files used to |
+| | | |buffer uploads. |
+|-----------------------------+----+-------------------+------------------------|
+| | | |How many extra backend |
+| | | |connections we keep |
+|connect_ahead |int |0 |alive in addition to the|
+| | | |current ones, in |
+| | | |anticipation of new |
+| | | |client connections. |
+|-----------------------------+----+-------------------+------------------------|
+| | | |Whether Perlbal should |
+| | | |transparently retry |
+|enable_error_retries |bool|false |requests to backends if |
+| | | |a backend returns a 500 |
+| | | |server error. |
+|-----------------------------+----+-------------------+------------------------|
+| | | |Enable 'reproxying' |
+| | | |(end-user-transparent |
+| | | |internal redirects) to |
+| | | |either local files or |
+| | | |other URLs. When |
+| | | |enabled, the backend |
+| | | |servers in the pool that|
+| | | |this service is |
+|enable_reproxy |bool|false |configured for will have|
+| | | |access to tell this |
+| | | |Perlbal instance to |
+| | | |serve any local readable|
+| | | |file, or connect to any |
+| | | |other URL that this |
+| | | |Perlbal can connect to. |
+| | | |Only enable this if you |
+| | | |trust the backend web |
+| | | |nodes. |
+|-----------------------------+----+-------------------+------------------------|
+| | | |String of |
+| | | |comma-separated seconds |
+| | | |(full or partial) to |
+| | | |delay between retries. |
+| | | |For example "0,2" would |
+| | | |mean do at most two |
+|error_retry_schedule | |0,.25,.50,1,1,1,1,1|retries, the first zero |
+| | | |seconds after the first |
+| | | |failure, and the second |
+| | | |2 seconds after the 2nd |
+| | | |failure. You probably |
+| | | |don't need to modify the|
+| | | |default value |
+|-----------------------------+----+-------------------+------------------------|
+| | | |The cookie name to |
+|high_priority_cookie | | |inspect to determine if |
+| | | |the client goes onto the|
+| | | |high-priority queue. |
+|-----------------------------+----+-------------------+------------------------|
+| | | |A string that the |
+|high_priority_cookie_contents| | |high_priority_cookie |
+| | | |must contain to go onto |
+| | | |the high-priority queue.|
+|-----------------------------+----+-------------------+------------------------|
+| | | |The max number of |
+| | | |requests to be made on a|
+| | | |single persistent |
+| | | |backend connection |
+| | | |before releasing the |
+| | | |connection. The default |
+|max_backend_uses | |0 |value of 0 means no |
+| | | |limit, and the |
+| | | |connection will only be |
+| | | |discarded once the |
+| | | |backend asks it to be, |
+| | | |or when Perlbal is |
+| | | |sufficiently idle. |
+|-----------------------------+----+-------------------+------------------------|
+| | | |Whether to enable HTTP |
+| | | |keep-alives to the |
+| | | |backend webnodes. (Off |
+| | | |by default, but highly |
+| | | |recommended if Perlbal |
+|persist_backend |bool|false |will be the only client |
+| | | |to your backends. If |
+| | | |not, beware that Perlbal|
+| | | |will hog the |
+| | | |connections, starving |
+| | | |other clients.) |
+|-----------------------------+----+-------------------+------------------------|
+| | | |Name of |
+| | | |previously-created pool |
+|pool | | |object containing the |
+| | | |backend nodes that this |
+| | | |reverse proxy sends |
+| | | |requests to. |
+|-----------------------------+----+-------------------+------------------------|
+|queue_relief_chance | |0 | |
+|-----------------------------+----+-------------------+------------------------|
+|queue_relief_size |int |0 | |
+|-----------------------------+----+-------------------+------------------------|
+| | | |Set the maximum number |
+| | | |of cached reproxy |
+| | | |results |
+| | | |(X-REPROXY-CACHE-FOR) |
+| | | |that may be kept in the |
+| | | |service cache. These |
+| | | |cached requests take up |
+|reproxy_cache_maxsize |int |0 |about 1.25KB of ram each|
+| | | |(on Linux x86), but will|
+| | | |vary with usage. Perlbal|
+| | | |still starts with 0 in |
+| | | |the cache and will grow |
+| | | |over time. Be careful |
+| | | |when adjusting this and |
+| | | |watch your ram usage |
+| | | |like a hawk. |
+|-----------------------------+----+-------------------+------------------------|
+| | | |Executable which will be|
+|server_process | | |the HTTP server on |
+| | | |stdin/stdout. (ALPHA, |
+| | | |EXPERIMENTAL!) |
+|-----------------------------+----+-------------------+------------------------|
+| | | |Comma separated list of |
+| | | |hosts in form |
+| | | |'a.b.c.d:port' which |
+| | | |will receive UDP upload |
+| | | |status packets no faster|
+| | | |than once a second per |
+| | | |HTTP request (PUT/POST) |
+|upload_status_listeners | | |from clients that have |
+| | | |requested an upload |
+| | | |status bar, which they |
+| | | |request by appending the|
+| | | |URL get argument |
+| | | |?client_up_sess=[xxxxxx]|
+| | | |where xxxxx is 5-50 |
+| | | |'word' characters (a-z, |
+| | | |A-Z, 0-9, underscore). |
+|-----------------------------+----+-------------------+------------------------|
+| | | |Whether Perlbal should |
+| | | |send a quick OPTIONS |
+| | | |request to the backends |
+| | | |before sending an actual|
+| | | |client request to them. |
+| | | |If your backend is |
+| | | |Apache or some other |
+| | | |process-based webserver,|
+| | | |this is HIGHLY |
+|verify_backend |bool|false |recommended. All too |
+| | | |often a loaded backend |
+| | | |box will reply to new |
+| | | |TCP connections, but |
+| | | |it's the kernel's TCP |
+| | | |stack Perlbal is talking|
+| | | |to, not an actual Apache|
+| | | |process yet. Using this |
+| | | |option reduces end-user |
+| | | |latency a ton on loaded |
+| | | |sites. |
+|-----------------------------+----+-------------------+------------------------|
+| | | |What path the OPTIONS |
+|verify_backend_path | |* |request sent by |
+| | | |verify_backend should |
+| | | |use. Default is '*'. |
++-------------------------------------------------------------------------------+
Only for 'web_server' services:
+------------------------------------------------------------------------+
- | Param | type | Default | Description |
- |-------------------+------+------------+--------------------------------|
- | | | | Show directory indexes when an |
- | | | | HTTP request is for a |
- | dirindexing | bool | false | directory. Warning: this is |
- | | | | not an async operation, so |
- | | | | will slow down Perlbal on |
- | | | | heavily loaded sites. |
- |-------------------+------+------------+--------------------------------|
- | docroot | | | Directory root for web server. |
- |-------------------+------+------------+--------------------------------|
- | enable_delete | bool | false | Enable HTTP DELETE requests. |
- |-------------------+------+------------+--------------------------------|
- | enable_put | bool | false | Enable HTTP PUT requests. |
- |-------------------+------+------------+--------------------------------|
- | | | | Comma-separated list of |
- | index_files | | index.html | filenames to load when a user |
- | | | | visits a directory URL, listed |
- | | | | in order of preference. |
- |-------------------+------+------------+--------------------------------|
- | | | | The maximum content-length |
- | | | | that will be accepted for a |
- | max_put_size | size | 0 | PUT request, if enable_put is |
- | | | | on. Default value of 0 means |
- | | | | no limit. |
- |-------------------+------+------------+--------------------------------|
- | | | | If PUT requests are enabled, |
- | min_put_directory | int | 0 | require this many levels of |
- | | | | directories to already exist. |
- | | | | If not, fail. |
+ | Param |type| Default | Description |
+ |----------------------+----+----------+---------------------------------|
+ | | | |Show directory indexes when an |
+ | | | |HTTP request is for a directory. |
+ |dirindexing |bool|false |Warning: this is not an async |
+ | | | |operation, so will slow down |
+ | | | |Perlbal on heavily loaded sites. |
+ |----------------------+----+----------+---------------------------------|
+ |docroot | | |Directory root for web server. |
+ |----------------------+----+----------+---------------------------------|
+ | | | |Enable Perlbal's |
+ | | | |multiple-files-in-one-request |
+ | | | |mode, where a client have use a |
+ | | | |comma-separated list of files to |
+ | | | |return, always in text/plain. |
+ | | | |Useful for web apps which have |
+ |enable_concatenate_get|bool|false |dozens/hundreds of tiny css/js |
+ | | | |files, and don't trust |
+ | | | |browsers/etc to do pipelining. |
+ | | | |Decreases overall round-trip |
+ | | | |latency a bunch, but requires app|
+ | | | |to be modified to support it. See|
+ | | | |t/17-concat.t test for details. |
+ |----------------------+----+----------+---------------------------------|
+ |enable_delete |bool|false |Enable HTTP DELETE requests. |
+ |----------------------+----+----------+---------------------------------|
+ |enable_put |bool|false |Enable HTTP PUT requests. |
+ |----------------------+----+----------+---------------------------------|
+ | | | |Comma-separated list of filenames|
+ |index_files | |index.html|to load when a user visits a |
+ | | | |directory URL, listed in order of|
+ | | | |preference. |
+ |----------------------+----+----------+---------------------------------|
+ | | | |The maximum content-length that |
+ | | | |will be accepted for a PUT |
+ |max_put_size |size|0 |request, if enable_put is on. |
+ | | | |Default value of 0 means no |
+ | | | |limit. |
+ |----------------------+----+----------+---------------------------------|
+ | | | |If PUT requests are enabled, |
+ |min_put_directory |int |0 |require this many levels of |
+ | | | |directories to already exist. If |
+ | | | |not, fail. |
+------------------------------------------------------------------------+
diff -r c449697b30d9 -r 8a470e6627c0 lib/Perlbal.pm
--- a/lib/Perlbal.pm Mon Oct 26 05:06:01 2009 +0000
+++ b/lib/Perlbal.pm Sun May 02 00:21:22 2010 +0000
@@ -10,12 +10,21 @@ Perlbal - Reverse-proxy load balancer an
=head1 SEE ALSO
- http://www.danga.com/perlbal/
+L<http://www.danga.com/perlbal/>
+
+=head1 CONTRIBUTING
+
+Got a patch? Or a bug report? Instructions on how to contribute
+are located here:
+
+L<http://contributing.appspot.com/perlbal>
+
+Thanks!
=head1 COPYRIGHT AND LICENSE
Copyright 2004, Danga Interactive, Inc.
-Copyright 2005-2007, Six Apart, Ltd.
+Copyright 2005-2010, Six Apart, Ltd.
You can use and redistribute Perlbal under the same terms as Perl itself.
@@ -33,7 +42,7 @@ use Devel::Peek;
use Devel::Peek;
use vars qw($VERSION);
-$VERSION = '1.72';
+$VERSION = '1.75';
use constant DEBUG => $ENV{PERLBAL_DEBUG} || 0;
use constant DEBUG_OBJ => $ENV{PERLBAL_DEBUG_OBJ} || 0;
@@ -60,7 +69,7 @@ use Getopt::Long;
use Getopt::Long;
use Carp qw(cluck croak);
use Errno qw(EBADF);
-use POSIX ();
+use POSIX qw(SIG_BLOCK SIG_UNBLOCK SIGINT sigprocmask);
our(%TrackVar);
sub track_var {
@@ -198,7 +207,7 @@ sub create_service {
sub create_service {
my $class = shift;
my $name = shift;
-
+
unless (defined($name)) {
$name = "____auto_".($service_autonumber++);
}
@@ -470,7 +479,7 @@ sub MANAGE_mime {
return $mc->err("$arg1 not a defined extension.");
}
} else {
- return $mc->err("Usage: list, remove <ext>, add <ext> <mime>");
+ return $mc->err("Usage: list, remove <ext>, set <ext> <mime>");
}
}
@@ -974,6 +983,45 @@ sub MANAGE_server {
return $mc->err("unknown server option '$val'");
}
+sub MANAGE_dumpconfig {
+ my $mc = shift;
+
+ while (my ($name, $pool) = each %pool) {
+ $mc->out("CREATE POOL $name");
+
+ if ($pool->can("dumpconfig")) {
+ foreach my $line ($pool->dumpconfig) {
+ $mc->out(" $line");
+ }
+ } else {
+ my $class = ref($pool);
+ $mc->out(" # Pool class '$class' is unable to dump config.");
+ }
+ } continue {
+ $mc->out("");
+ }
+
+ while (my ($name, $service) = each %service) {
+ $mc->out("CREATE SERVICE $name");
+
+ if ($service->can("dumpconfig")) {
+ foreach my $line ($service->dumpconfig) {
+ $mc->out(" $line");
+ }
+ } else {
+ my $class = ref($service);
+ $mc->out(" # Service class '$class' is unable to dump config.");
+ }
+
+ my $state = $service->{enabled} ? "ENABLE" : "DISABLE";
+ $mc->out("$state $name");
+ } continue {
+ $mc->out("");
+ }
+
+ return $mc->ok
+}
+
sub MANAGE_reproxy_state {
my $mc = shift;
Perlbal::ReproxyManager::dump_state($mc->out);
@@ -1087,22 +1135,46 @@ sub MANAGE_load {
my $last_case;
my $last_class;
- my $load = sub {
- my $name = shift;
+ my $good_error;
+
+ # TODO case protection
+
+ foreach my $name ($fn, lc $fn, ucfirst lc $fn) {
$last_case = $name;
my $class = $last_class = "Perlbal::Plugin::$name";
- my $rv = eval "use $class; $class->load; 1;";
- return $mc->err($@) if ! $rv && $@ !~ /^Can\'t locate/;
- return $rv;
- };
+ my $file = $class . ".pm";
+ $file =~ s!::!/!g;
- my $rv = $load->($fn) || $load->(lc $fn) || $load->(ucfirst lc $fn);
- return $mc->err($@) unless $rv;
+ my $rv = eval "use $class; 1;";
- $PluginCase{lc $fn} = $last_case;
- $plugins{$last_case} = $last_class;
+ if ($rv) {
+ $good_error = undef;
+ last;
+ }
- return $mc->ok;
+ # If we don't have a good error yet, start with this one.
+ $good_error = $@ unless defined $good_error;
+
+ # If the file existed perl will place an entry in %INC (though it will be undef due to compilation error)
+ if (exists $INC{$file}) {
+ $good_error = $@;
+ last;
+ }
+ }
+
+ unless (defined $good_error) {
+ my $rv = eval "$last_class->load; 1;";
+
+ if ($rv) {
+ $PluginCase{lc $fn} = $last_case;
+ $plugins{$last_case} = $last_class;
+ return $mc->ok;
+ }
+
+ $good_error = $@;
+ }
+
+ return $mc->err($good_error);
}
sub MANAGE_reload {
@@ -1190,16 +1262,22 @@ sub daemonize {
IO::AIO::max_parallel(0)
if $Perlbal::OPTMOD_IO_AIO;
+ my $sigset = POSIX::SigSet->new(SIGINT);
+ sigprocmask(SIG_BLOCK, $sigset)
+ or die "Can't block sigint for fork: $!";
+
## Fork and exit parent
if ($pid = fork) { exit 0; }
+
+ sigprocmask(SIG_UNBLOCK, $sigset)
+ or die "Can't unblock sigint after fork: $!";
## Detach ourselves from the terminal
croak "Cannot detach from controlling terminal"
unless $sess_id = POSIX::setsid();
- ## Prevent possibility of acquiring a controlling terminal
- $SIG{'HUP'} = 'IGNORE';
- if ($pid = fork) { exit 0; }
+ # Handler for INT needs to be restored.
+ $SIG{INT} = 'DEFAULT';
## Change working directory
chdir "/";
@@ -1296,7 +1374,12 @@ sub log {
if ($foreground) {
# syslog acts like printf so we have to use printf and append a \n
shift; # ignore the first parameter (info, warn, crit, etc)
- printf(shift(@_) . "\n", @_);
+ my $message = shift;
+ if (@_) {
+ printf("$message\n", @_);
+ } else {
+ print("$message\n");
+ }
} else {
# just pass the parameters to syslog
Sys::Syslog::syslog(@_) if $Perlbal::syslog_open;
diff -r c449697b30d9 -r 8a470e6627c0 lib/Perlbal/BackendHTTP.pm
--- a/lib/Perlbal/BackendHTTP.pm Mon Oct 26 05:06:01 2009 +0000
+++ b/lib/Perlbal/BackendHTTP.pm Sun May 02 00:21:22 2010 +0000
@@ -50,7 +50,7 @@ use Perlbal::ClientProxy;
# if this is made too big, (say, 128k), then perl does malloc instead
# of using its slab cache.
-use constant BACKEND_READ_SIZE => 61449; # 60k, to fit in a 64k slab
+use constant BACKEND_READ_SIZE => 61440; # 60k, to fit in a 64k slab
# keys set here when an endpoint is found to not support persistent
# connections and/or the OPTIONS method
@@ -504,10 +504,6 @@ sub handle_response { # : void
my $res_source = $client->{primary_res_hdrs} || $hd;
my $thd = $client->{res_headers} = $res_source->clone;
- # setup_keepalive will set Connection: and Keep-Alive: headers for us
- # as well as setup our HTTP version appropriately
- $client->setup_keepalive($thd);
-
# if we had an alternate primary response header, make sure
# we send the real content-length (from the reproxied URL)
# and not the one the first server gave us
@@ -524,9 +520,13 @@ sub handle_response { # : void
$thd->code($rescode);
$thd->header('Accept-Ranges', $hd->header('Accept-Ranges')) if $hd->header('Accept-Ranges');
$thd->header('Content-Range', $hd->header('Content-Range')) if $hd->header('Content-Range');
- }
+ }
$thd->code(200) if $thd->response_code == 204; # upgrade HTTP No Content (204) to 200 OK.
}
+
+ # setup_keepalive will set Connection: and Keep-Alive: headers for us
+ # as well as setup our HTTP version appropriately
+ $client->setup_keepalive($thd);
print " writing response headers to client\n" if Perlbal::DEBUG >= 3;
$client->write($thd->to_string_ref);
diff -r c449697b30d9 -r 8a470e6627c0 lib/Perlbal/Cache.pm
--- a/lib/Perlbal/Cache.pm Mon Oct 26 05:06:01 2009 +0000
+++ b/lib/Perlbal/Cache.pm Sun May 02 00:21:22 2010 +0000
@@ -59,7 +59,8 @@ sub maxsize {
}
sub set_maxsize {
- my ($self, $maxsize) = @_;
+ my Perlbal::Cache $self = shift;
+ my $maxsize = shift;
$self->{maxsize} = $maxsize;
$self->drop_tail while
$self->{size} > $self->{maxsize};
@@ -67,7 +68,7 @@ sub set_maxsize {
# For debugging only
sub validate_list {
- my ($self) = @_;
+ my Perlbal::Cache $self = shift;
die "no tail pointer\n" if $self->{size} && ! $self->{tail};
die "no head pointer\n" if $self->{size} && ! $self->{head};
diff -r c449697b30d9 -r 8a470e6627c0 lib/Perlbal/ClientHTTP.pm
--- a/lib/Perlbal/ClientHTTP.pm Mon Oct 26 05:06:01 2009 +0000
+++ b/lib/Perlbal/ClientHTTP.pm Sun May 02 00:21:22 2010 +0000
@@ -247,6 +247,9 @@ sub handle_put_chunked {
return;
}
+ # Reading too far ahead of our AIO subsystem will cause us to buffer it in memory.
+ $self->watch_read(0) if $self->{read_ahead} >= 1024 * 1024; # arbitrary
+ # ->put_writeout clears {read_ahead}, so we run it after we need that
$self->put_writeout if $self->{read_ahead} >= 8192; # arbitrary
},
on_disconnect => sub {
@@ -333,6 +336,9 @@ sub event_read_put {
$self->{content_length_remain} -= $clen;
if ($self->{content_length_remain}) {
+ # Reading too far ahead of our AIO subsystem will cause us to buffer it in memory.
+ $self->watch_read(0) if $self->{read_ahead} >= 1024 * 1024; # arbitrary
+ # ->put_writeout clears {read_ahead}, so we run it after we need that
$self->put_writeout if $self->{read_ahead} >= 8192; # arbitrary
} else {
# now, if we've filled the content of this put, we're done
@@ -426,6 +432,9 @@ sub put_writeout {
$self->{read_buf} = [];
$self->{read_ahead} = 0;
+ # After copying out and clearing the buffer, turn reads back on again to fill up another buffer.
+ $self->watch_read(1) if $self->{content_length_remain} || $self->{chunked_upload_state};
+
# okay, file is open, write some data
$self->{put_in_progress} = 1;
diff -r c449697b30d9 -r 8a470e6627c0 lib/Perlbal/ClientHTTPBase.pm
--- a/lib/Perlbal/ClientHTTPBase.pm Mon Oct 26 05:06:01 2009 +0000
+++ b/lib/Perlbal/ClientHTTPBase.pm Sun May 02 00:21:22 2010 +0000
@@ -36,6 +36,7 @@ use fields ('service', # Per
# service selector parent
'selector_svc', # the original service from which we came
+ 'is_ssl', # Is this socket SSL attached (restricted operations)
);
use Fcntl ':mode';
@@ -76,11 +77,21 @@ sub new {
$self->{requests} = 0;
$self->{scratch} = {};
$self->{selector_svc} = $selector_svc;
+ $self->{is_ssl} = 0;
$self->state('reading_headers');
$self->watch_read(1);
return $self;
+}
+
+sub new_from_base {
+ my $class = shift;
+ my Perlbal::ClientHTTPBase $cb = shift; # base object
+ Perlbal::Util::rebless($cb, $class);
+
+ $cb->handle_request;
+ return $cb;
}
sub close {
@@ -109,6 +120,7 @@ sub setup_keepalive {
# now get the headers we're using
my Perlbal::HTTPHeaders $reshd = $_[1];
my Perlbal::HTTPHeaders $rqhd = $self->{req_headers};
+ my $override_value = $_[2];
# for now, we enforce outgoing HTTP 1.0
$reshd->set_version("1.0");
@@ -117,13 +129,14 @@ sub setup_keepalive {
# we respect for persist_client
my $svc = $self->{selector_svc} || $self->{service};
my $persist_client = $svc->{persist_client} || 0;
+ $persist_client = $override_value if defined $override_value;
print " service's persist_client = $persist_client\n" if Perlbal::DEBUG >= 3;
# do keep alive if they sent content-length or it's a head request
my $do_keepalive = $persist_client && $rqhd->req_keep_alive($reshd);
if ($do_keepalive) {
print " doing keep-alive to client\n" if Perlbal::DEBUG >= 3;
- my $timeout = $self->{service}->{persist_client_timeout};
+ my $timeout = $self->{service}->{persist_client_idle_timeout};
$reshd->header('Connection', 'keep-alive');
$reshd->header('Keep-Alive', $timeout ? "timeout=$timeout, max=100" : undef);
} else {
@@ -139,7 +152,12 @@ sub setup_keepalive {
# overridden here from Perlbal::Socket to use the service value
sub max_idle_time {
- return $_[0]->{service}->{persist_client_timeout};
+ my Perlbal::ClientHTTPBase $self = shift;
+ if ($self->state eq 'persist_wait') {
+ return $self->{service}->{persist_client_idle_timeout};
+ } else {
+ return $self->{service}->{idle_timeout};
+ }
}
# Called when this client is entering a persist_wait state, but before we are returned to base.
@@ -272,7 +290,16 @@ sub event_read {
if $self->{req_headers};
my $hd = $self->read_request_headers;
+ $self->handle_request;
+}
+
+sub handle_request {
+ my Perlbal::ClientHTTPBase $self = shift;
+ my Perlbal::HTTPHeaders $hd = $self->{req_headers};
+
return unless $hd;
+
+ $self->check_req_headers;
return if $self->{service}->run_hook('start_http_request', $self);
@@ -323,7 +350,7 @@ sub event_write_reproxy_fh {
$self->tcp_cork(1) if $self->{reproxy_file_offset} == 0;
$self->watch_write(0);
- if ($self->{service}->{listener}->{sslopts}) { # SSL (sendfile does not do SSL)
+ if ($self->{is_ssl}) { # SSL (sendfile does not do SSL)
return if $self->{closed};
if ($remain <= 0) { #done
print "REPROXY SSL done\n" if Perlbal::DEBUG >= 2;
@@ -851,6 +878,45 @@ sub send_response {
return $self->_simple_response(@_);
}
+sub send_full_response {
+ my Perlbal::ClientHTTPBase $self = shift;
+ my $code = shift;
+ my $headers = shift || [];
+ my $bref = ref($_[0]) eq 'SCALAR' ? shift : \shift;
+ my $options = shift || {};
+
+ my $res = $self->{res_headers} = Perlbal::HTTPHeaders->new_response($code);
+
+ while (@$headers) {
+ my ($name, $value) = splice @$headers, 0, 2;
+ $res->header($name, $value);
+ }
+
+ if ($code == 204 || $code == 304) {
+ $res->header('Content-Length', undef);
+ $bref = \undef;
+ } elsif (defined $$bref) {
+ $res->header('Content-Length', length($$bref));
+ }
+
+ $res->header('Server', 'Perlbal'); # Tunable?
+ # $res->header('Date', # We should do this
+
+ $self->setup_keepalive($res, $options->{persist_client});
+
+ $self->state('xfer_resp');
+ $self->tcp_cork(1); # cork writes to self
+ $self->write($res->to_string_ref);
+
+ if (defined $$bref && $self->{req_headers} && $self->{req_headers}->request_method ne 'HEAD') {
+ # don't write body for head requests
+ $self->write($bref);
+ }
+
+ $self->write(sub { $self->http_response_sent; });
+ return 1;
+}
+
# method that sends a 500 to the user but logs it and any extra information
# we have about the error in question
sub system_error {
diff -r c449697b30d9 -r 8a470e6627c0 lib/Perlbal/ClientProxy.pm
--- a/lib/Perlbal/ClientProxy.pm Mon Oct 26 05:06:01 2009 +0000
+++ b/lib/Perlbal/ClientProxy.pm Sun May 02 00:21:22 2010 +0000
@@ -183,8 +183,17 @@ sub try_next_uri {
sub try_next_uri {
my Perlbal::ClientProxy $self = $_[0];
- shift @{$self->{reproxy_uris}};
+ if ($self->{currently_reproxying}) {
+ # If we're currently reproxying to a backend, that means we want to try the next uri which is
+ # ->{reproxy_uris}->[0].
+ } else {
+ # Since we're not currently reproxying, that means we never got a backend in the first place,
+ # so we want to move on to the next uri which is ->{reproxy_uris}->[1] (shift one off)
+ shift @{$self->{reproxy_uris}};
+ }
+
$self->{currently_reproxying} = undef;
+
$self->start_reproxy_uri();
}
@@ -251,10 +260,6 @@ sub backend_response_received {
my Perlbal::ClientProxy $self = $_[0];
my Perlbal::BackendHTTP $be = $_[1];
- # a response means that we are no longer currently waiting on a reproxy, and
- # don't want to retry this URI
- $self->{currently_reproxying} = undef;
-
# we fail if we got something that's NOT a 2xx code, OR, if we expected
# a certain size and got back something different
my $code = $be->{res_headers}->response_code + 0;
@@ -277,6 +282,11 @@ sub backend_response_received {
$self->try_next_uri;
return 1;
}
+
+ # a response means that we are no longer currently waiting on a reproxy, and
+ # don't want to retry this URI
+ $self->{currently_reproxying} = undef;
+
return 0;
}
@@ -879,8 +889,9 @@ sub satisfy_request_from_cache {
# If 'Last-Modified' is same as 'If-Modified-Since', send a 304
if ($ims eq $lm) {
- my $res_hd = Perlbal::HTTPHeaders->new_response(304);
+ my $res_hd = $self->{res_headers} = Perlbal::HTTPHeaders->new_response(304);
$res_hd->header("Content-Length", "0");
+ $self->setup_keepalive($res_hd);
$self->tcp_cork(1);
$self->state('xfer_resp');
$self->write($res_hd->to_string_ref);
@@ -1073,6 +1084,8 @@ sub continue_buffered_upload {
# write data to disk
sub buffered_upload_update {
my Perlbal::ClientProxy $self = shift;
+ # Reading too far ahead of our AIO subsystem will cause us to buffer it in memory.
+ $self->watch_read(0) if $self->{read_ahead} >= 1024 * 1024; # arbitrary
return if $self->{is_writing};
return unless $self->{is_buffering} && $self->{read_ahead};
@@ -1113,9 +1126,13 @@ sub buffered_upload_update {
}
# at this point, we want to do some writing
- my $bref = shift(@{$self->{read_buf}});
+ my $bref = \join("", map { $$_ } @{$self->{read_buf}});
+ $self->{read_buf} = []; # clear these out
+ $self->{read_ahead} = 0;
my $len = length $$bref;
- $self->{read_ahead} -= $len;
+
+ # After copying out and clearing the buffer, turn reads back on again to fill up another buffer.
+ $self->watch_read(1) if $self->{content_length_remain} || $self->{chunked_upload_state};
# so at this point we have a valid filename and file handle and should write out
# the buffer that we have
diff -r c449697b30d9 -r 8a470e6627c0 lib/Perlbal/HTTPHeaders.pm
--- a/lib/Perlbal/HTTPHeaders.pm Mon Oct 26 05:06:01 2009 +0000
+++ b/lib/Perlbal/HTTPHeaders.pm Sun May 02 00:21:22 2010 +0000
@@ -107,7 +107,7 @@ sub new {
# check for valid response line
return fail("Bogus response line") unless
- $self->{responseLine} =~ m!^HTTP\/(\d+)\.(\d+)\s+(\d+)\s+(.*)$!;
+ $self->{responseLine} =~ m!^HTTP\/(\d+)\.(\d+)\s+(\d+)(?:\s+(.*))$!;
my ($ver_ma, $ver_mi, $code) = ($1, $2, $3);
$self->code($code, $4);
@@ -269,7 +269,8 @@ sub header {
sub headers_list {
my Perlbal::HTTPHeaders $self = shift;
- return [$self->{headers} ? keys %{ $self->{headers} } : ()];
+ return [] unless $self->{headers};
+ return [ map { $self->{origcase}{$_} } keys %{$self->{headers}} ];
}
sub to_string_ref {
diff -r c449697b30d9 -r 8a470e6627c0 lib/Perlbal/Plugin/AccessControl.pm
--- a/lib/Perlbal/Plugin/AccessControl.pm Mon Oct 26 05:06:01 2009 +0000
+++ b/lib/Perlbal/Plugin/AccessControl.pm Sun May 02 00:21:22 2010 +0000
@@ -198,4 +198,25 @@ sub unregister {
return 1;
}
+sub dumpconfig {
+ my ($class, $svc) = @_;
+
+ my @return;
+
+ my $cfg = $svc->{extra_config}->{_access} ||= {};
+ my $rules = $cfg->{rules} || [];
+
+ foreach my $rule (@$rules) {
+ my $action = uc $rule->[0];
+ my $type = uc $rule->[1];
+ my $value = $rule->[2];
+ push @return, "ACCESS $action $type $value";
+ }
+
+ my $default_action = $cfg->{deny_default} ? "DENY" : "ALLOW";
+ push @return, "ACCESS POLICY $default_action";
+
+ return @return;
+}
+
1;
diff -r c449697b30d9 -r 8a470e6627c0 lib/Perlbal/Plugin/Redirect.pm
--- a/lib/Perlbal/Plugin/Redirect.pm Mon Oct 26 05:06:01 2009 +0000
+++ b/lib/Perlbal/Plugin/Redirect.pm Sun May 02 00:21:22 2010 +0000
@@ -18,14 +18,10 @@ sub handle_request {
my $path = $req_header->request_uri;
- my $res_header = Perlbal::HTTPHeaders->new_response(301);
- $res_header->header('Location' => "http://$target_host$path");
- $res_header->header('Content-Length' => 0);
- # For some reason a follow-up request gets a "400 Bad request" response,
- # so until someone has time to figure out why, just punt and disable
- # keep-alives after this request.
- $res_header->header('Connection' => 'close');
- $pb->write($res_header->to_string_ref());
+ $pb->send_full_response(301, [
+ 'Location' => "http://$target_host$path",
+ 'Content-Length' => 0
+ ], "");
return 1;
};
diff -r c449697b30d9 -r 8a470e6627c0 lib/Perlbal/Plugin/Vhosts.pm
--- a/lib/Perlbal/Plugin/Vhosts.pm Mon Oct 26 05:06:01 2009 +0000
+++ b/lib/Perlbal/Plugin/Vhosts.pm Sun May 02 00:21:22 2010 +0000
@@ -73,6 +73,22 @@ sub unregister {
$svc->selector(undef);
delete $Services{"$svc"};
return 1;
+}
+
+sub dumpconfig {
+ my ($class, $svc) = @_;
+
+ my $vhosts = $svc->{extra_config}->{_vhosts};
+
+ return unless $vhosts;
+
+ my @return;
+
+ while (my ($vhost, $target) = each %$vhosts) {
+ push @return, "VHOST $vhost = $target";
+ }
+
+ return @return;
}
# call back from Service via ClientHTTPBase's event_read calling service->select_new_service(Perlbal::ClientHTTPBase)
diff -r c449697b30d9 -r 8a470e6627c0 lib/Perlbal/Pool.pm
--- a/lib/Perlbal/Pool.pm Mon Oct 26 05:06:01 2009 +0000
+++ b/lib/Perlbal/Pool.pm Sun May 02 00:21:22 2010 +0000
@@ -92,6 +92,23 @@ sub set {
return $set->();
}
+}
+
+sub dumpconfig {
+ my Perlbal::Pool $self = shift;
+ my $name = $self->{name};
+
+ my @return;
+
+ if (my $nodefile = $self->{'nodefile'}) {
+ push @return, "SET nodefile = $nodefile";
+ } else {
+ foreach my $node (@{$self->{nodes}}) {
+ my ($ip, $port) = @$node;
+ push @return, "POOL ADD $name $ip:$port";
+ }
+ }
+ return @return;
}
# returns string of balance method
diff -r c449697b30d9 -r 8a470e6627c0 lib/Perlbal/Service.pm
--- a/lib/Perlbal/Service.pm Mon Oct 26 05:06:01 2009 +0000
+++ b/lib/Perlbal/Service.pm Sun May 02 00:21:22 2010 +0000
@@ -57,7 +57,8 @@ use fields (
'reproxy_cache_maxsize', # int; maximum number of reproxy results to be cached. (0 is disabled and default)
'client_sndbuf_size', # int: bytes for SO_SNDBUF
'server_process' , # scalar: path to server process (executable)
- 'persist_client_timeout', # int: keep-alive timeout in seconds for clients (default is 30)
+ 'persist_client_idle_timeout', # int: keep-alive timeout in seconds for clients (default is 30)
+ 'idle_timeout', # int: idle timeout outside of keep-alive time (default is 30)
# Internal state:
'waiting_clients', # arrayref of clients waiting for backendhttp conns
@@ -94,6 +95,8 @@ use fields (
'ssl_key_file', # file: path to key pem file
'ssl_cert_file', # file: path to key pem file
'ssl_cipher_list', # OpenSSL cipher list string
+ 'ssl_ca_path', # directory: path to certificates
+ 'ssl_verify_mode', # int: verification mode, see IO::Socket::SSL documentation
'enable_error_retries', # bool: whether we should retry requests after errors
'error_retry_schedule', # string of comma-separated seconds (full or partial) to delay between retries
@@ -295,7 +298,7 @@ our $tunables = {
},
'upload_status_listeners' => {
- des => "Comma separated list of hosts in form 'a.b.c.d:port' which will receive UDP upload status packets no faster than once a second per HTTP request (PUT/POST) from clients that have requested an upload status bar, which they request by appending the URL get argument ?client_up_session=[xxxxxx] where xxxxx is 5-50 'word' characters (a-z, A-Z, 0-9, underscore).",
+ des => "Comma separated list of hosts in form 'a.b.c.d:port' which will receive UDP upload status packets no faster than once a second per HTTP request (PUT/POST) from clients that have requested an upload status bar, which they request by appending the URL get argument ?client_up_sess=[xxxxxx] where xxxxx is 5-50 'word' characters (a-z, A-Z, 0-9, underscore).",
default => "",
check_role => "reverse_proxy",
check_type => sub {
@@ -402,6 +405,11 @@ our $tunables = {
$self->{index_files} = [ split(/[\s,]+/, $val) ];
return $mc->ok;
},
+ dumper => sub {
+ my ($self, $val) = @_;
+ return unless defined $val;
+ return join(', ', @$val);
+ },
},
'default_service' => {
@@ -448,6 +456,10 @@ our $tunables = {
# the type-checking phase. instead, we do nothing here.
return $mc->ok;
},
+ dumper => sub {
+ my ($self, $val) = @_;
+ return $val->name;
+ }
},
'server_process' => {
@@ -463,12 +475,32 @@ our $tunables = {
},
'persist_client_timeout' => {
+ des => "Set both the persist_client_idle_timeout and idle_timeout (deprecated)",
+ check_type => "int",
+ check_role => "*",
+ setter => sub {
+ my ($self, $val, $set, $mc) = @_;
+ $self->{persist_client_idle_timeout} = $val;
+ $self->{idle_timeout} = $val;
+ return $mc->ok;
+ },
+ dump_ignore => 1,
+ },
+
+ 'persist_client_idle_timeout' => {
des => "Timeout in seconds for HTTP keep-alives to the end user (default is 30)",
check_type => "int",
default => 30,
check_role => "*",
},
-
+
+ 'idle_timeout' => {
+ des => "Timeout in seconds for idle connections to the end user (default is 30)",
+ check_type => "int",
+ default => 30,
+ check_role => "*",
+ },
+
'buffer_uploads_path' => {
des => "Directory root for storing files used to buffer uploads.",
@@ -545,6 +577,20 @@ our $tunables = {
check_role => "*",
},
+ 'ssl_ca_path' => {
+ des => 'Path to directory containing certificates for SSL.',
+ default => undef,
+ check_type => "directory_or_none",
+ check_role => "*",
+ },
+
+ 'ssl_verify_mode' => {
+ des => 'SSL verification mode',
+ default => 0,
+ check_type => "int",
+ check_role => "*",
+ },
+
'enable_error_retries' => {
des => 'Whether Perlbal should transparently retry requests to backends if a backend returns a 500 server error.',
default => 0,
@@ -638,6 +684,80 @@ sub run_manage_command {
my $ctx = Perlbal::CommandContext->new;
$ctx->{last_created} = $self->name;
return Perlbal::run_manage_command($cmd, undef, $ctx);
+}
+
+sub dumpconfig {
+ my $self = shift;
+
+ my @return;
+
+ my %my_tunables = %$tunables;
+
+ my $dump = sub {
+ my $setting = shift;
+ };
+
+ foreach my $skip (qw(role listen pool)) {
+ delete $my_tunables{$skip};
+ }
+
+ my $role = $self->{role};
+
+ foreach my $setting ("role", "listen", "pool", sort keys %my_tunables) {
+ my $attrs = $tunables->{$setting};
+
+ next if $attrs->{dump_ignore};
+
+ my $value = $attrs->{_plugin_inserted} ? $self->{extra_config}->{$setting} : $self->{$setting};
+
+ my $check_role = $attrs->{check_role};
+ my $check_type = $attrs->{check_type};
+ my $default = $attrs->{default};
+ my $required = $attrs->{required};
+
+ next if ($check_role && $check_role ne '*' && $check_role ne $role);
+
+ if ($check_type && $check_type eq 'size') {
+ $default = $1 if $default =~ /^(\d+)b$/i;
+ $default = $1 * 1024 if $default =~ /^(\d+)k$/i;
+ $default = $1 * 1024 * 1024 if $default =~ /^(\d+)m$/i;
+ }
+
+ if (!$required) {
+ next unless defined $value;
+ next if (defined $default && $value eq $default);
+ }
+
+ if (my $dumper = $attrs->{dumper}) {
+ $value = $dumper->($self, $value);
+ }
+
+ if ($check_type && $check_type eq 'bool') {
+ $value = 'on' if $value;
+ }
+
+ push @return, "SET $setting = $value";
+ }
+
+ my $plugins = $self->{plugins};
+
+ foreach my $plugin (keys %$plugins) {
+ local $@;
+
+ my $class = "Perlbal::Plugin::$plugin";
+ my $cv = $class->can('dumpconfig');
+
+ if ($cv) {
+ eval { push @return, $class->dumpconfig($self) };
+ if ($@) {
+ push @return, "# Plugin '$plugin' threw an exception while being dumped.";
+ }
+ } else {
+ push @return, "# Plugin '$plugin' isn't capable of dumping config.";
+ }
+ }
+
+ return @return;
}
# called once a role has been set
@@ -734,20 +854,26 @@ sub set {
return $mc->err("File '$val' not found for '$key'") unless -f $val;
} elsif ($req_type eq "file_or_none") {
return $mc->err("File '$val' not found for '$key'") unless -f $val || $val eq $tun->{default};
+ } elsif ($req_type eq "directory_or_none") {
+ return $mc->err("Directory '$val' not found for '$key'") unless !defined $val || -d $val;
} else {
die "Unknown check_type: $req_type\n";
}
+ }
+
+ if ($tun->{_plugin_inserted}) {
+ # plugins that add tunables need to be stored in the extra_config hash due to the main object
+ # using fields. this passthrough is done so the config files don't need to specify this.
+ $set = sub {
+ $self->{extra_config}->{$key} = $val;
+ return $mc->ok;
+ };
}
my $setter = $tun->{setter};
if (ref $setter eq "CODE") {
return $setter->($self, $val, $set, $mc);
- } elsif ($tun->{_plugin_inserted}) {
- # plugins that add tunables need to be stored in the extra_config hash due to the main object
- # using fields. this passthrough is done so the config files don't need to specify this.
- $self->{extra_config}->{$key} = $val;
- return $mc->ok;
} else {
return $set->();
}
@@ -1333,7 +1459,6 @@ sub header_management {
my ($mode, $key, $val, $mc) = @_;
return $mc->err("no header provided") unless $key;
return $mc->err("no value provided") unless $val || $mode eq 'remove';
- return $mc->err("only valid on reverse_proxy services") unless $self->{role} eq 'reverse_proxy';
if ($mode eq 'insert') {
push @{$self->{extra_headers}->{insert}}, [ $key, $val ];
@@ -1381,10 +1506,23 @@ sub selector {
return $self->{selector};
}
+# This is called anytime a client is leaving this service to be another service.
+sub release_client {
+ my Perlbal::Service $self = shift;
+ my Perlbal::ClientHTTPBase $cb = shift;
+
+ $self->munge_headers($cb->{req_headers});
+ return;
+}
+
# given a base client from a 'selector' role, down-cast it to its specific type
sub adopt_base_client {
my Perlbal::Service $self = shift;
my Perlbal::ClientHTTPBase $cb = shift;
+
+ if (my $orig_service = $cb->{service}) {
+ $orig_service->release_client($cb);
+ }
$cb->{service} = $self;
@@ -1395,7 +1533,7 @@ sub adopt_base_client {
Perlbal::ClientProxy->new_from_base($cb);
return;
} elsif ($self->{'role'} eq "selector") {
- $self->selector()->($cb);
+ Perlbal::ClientHTTPBase->new_from_base($cb);
return;
} else {
$cb->_simple_response(500, "Can't map to service type $self->{'role'}");
@@ -1441,6 +1579,8 @@ sub enable {
SSL_key_file => $self->{ssl_key_file},
SSL_cert_file => $self->{ssl_cert_file},
SSL_cipher_list => $self->{ssl_cipher_list},
+ (defined $self->{ssl_ca_path} ? (SSL_ca_path => $self->{ssl_ca_path}) : ()),
+ (defined $self->{ssl_verify_mode} ? (SSL_verify_mode => $self->{ssl_verify_mode}) : ()),
};
return $mc->err("IO::Socket:SSL (0.97+) not available. Can't do SSL.") unless eval "use IO::Socket::SSL 0.97 (); 1;";
return $mc->err("SSL key file ($self->{ssl_key_file}) doesn't exist") unless -f $self->{ssl_key_file};
diff -r c449697b30d9 -r 8a470e6627c0 lib/Perlbal/Socket.pm
--- a/lib/Perlbal/Socket.pm Mon Oct 26 05:06:01 2009 +0000
+++ b/lib/Perlbal/Socket.pm Sun May 02 00:21:22 2010 +0000
@@ -80,6 +80,7 @@ sub write_debuggy {
}
if (Perlbal::DEBUG >= 4) {
+ no warnings 'redefine';
*write = \&write_debuggy;
}
@@ -295,7 +296,7 @@ sub drain_read_buf_to {
### can override if they want to do some other processing.
sub die_gracefully {
my Perlbal::Socket $self = $_[0];
- if ($self->state eq 'persist_wait') {
+ if (defined $self->state && $self->state eq 'persist_wait') {
$self->close('graceful_shutdown');
}
$self->{do_die} = 1;
@@ -312,7 +313,7 @@ sub write {
# Mark this socket alive so we don't time out
$self->{alive_time} = $Perlbal::tick_time;
}
-
+
return $ret;
}
diff -r c449697b30d9 -r 8a470e6627c0 lib/Perlbal/SocketSSL.pm
--- a/lib/Perlbal/SocketSSL.pm Mon Oct 26 05:06:01 2009 +0000
+++ b/lib/Perlbal/SocketSSL.pm Sun May 02 00:21:22 2010 +0000
@@ -41,7 +41,9 @@ use fields qw( listener create_time );
$orig->($self, @{${*$self}->{__close_args}});
} else {
${*$self}->{__close_args} = [ @_ ];
- ${*$self}->{_danga_socket}->close('intercepted_ssl_close');
+ if (exists ${*$self}->{_danga_socket}) {
+ ${*$self}->{_danga_socket}->close('intercepted_ssl_close');
+ }
}
};
}
@@ -104,7 +106,8 @@ sub try_accept {
delete $ref->{$fd};
# now stick the new one in
- $self->{listener}->class_new_socket($sock);
+ my Perlbal::ClientHTTPBase $cb = $self->{listener}->class_new_socket($sock);
+ $cb->{is_ssl} = 1;
return;
}
diff -r c449697b30d9 -r 8a470e6627c0 lib/Perlbal/TCPListener.pm
--- a/lib/Perlbal/TCPListener.pm Mon Oct 26 05:06:01 2009 +0000
+++ b/lib/Perlbal/TCPListener.pm Sun May 02 00:21:22 2010 +0000
@@ -147,17 +147,17 @@ sub class_new_socket {
my $service_role = $self->{service}->role;
if ($service_role eq "reverse_proxy") {
- Perlbal::ClientProxy->new($self->{service}, $psock);
+ return Perlbal::ClientProxy->new($self->{service}, $psock);
} elsif ($service_role eq "management") {
- Perlbal::ClientManage->new($self->{service}, $psock);
+ return Perlbal::ClientManage->new($self->{service}, $psock);
} elsif ($service_role eq "web_server") {
- Perlbal::ClientHTTP->new($self->{service}, $psock);
+ return Perlbal::ClientHTTP->new($self->{service}, $psock);
} elsif ($service_role eq "selector") {
# will be cast to a more specific class later...
- Perlbal::ClientHTTPBase->new($self->{service}, $psock, $self->{service});
+ return Perlbal::ClientHTTPBase->new($self->{service}, $psock, $self->{service});
} elsif (my $creator = Perlbal::Service::get_role_creator($service_role)) {
# was defined by a plugin, so we want to return one of these
- $creator->($self->{service}, $psock);
+ return $creator->($self->{service}, $psock);
}
}
diff -r c449697b30d9 -r 8a470e6627c0 lib/Perlbal/Test/WebServer.pm
--- a/lib/Perlbal/Test/WebServer.pm Mon Oct 26 05:06:01 2009 +0000
+++ b/lib/Perlbal/Test/WebServer.pm Sun May 02 00:21:22 2010 +0000
@@ -217,7 +217,7 @@ sub serve_client {
if ($cmd =~ /^reproxy_url_cached:(\d+):(.+)/i) {
kill 'USR1', $testpid;
$to_send = $response->(headers =>
- "X-Reproxy-URL: $2\r\nX-Reproxy-Cache-For: $1; Last-Modified Content-Type\r\n");
+ "X-Reproxy-URL: $2\r\nX-Reproxy-Cache-For: $1; Last-Modified Content-Type\r\nLast-Modified: 199\r\nContent-Type: application/badger\r\n");
}
if ($cmd =~ /^reproxy_url_multi:((?:\d+:){2,})(\S+)/i) {
diff -r c449697b30d9 -r 8a470e6627c0 perlbal
--- a/perlbal Mon Oct 26 05:06:01 2009 +0000
+++ b/perlbal Sun May 02 00:21:22 2010 +0000
@@ -7,7 +7,9 @@ Perlbal - Reverse-proxy load balancer an
=head1 DESCRIPTION
-For now, see example configuration files in conf/
+For now, see example configuration files in conf/ from the CPAN tarball
+
+http://search.cpan.org/dist/Perlbal/
=head1 AUTHORS
diff -r c449697b30d9 -r 8a470e6627c0 t/12-headers.t
--- a/t/12-headers.t Mon Oct 26 05:06:01 2009 +0000
+++ b/t/12-headers.t Sun May 02 00:21:22 2010 +0000
@@ -34,7 +34,7 @@ foreach my $class (@classes) {
is($obj->header('anoTHER'), '', "headers without content 3 - $class");
is($obj->header('notthere'), undef, "headers without content 4 - $class");
- is_deeply([sort @{ $obj->headers_list }], [qw/ another header something /], 'headers_list');
+ is_deeply([sort map {lc} @{ $obj->headers_list }], [qw/ another header something /], 'headers_list');
}
1;
diff -r c449697b30d9 -r 8a470e6627c0 t/31-realworld.t
--- a/t/31-realworld.t Mon Oct 26 05:06:01 2009 +0000
+++ b/t/31-realworld.t Sun May 02 00:21:22 2010 +0000
@@ -37,7 +37,7 @@ SET buffer_upload_threshold_size = 1
SET buffer_upload_threshold_size = 1
ENABLE test
-LOAD vhosts
+LOAD Vhosts
CREATE SERVICE ss
SET role = selector
diff -r c449697b30d9 -r 8a470e6627c0 t/32-selector.t
--- a/t/32-selector.t Mon Oct 26 05:06:01 2009 +0000
+++ b/t/32-selector.t Sun May 02 00:21:22 2010 +0000
@@ -19,7 +19,7 @@ my $pb_port = new_port();
my $pb_port = new_port();
my $conf = qq{
-LOAD vhosts
+LOAD Vhosts
CREATE POOL a
CREATE SERVICE ss
diff -r c449697b30d9 -r 8a470e6627c0 t/35-reproxy.t
--- a/t/35-reproxy.t Mon Oct 26 05:06:01 2009 +0000
+++ b/t/35-reproxy.t Sun May 02 00:21:22 2010 +0000
@@ -96,14 +96,18 @@ ok_reproxy_url_204();
is($sig_counter, 0, "Prior to first hit, counter should be zero.");
ok_reproxy_url_cached("One");
+ ok_reproxy_url_cached_ims("One");
is($sig_counter, 1, "First hit to populate the cache.");
ok_reproxy_url_cached("Two");
+ ok_reproxy_url_cached_ims("Two");
is($sig_counter, 1, "Second hit should be cached.");
sleep 2;
is($sig_counter, 1, "Prior to third hit, counter should still be 1.");
ok_reproxy_url_cached("Three");
+ ok_reproxy_url_cached_ims("Three");
is($sig_counter, 2, "Third hit isn't cached, now 2.");
ok_reproxy_url_cached("Four");
+ ok_reproxy_url_cached_ims("Four");
is($sig_counter, 2, "Forth hit should be cached again, still 2.");
}
@@ -133,6 +137,11 @@ foreach_aio {
# try to reproxy to a list of URLs, where the first one is bogus, and last one is good
ok_reproxy_url_list();
+{
+ my $resp = $wc->request("reproxy_url:http://127.0.0.1:$webport/bar.txt http://127.0.0.1:$webport/foo.txt");
+ ok($resp->content eq $file_content, "reproxy URL w/ 404 one first");
+}
+
# responses to HEAD requests should not have a body
{
$wc->keepalive(0);
@@ -143,32 +152,47 @@ ok_reproxy_url_list();
$wc->keepalive(1);
}
+my $lm;
sub ok_reproxy_url_cached {
my $resp = $wc->request("reproxy_url_cached:1:http://127.0.0.1:$webport/foo.txt");
ok($resp && $resp->content eq $file_content, "reproxy with cache: $_[0]");
+ like($resp->header("Connection"), qr/Keep-Alive/i, "... and keep-alives are on");
+ $lm = $resp->header("Last-Modified");
+}
+
+sub ok_reproxy_url_cached_ims {
+ die "Last-Modified hasn't been set yet" unless defined $lm;
+ my $resp = $wc->request({ headers => "If-Modified-Since: $lm\r\n", }, "reproxy_url_cached:1:http://127.0.0.1:$webport/foo.txt");
+ ok($resp, "Got a response");
+ is($resp->code, 304, "reproxy with cache ims, got 304 correctly: $_[0]");
+ like($resp->header("Connection"), qr/Keep-Alive/i, "... and keep-alives are on");
}
sub ok_reproxy_url_list {
my $resp = $wc->request("reproxy_url_multi:$deadport:$webport:/foo.txt");
ok($resp->content eq $file_content, "reproxy URL w/ dead one first");
+ like($resp->header("Connection"), qr/Keep-Alive/i, "... and keep-alives are on");
}
sub ok_reproxy_file {
my $resp = $wc->request("reproxy_file:$dir/foo.txt");
ok($resp && $resp->content eq $file_content, "reproxy file");
+ like($resp->header("Connection"), qr/Keep-Alive/i, "... and keep-alives are on");
}
sub ok_reproxy_url {
my $resp = $wc->request("reproxy_url:http://127.0.0.1:$webport/foo.txt");
ok($resp->content eq $file_content, "reproxy URL") or diag(dump_res($resp));
is($resp->code, 200, "response code is 200");
+ like($resp->header("Connection"), qr/Keep-Alive/i, "... and keep-alives are on");
}
sub ok_reproxy_url_204 {
my $resp = $wc->request("reproxy_url204:http://127.0.0.1:$webport/foo.txt");
ok($resp->content eq $file_content, "reproxy URL") or diag(dump_res($resp));
is($resp->code, 200, "204 response code is 200");
+ like($resp->header("Connection"), qr/Keep-Alive/i, "... and keep-alives are on");
}
sub ok_status {
diff -r c449697b30d9 -r 8a470e6627c0 t/45-buffereduploads.t
--- a/t/45-buffereduploads.t Mon Oct 26 05:06:01 2009 +0000
+++ b/t/45-buffereduploads.t Sun May 02 00:21:22 2010 +0000
@@ -83,13 +83,14 @@ request("clean_on_early_close", 500_000,
);
# rate tests
-buffer_rules(rate => 200_000);
+# need to write at least 250k (default size threshold)
+buffer_rules(rate => 300_000);
request("buffer_on_rate", 1_000_000,
50_000,
- "sleep:1",
+ "sleep:2",
"empty",
300_000,
- "sleep:1",
+ "sleep:2",
300_000,
"exists",
"finish",
diff -r c449697b30d9 -r 8a470e6627c0 t/75-plugin-include.t
--- a/t/75-plugin-include.t Mon Oct 26 05:06:01 2009 +0000
+++ b/t/75-plugin-include.t Sun May 02 00:21:22 2010 +0000
@@ -37,7 +37,7 @@ ok(manage("INCLUDE = $dir/a.conf"), "inc
ok(manage("INCLUDE = $dir/b* $dir/c*"), "include multi");
-ok(! manage("INCLUDE = $dir/d.conf"), "error on nonexistent conf");
+ok(! manage("INCLUDE = $dir/d.conf", quiet_failure => 1), "error on nonexistent conf");
my $s_output = manage_multi("show SERVICE");
diff -r c449697b30d9 -r 8a470e6627c0 t/76-plugin-redirect.t
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/t/76-plugin-redirect.t Sun May 02 00:21:22 2010 +0000
@@ -0,0 +1,47 @@
+#!/usr/bin/perl
+
+use strict;
+use Perlbal::Test;
+use Perlbal::Test::WebServer;
+use Perlbal::Test::WebClient;
+use Test::More 'no_plan';
+
+my $port = new_port();
+
+my $conf = qq{
+LOAD Redirect
+LOAD Vhosts
+
+CREATE SERVICE ss
+ SET role = selector
+ SET listen = 127.0.0.1:$port
+ SET persist_client = 1
+ SET plugins = Vhosts
+ VHOST example.com = test
+ENABLE ss
+
+CREATE SERVICE test
+ SET role = web_server
+ SET persist_client = 1
+ SET plugins = Redirect
+ REDIRECT HOST example.com example.net
+ENABLE test
+};
+
+my $msock = start_server($conf);
+ok($msock, 'perlbal started');
+
+# make first web client
+my $wc = Perlbal::Test::WebClient->new;
+$wc->server("127.0.0.1:$port");
+$wc->keepalive(1);
+$wc->http_version('1.0');
+
+my $resp = $wc->request({ host => "example.com", }, "foo/bar.txt"); # Test lib prepends '/' for me.
+ok($resp, "Got a response");
+
+is($resp->code, 301, "Redirect has proper code");
+like($resp->header("Location"), qr{^http://example.net/foo/bar.txt$}, "Correct redirect response");
+like($resp->header("Connection"), qr/Keep-Alive/i, "... and keep-alives are on");
+
+1;
--------------------------------------------------------------------------------