Event-RPC-1.08/0000755000175000017500000000000012601717775012176 5ustar joernjoernEvent-RPC-1.08/Changes0000644000175000017500000002175112601717663013473 0ustar joernjoernRevision history and release notes for Event::RPC: 1.08 Sun Sep 26, 2015, joern Notes: - Just a stable release without changes. I thought CPAN testers would pick up developer releases too, but was wrong ;) 1.08_01 Sat Sep 26, 2015, joern Features: - Support for multiple serialisers: Sereal, CBOR::XS, JSON::XS and Storable. That's because Storable is known to be insecure, so this module should not rely on it. Great care has been taken to make these changes up- and downwards compatible, so old clients still can connect to new servers and vice versa. Check documentation chapters MESSAGE FORMAT OPTIONS in Event::RPC, Event::RPC::Server and Event::RPC::Client manpages for details. Thanks to mala for his hint about the security issues of Storable. You find more details in this article: http://www.masteringperl.org/2012/12/the-storable-security-problem/ Bugfixes: - Proper handling of exceptions which occur at the server before a remote method is really executed, e.g. when lookup of the class failed due to incorrect @INC path. - Fixed encoding of source files and corrected the year of all Copyright notices. 1.07 Mon Sep 21, 2015, joern Features: - New method return type '_singleton'. Objects created this way are never destroyed on the server. 1.06 Sun Sep 20, 2015, joern Features: - New 'ssl_opts' attribute for Server and Client to give more control over the SSL connection. Bugfixes: - Some tests failed due to stronger hostname verifcation in IO::Socket:SSL >= 2.017. Fixed that by adding proper certificates with cn 'localhost' and a test which verifies the failing connection with wrong hostname. Thanks to ppisar[...]redhat.com. This fixes rt #106874. 1.05 Tue Feb 28, 2014, joern Features: - New Method set_max_packet_size (Client and Server) to change the default value of 2 GB up to 4 GB (or less). Bugfixes - Increased default maximum packet size from 4 MB to 2 GB. - Fixed test suite for parallel execution by using different port numbers for the test server. Thanks for the report to Andreas König. - Applied a patch from Salvatore Bonaccorso which fixes missing encoding declarations in POD. Thanks! - Fixed some POD typos. Thanks for the report to Xavier Guimard. 1.04 Fri Feb 24, 2014, joern Bugfixes - Under certain infrequently conditions it could happen that the server process blocked when sending a response packet to a client. - Event::RPC::Client failed loading when no IO::Socket::SSL is installed. 1.03 Sat Feb 2, 2013, joern Features: - Added options 'ssl_ca_file and 'ssl_ca_path' options to Event::RPC::Client, which enable SSL peer verifcation on the client. Thanks for the report about a security warning of IO::Socket::SSL to Moritz Bunkus. 1.02 Tue Mar 8, 2011, joern Features: - Added AnyEvent mainloop implementation. 1.01 Sat Oct 25, 2008, joern Bugfixes: - Even objects returned by methods not declared as an "object returner" where turned into Event::RPC object handles instead of copying the complete data structure to the client. Thanks for the report to Alex . 1.00 Sat Jun 21, 2008, joern Notes: - Time for version 1.00 ;) Features: - load_modules option added to Event::RPC::Server. - timeout option added to Event::RPC::Client. Patch by Strzelecki Lukasz . 0.90 Sun Apr 23, 2006, joern Notes: - Just a change to the license, switched from LGPL to Perl Artistic + GPL. Thanks for the hint about the bad wording in the old license text to Gregor Herrmann. 0.89 Mon Mar 27, 2006, joern Features: - New class_map attribute for Event::RPC::Client to be able to use classes locally which are imported from the server as well, by giving the server classes a different name on the client. - Turn execptions of unregistered object access into warnings, which makes client / server communication more robust and debugging easier. Bugfixes: - Fixed crashing when a method declared as an object returner returned undef, which should be absolutely legal. - Fixed client side exceptions if server connection is unexpectedly interrupted during a remote method call. - Exceptions are now stringified before send to the client, otherwise Storable may complain on exception objects which can't be freezed e.g. due to embedded code refs. 0.88 Sat Dec 24, 2005, joern Bugfixes: - Use Storable::nfreeze() to pack network messages, so Event::RPC works with mixed endian architectures as well. Patch by Rolf Grossmann . 0.87 Sun Dec 18, 2005, joern Features: - Delegation of authentication resp. user/password check to an external module via Event::RPC::Server attribute "auth_module". Old passwd hash based model is implemented in Event::RPC::AuthPasswdHash. - Fixed a typo in Event::RPC::Looger manpage. Thanks to Sean for the report. - Cleaned up examples/: server.pl and client.pl now both accept -h option for binding/connecting to a specific host, not just localhost. - Makefile.PL tuning: add detected optional modules to PREREQ_PM to get their version numbers added to CPAN Testers reports. Bugfixes: - ChangeLog entry 0.86 was wrong regarding the SSL stuff. 0.86 Sat Dec 17, 2005, joern Features: - added Event::RPC::Server->get_active_connection - documented Event::RPC::Connection->get_client_oids - added Event::RPC::Connection->get_client_object Bugfixes: - Added missing documentation for Event::RPC::Client's error_cb attribute, which was just mentioned in the SYNPOSIS. - Fixed an incompatability with IO::Socket::SSL 0.97, which doesn't return different sysread() states for error and eof anymore which confused Event::RPC. 0.85 Sun Aug 28, 2005, joern Bugfixes: - Make server more bullet proof: handle log connections even if no logger is set, but a log listener was started. - Event::RPC::Server->new didn't recognize the 'connection_hook' parameter. - Try making the testsuite more stable with Win32. 0.84 Mon Jul 25, 2005, joern Bugfixes: - Buffering for big incoming RPC requests (> 64KB) didn't work properly 0.83 Fri Apr 15, 2005, joern Features: - Made more parts of the API public by documenting them. - New server option "connection_hook" for accessing Event::RPC::Connection objects during connecting and disconnecting. - New server option "auto_reload_modules" to control the server's auto reloading facility, which was activated by default up to now. - New server option "host" to bind the listener to a specific address. Default is to bind to all addresses. - Increased connect performance by reducing the number of messages exchanged between client and server. - Client may request a subset of exported server classes. Default is still to import all classes exported by the server. - Client checks Event::RPC version and used protocol version on connect and warns different software versions but dies on incompatible protocol versions. Naturally it's recommended to use the same Event::RPC version on server and client. - Methods for getting client and server (after connecting) software and protocol version numbers. Bugfixes: - Missed ReuseAddr on listener sockets. - Made testsuite more robust - Network logging clients could block the server by sending data to it. - Renamed client option 'server' to 'host', which is more adequate. 'server' is still allowed but deprecated and using it triggers a warning. 0.82 Sun Apr 10, 2005, joern Notes: - First public release. API is fairly stable. Features: - User/password based authentication added. - Full documentation added. - Test suite added which covers all connection types and the most important features. 0.81 Sun Mar 13, 2005, joern Notes: - Still an internal release, incomplete documentation, no test suite. Features: - Support for SSL encryption added using IO::Socket::SSL. - Event loop abstraction. Event::RPC now works with Event and Glib and can be easily extended for other event loop frameworks. Thanks to Rocco Caputo for the suggestion. 0.80 Sun Mar 13, 2005, joern Notes: - A non public release. Only announced on the perl-loop mailing list for the namespace request and to get comments. Module is fully working but API isn't documented yet very well. Security stuff (SSL encryption, some password authentication) is missing also a complete test suite. Event-RPC-1.08/t/0000755000175000017500000000000012601717775012441 5ustar joernjoernEvent-RPC-1.08/t/ssl/0000755000175000017500000000000012601717775013242 5ustar joernjoernEvent-RPC-1.08/t/ssl/ca-wrong.key0000644000175000017500000000635712103173064015464 0ustar joernjoern-----BEGIN RSA PRIVATE KEY----- Proc-Type: 4,ENCRYPTED DEK-Info: DES-EDE3-CBC,21A2C2370C6F85D7 bT+xWdBBvy4uUElXccPZ6fBuI4ozeLcisnPJr2jtSWTv4lhsnzCOPQNCGPOPbKfr 1aMTmFh11vbzjsKVJOTrtVrf3MiBHDa7/bK18F2Hz0pOZUOrCiXbqd+gXx4IAJ6Z 9xSH+a36nic9CReKwODy5dBuZWBp8tBBgnpQ66SgYItHX2hNnEAhPpy/pmwXq6wH YQ0c2M6MzbJPl1H0uwe//CkgSMMTGK21NsSIsSn4vGvHEv9Sm9iuaU6489yWHfRG BWLxNcwGsJwdYbDaQNYEYTcal3EcYEeGme6CLtF28ecK4K0AW/Fje4N1HWnAGUf8 Y73sXbJ1S3T4Tbq+E/UvlTOMW64Ucdo4h1Nvsa+4mbQzXeqOzQHDyNS7m3n8mcJB S8tYl9sw2BjYWo83jrcxWYYw/fKADVaOTWfJ7OK/yJFHyefbJMiXHLplR8keqpRl EZT1b5a6goSUbIamLDShu3CEDAUWIc6PBFNFl8fUt2FXrSUfw8ditOh4V8OCjN98 nQ9T5iIcS5E65QYlAzQr/LdyyWbg7i+de/A6cqkgrSaGFn9lLWq2RE4XYEaF4iJr XX3mAfHD/kxvruaXS9Mlycrti+A1C4Iv6NlCS0N0cr6J/+GX2sPaJuj1rdXHP6QN g9bH038Hy+zb21wr7oM/Yia72BLPfXqCmEavXM/3GGD8DH8xu2KBFINi0dS1tFlx rVhPi41zDFgNXTMVeLE8Wf4/SO037cfv90gqmpSepUv9C2ML+0RHYPEko69EacY2 0wl2oQNF4gCbq5Cc/oZYEtIs0eNz0+9J23xnjUpFqOBl+Zrc/NhLoOuaSwwn9FU9 kChpx6mqaDdYybU0qgvthGlNJVHPZb4xgfc1fxXKS48TWV9AiLoZNOFl3d75RfMr 15+iplTk9kCjNg1G1vD82N6A9rjGwDIrCJPt39Sn8MGOxbIceSKQUAXhw+NT/PMK ai5p9YlAKub7tdu0sCidAzcRzTfLOa+K9R1Br6WsfClzbBtcf5IcLhbBpwhlZRpZ CUdXziLOBql8ZxvL70bglEv1epzTTJFGZXAw+IVS0Pe9a2w4XdF67IxVgaw/OSDR DxjUWhIfXWRxLxsIV0Zi1cvPELvgZGOHMfvbEQMefG8Z1hOB7Y4fF00kTxf6Y3y9 kpo5DrooOqtCmy4B+DbEkBJYBe5gJ/HRDx0uNokXGuqR1CWs4ysWnXWchP0FHE/g dvu7Tqaeq8XEgewTWXXlYV1mQ3inImWnbEp1zPfgxNNrepoYsDuDfQanUeLdJ4NC w3sO8It9pEj3QCnX9CFL3/98Yp9lJZrPQiBbRXVArHbaJZ9xheQ0osVnucHi6BjA rPHoY5HIlq3+UJn6NrSuffSpgOwojgmW2OiRxVVC3sLICgmaT2u3leQKsuj05q0x 7F7TcyzjKyKUtP5XUbo7tNNFhBSElSjxRPoVQsOI/r9TUNu7BSfpN1aLUMJ/ocBX jdKzkQSM0K/AipveNvlhjKZQGs+v2oiv0nlSPrMxcDqbIYZMHkKXSfycstH2WxEu ZdjP5jt4TBtS/VWkwP+vb4VSOjO85TZKzfYsMBfr41rSejIhLVWh03h8osmBAW1K qUA6jU21Nr7la9iTsPe81vjwLqrWmwMtGJBepxUKvFoa5sMHh5kaQxCXqG/YxiUU M2jSwSoXam8IPWLFgVYdotCswZlmQYxMVwv4Nq1PsxzHbic+n7TZ1Lkivz8zh3V2 LyazFty45dEEtlCy9UvO2Y+bIyT0GgP2tCnsyrJn8uJiVl/sm/s0Hb2CxNetyrWW BH7W4kpOoastRISw1cdBhPdWSqsD8PFTuqfQMKW10cd4RfyyLFrZKT5ImN4Eq1tQ HMNx7U2FdJJfA1VHs3YqqBYGbaCL2eBNoBdo53BxnSQEUChHfa4W2u7A73Tm0SB7 RXGTVt3aS9zlVZ6wc4UeQXNKJr+e3/j0H5qrx3z61uT7cobkf3XhxRMPHz78VB5m yOqItOj6iMITkJ74Zhdl2sFBWZnG5f84KC8b72zUD7WpwfYMbaAkRQP3HfmdywtE kYpJC656dpcok+HAihSU0H6jOnvVn526IaKAJUUmi/BbG8wc7R1YoZQHc1S9RRKA WcjEEXt/E/HI3SRyPVKMywws7FsuL/zKkFaBhMSBLcqTnb2E5D8tSeMQtst2q3OO GtoCRBwkzGHoRxjq3Sjishmabm3QbaYVOT6kcsoklLhSAinSicLJoJI3TKKHDEAt H9DX+yApFUgfkziiibotGDpjTA5RtQJv69phgpkLwJiVJqa6mNEgiz1DMr47oKtI OJeMxMLT0xtTvMa3OKNvomBZJbYk2dfsgEwE/Kvmws1FzX68zu58piWLKnVbbZv4 +ibUvdSc7sQIa3iPtfvPN/oNkeKoti2BtLibhCY1G9oZNG/CSa7Lr8jV/st0ze4y vCCCDByWQXCpmobmgS2aa8H8coSCAAqm9Exaq43eabeg79iJxuCe6pHwFKQ2RxdD jcQyTzCINxGX/+d6bc0qDlDcSdU3HQ03jxReXuhE7TdPM6u10OBpHk8chH9pTkPc K+SmBrlQjENT0Ja49VTjNz8A/WgKvjjvF1U6oEF4jWmcQGlYqLewke4FNam4XFvN yytFW/GBQ13v+1uIbX9Ecs2b4LbJKZZYQKpEMiDjqsvwlFPn4ZHTwMz+K4ni1krQ hmxUNb7Vizc6Xwt/lfN8T1hajwCYLxRbsNmwskKCvSITK+tdi9nugXXpXQXHCnOv Kz9yDqH/NXExb3KDuc/mIJOiODWvPsmOGtgqfdCQ9DQJjD62l0IflI+FJjJ72l5n ANepn7604F/50WIry4nzcGU+kKjJ2CS+e8fnIjC9rkBJgUy8lQSGxcqaJjNfztjV tLgv80U/lVpMWoGc9LFU8E5ZMmxZbGGwneVerki9IfM8gP/0FFILVSZqttDqzutv XrobEzk6hOjHkoCrCT4Vdqsj96lvhBC472J6l2x0hLCRoZljLw9umM8zHPYdqSXb KBj3tnLuURfVrnyEWEEhqNI94147LU5p4TGA88BNG0JdaGuzZqyqzo1SKdCUW3kV NJE1gXrVrQmyJRSjWOPTtUK6NenyOdqlqITeBZwRb/3w0WAv4UafbD+Ai83m1APl -----END RSA PRIVATE KEY----- Event-RPC-1.08/t/ssl/ca.crt0000644000175000017500000000373112600020623014315 0ustar joernjoern-----BEGIN CERTIFICATE----- MIIFnzCCA4egAwIBAgIJAPNdDhGTAAn0MA0GCSqGSIb3DQEBDQUAMGYxCzAJBgNV BAYTAkFVMRMwEQYDVQQIDApTb21lLVN0YXRlMSEwHwYDVQQKDBhJbnRlcm5ldCBX aWRnaXRzIFB0eSBMdGQxHzAdBgNVBAMMFkV2ZW50IFJQQyBUZXN0IFJvb3QgQ0Ew HhcNMTUwOTA1MTA0MTUzWhcNMTgwNjI1MTA0MTUzWjBmMQswCQYDVQQGEwJBVTET MBEGA1UECAwKU29tZS1TdGF0ZTEhMB8GA1UECgwYSW50ZXJuZXQgV2lkZ2l0cyBQ dHkgTHRkMR8wHQYDVQQDDBZFdmVudCBSUEMgVGVzdCBSb290IENBMIICIjANBgkq hkiG9w0BAQEFAAOCAg8AMIICCgKCAgEAuZPFP2vuelUYGJXYPnkOgDYGvE72EAVY IGn/A4lsY9JI/u9MiMVLwcB/f6fn5T+1aPeqyGDhXoFMrviLzvoF8A8R0Rdie8L9 0txwi1z9PRUQWSWlq21c5O9zSlglS2iZUlaPSXSCoSkIyW0tszfG6Af8eVzH9WmT 1JILNjuHLY+HGj7MBoVX6E+QdnU+5UGSk0wmcaUAtL0/W/Fb/oyt1LhkdtudWS8o ir9/fxXmCnVX/SkryK7nQ1inZAO6ZOpZDLOO7Y0K/VL7nJS28HAH4iaPhAMsSVSX Oftx3KAVPCf7iPTccAgV0Ja4+F0BTxWx4GfH4SYv/IFHmqPIeKonDqZTnJdgEkC6 5zd+DVlzst3Yms27ZsZDiI86f+qTeSAgGUJnz3eKUAf4R8nZbuDLNieRMh3D3fC2 GpYWandnbJsQcnDVOSabThSuNaVaDka1z0+Ri5CFAXBw4h+zayD99U/UJ22BKpc3 tNOHpNG9A+Ecj5ISMt5ayeSupf3HX5wHaE+oZZeHcs4NQlKOm9o9DToQTtJHXEBq JoRovM8Zl6YKxljoA9Dg3971Euf8Y6A6eE5fLEmndTPh7qTTdl0/ufJALuqWaj7N 8lwY/dK3vjPN7ZmclqvWBQQJCNLJ+XvUDdy0bKP+nnYhl0zgWkBaV54Oj/bRWPW8 eUP2gwnZFDECAwEAAaNQME4wHQYDVR0OBBYEFMF2EmQLZK+iD7YQr9UD+0zkTgt1 MB8GA1UdIwQYMBaAFMF2EmQLZK+iD7YQr9UD+0zkTgt1MAwGA1UdEwQFMAMBAf8w DQYJKoZIhvcNAQENBQADggIBAJWugAeQ1yGmKhMolC5fFzgZstyn0kDKLXwu0fkK wwJqBP4zJh41QZorEF9puQIN5LY7j1bJkPYZjFREB3MhVvWGorSLSFie4SvpzoEs X3EgIYBpX9YSTWoHQbRZ6P9LqNUZkGBHXiwsH6cC4N35sEYgXsE1KuL3PBzN1ufH Y69Pkaa1pzuhjAtZeBZpkzw7nS24zR38dQdWB6s5MHXBN1JSWmjYKYG6wx2lr9f+ 56rpqICFdL6FAEbxiV/FyNMYqadpWPyt54PvmLwxVX/pK9Izzl2TyP6awkfFmQDV Yy6Oav1viVbPFfd76JrqNyIJRSTp+bpMOaI7evQBtqqKLzKrdZc9rY9Jj2ALYLx0 VITORz1eCOUDZ29kV4zxF0xyjCQ92jum7594DLFJFEgrp9kHxaZxntJXtDwIAV3I J/4Waxf/qhCiRboZNXk5g7dQjBnuSwQhOVmIWn/wgpnfO9KOdp35+ipHmjJByOj4 m9Gsfk7NaHg/zZu28svxglb/pZyytpXMvW3h/3+BtgobeIbWBYe0M4tz5khBsJVx 1c0nyohZ6pPmom1H0bzY95dLdYSmGy6BbQBmtlzM3y03+6kVC6qqx/SVYeXhRjpr 3k8RJBDbTxiZIuIFxYwvW7bMC5UVbFDqAIieE2LdbaXJF8D9l+rvLAON3PMtQ/Qp rfO3 -----END CERTIFICATE----- Event-RPC-1.08/t/ssl/server.csr0000644000175000017500000000321712600020623015236 0ustar joernjoern-----BEGIN CERTIFICATE REQUEST----- MIIEnjCCAoYCAQAwWTELMAkGA1UEBhMCQVUxEzARBgNVBAgMClNvbWUtU3RhdGUx ITAfBgNVBAoMGEludGVybmV0IFdpZGdpdHMgUHR5IEx0ZDESMBAGA1UEAwwJbG9j YWxob3N0MIICIjANBgkqhkiG9w0BAQEFAAOCAg8AMIICCgKCAgEAoqZykaTAH0HP 07Cq5JThbjxLuUKTUUkyydiXipr95d7VNAgBEl9LV/hOhUyG1Aiti17CpUBAOqqY WE/gxXZGdkMrZJeOzDVf3X2jwDBQ7JmYu4Z2wolVWic0IVKBQ+bZP4mWNq361wFj CHQOfZbimqCbfTqfBQvuD86x1YwEveXkXRG8cjWLcoiI7EaYIA3uaA6w/Qct+E+m i9RvgpoIj57ShCM/6PqbwWOq7xSWb9goikLszoFdECYVt0nMU1Wlt2WC+IVqMsBL 9Q09/9wmKJKotHa9g9o2Ak3TsNsOdcMjVv/SYbI5H3zgVxpxAzL3oCIAbo6wczIt GRJs0g4AZVoVg6xJGNh/FpimjXoqWAvFZzEZgru5oYgvhEjqUk0dgMiXGcc7N5/R BK2J+7aPBYTmnY9sM8uUKW/s6O4gHGC2jgJG/LDXGBtRA81yDBXxxXe1h71Goszp 7OwzWfMVgudaxiqvaVLKmSlNjqL5ca9e/RIeFHdGZHbwB9OsYu5d/qkSHANwHM16 7zqAesryNgqbOReWZuRsPEn7wMUfWU6K7/FG3TjFNcdmWJxJhv55a1pr6FuF2fe9 UfilwtV+ikEaKLdlcEzyRhSiS+CmoWp6SV856FIw1n/Gn1uxGXSoCrDM8F+aBJAW CM2eTX9C1rrMEjiS4HqbOAtjZ/Ebq9MCAwEAAaAAMA0GCSqGSIb3DQEBDQUAA4IC AQCNF4wUgjyJAGT5SdoCvwxuSf35UU90d5wqKX2HXdB0J95vQR12UVYBSNjA8VQm AMVo0XLCtQkwgIJJritvVa7eevYPJvHnPYlgHhSH+GBKvs3L661v00dYxWN9MQ8h PP9cF5qy0XUsGi75oO7dmhW2cHgLJfIiIZCYjOYdL9TTKsocEcXjR/sTB9IUowQU OG21E+nlNQewS5ErPUcSKeGQIDI9QISCW6lYUIV2FZE+7W5nBzhU0FegVRodgssA 2MqQNqviXtO7+9kPGEifvTTDau4exXJparWNXp66y30+wx/rLWmu6H0klce5teKq mFUqWNyD2rUjUcGQTU9h422QWHiGmt3+3AT6nwNPxzXTxtSijZ70z0+18JRROvfp 5jz2EclII1MQLWBIyAM8EZ3wPZ/VQZ76X+zTpRLXrdWJ0YD2m4x6V14AS+7Fw6wF hKQz2wpxGVDGUUs8Azo0XORGcDX81Wpy3AUzCvcHB36f/MbEHiqb/4Z6GT0tAAKS 5NrvenrbujNy3TXGAcEnJy48Q6GzNhGJOG7AZpcSH2PozWeGzwxDFqlOjPahLuSj 92oiRuGaSo74T+zFNHxBP54RLKlY4cwPcCCYomlCI49Ax30WniJ2tG87UiYp7OQn NtvxZEyP+0+1ONyTHyeaks0NCGjuvGCWKvVvPhwWh4ybsw== -----END CERTIFICATE REQUEST----- Event-RPC-1.08/t/ssl/ca-wrong.crt0000644000175000017500000000357712103173064015465 0ustar joernjoern-----BEGIN CERTIFICATE----- MIIFXTCCA0WgAwIBAgIJAI9WA2Q/HOzoMA0GCSqGSIb3DQEBBQUAMEUxCzAJBgNV BAYTAkFVMRMwEQYDVQQIDApTb21lLVN0YXRlMSEwHwYDVQQKDBhJbnRlcm5ldCBX aWRnaXRzIFB0eSBMdGQwHhcNMTMwMjAyMDkyMTUxWhcNMjMwMTMxMDkyMTUxWjBF MQswCQYDVQQGEwJBVTETMBEGA1UECAwKU29tZS1TdGF0ZTEhMB8GA1UECgwYSW50 ZXJuZXQgV2lkZ2l0cyBQdHkgTHRkMIICIjANBgkqhkiG9w0BAQEFAAOCAg8AMIIC CgKCAgEApbYWTWNk0rRfdvFqsw/LpBj1e8D8csoMiSTsCEPOLz/8U9dustjjgxsT eS8uSwHCzLH/TeDSuE2Iuk26HH885EXNc/OXsIu+j2HetqcOv+DOAalqeEfWfG0e llud3Y955aiJ4ME0TFhByOPPEgz5rMuj08/3NSyEXAkrvGiFGiN+fQLryZ3opH07 EuH4x/yFEbdQd+9/zP5EwNfmIHYfBhLWHWOR7T9zKo71iWogeNfJzcc+VpVRXE1L 0DAIX/+vbksd+dnewKmT7g4HcurS0lLMM97d45kiZSY6bfxwELAwXO9NY26SK6Ig H3ZFMeNVeigaQ0gwK5JNk0hEVadB6qzI3PMT8/bTVGxH+1WxDczB2sUs561Q3vhn B+Ny1GjEVf4H+fAJBwQyQbzNlGOxYLwh2ZcSmUEHEUVqwgD8VvYpMvK1ZVmU81BP XsvlDfFP1WHyCOUcdHoZMr7NY771LU0B/IRn2fnhWvffMYYo8xlZt4UJmHf1khNo O+NvFnrv8jduIPlacXVPq95OnYGIoLtAbvj8QIcehJ9dgbniYB+OJ0ShiPzRg2dL u6qe5sBQF9jyAJFWHU8L31DKAfhP42Bi37e76rr6oIDYdZTzrhMc3RUZmaJN28a3 ycpjUGuFFwHw7nFZbD+pSZlDHFVRN8k2I1S/7AOU58qpdbjMog8CAwEAAaNQME4w HQYDVR0OBBYEFIJtnPxMc/mDhofSA0rJZV3MNBfSMB8GA1UdIwQYMBaAFIJtnPxM c/mDhofSA0rJZV3MNBfSMAwGA1UdEwQFMAMBAf8wDQYJKoZIhvcNAQEFBQADggIB AAMnareCgJqE11dXTULm+TEkzCp8czWc2QK4w8Qsn1EximpNdvxUDKwqcFW3YxJu CVSJV52ma+HJ/gmCPiZgZAYpzDCdL7+2aWy81OiRZZ257RoMCZvbQ3JJcF0o4D24 skL5Ez6zSlkq4gbJpO4jBahtbAzsGji+VjSR2S1W8wTVJIPY8ifRtvp3tpIMTJQs mfPI+2+pjt9NRulS4G19jpc/cGr8C1MLoRVv/SjYWy5C65OVohkgf16UYR5aoOF3 MF04biyoVPbFE53/Q5I7stE3QYOm1rCd16lKAJh6efaEtG1YTHqvNX7DPvRp1Lrn Cm4HduwgI3dqeI1K4UxO0JyASWIuf2MWD++bn1ESWpQzQIdm3YE7j5NCfUPzHXPj PcZtIwZRmPN3mxP95Tl1VDnBegCrV8ViVh+ttlUBP6R6CxKBSBKQowDwt9IRmPnZ mQZgGhleyla+lgAp6xmJ5L9l14hEPE0lalW7l8ZVylL49oCBvMthxX2ATuVvteKV HZCTc9N3QOi0k9LVR07rb9nEKxybDLlGGAFdd4gYOIs5sVbYHpdvazzcdOO9ZcEg wTLjqDlJ5eTjsJcUxlB9pk/vEUddqYuGHJUln5RFtEtnqqYFvOdWgy6fOVDiX73A QNE4X8gvgg4RJ4zFkFyuhystX8tLx5sg1BuMfsimw6KL -----END CERTIFICATE----- Event-RPC-1.08/t/ssl/ca.key0000644000175000017500000000637612600020623014325 0ustar joernjoern-----BEGIN RSA PRIVATE KEY----- Proc-Type: 4,ENCRYPTED DEK-Info: AES-256-CBC,A048B0CBE0F2D36A9628AB62487BE247 m4C70p1nN+3oBBQvJxSzLvjZytEyXruSXboGsFPZBZL9CEg4WrORrtLnKMSOY0VV H29OJWG+KJGsrYBC5bnZWiT4zD6Xn1SG4IYToHTYCISiDINr4uqzHQmw76rBdOj6 MQYY0VIwe/eJ56zuH+dLtf1ZK2I6G2U2r9J/+Pf6QRZ2RjW/FdnomuRK+oifDB00 NEkDJqq6s2nhlGoPLJLNRkt8LdSe3Y7cng6nfGNne6RNTW4Sx7ZdiYdFmw0bBMPa UMnBBCRheI80nnXDaB76//BzwTTDZoThHH7KvynDz7NiZbvWEJdi9JBjYiNGhk4d /4ec8T9q63P7YkG3XjF/KqVC43Q7xem1pMYhn83gbl0wMR9aWU3T/JPC1IESZYCN CjM1OTX1ctLmTXHP5MmnMNmAHUtZhHwymOJpqnvOSNVeVDBVXoP2REJU3be1zlRo Ru2wDe5IEB/t9wy0N5DTQPUaC28Lce7cmjrs+fVj90tGShZKXniqrsG4cT0/3sMT iXPU7fILFHn1vEkLyvHdv0yDDYt+a34ony80oNhmrjl48xBruMylso39Gqf+1LKN KFLWLAiQPQHmM4/yNCnSMqZSoX439O6k/BU3qmnNI4B1+TU0CWMNIZjWXLfw0GLp 3y2/cAS3jbECATffWGUeRWHzMhuRqXhI4oWVpkuAlx2vK/uD+/7/Rn4y6bX46okJ TOcOaOvQN7UhdTcItFi14662EJbWaZprhBMegZWBqegoAL7x7mUOZIY+Bj3+MCuI pUshz7v5L54HipvusH8JjilXxOjZcrLpcbiUwQjqSWC4XLBD0JgxzQPMbzBhK7LO twxtuSO1+dgZVvIkFbAhLR/p0a/DZmLf/+yIEd7auZETIdR6qabF1LvnXiUfnxRt LFcXCfbUR9OXNv/F0aHRFS76W3kooiO5fl8IMekPro3OdtBvtFox/jg/DOg8CFgL avXW2BCytQgWn7USTJpaddjP8z3VSZpO1uGquaRlXpMbYn60HkeoEbpqhYfLdYQX 24eM5ggvcErUc3cLj6gYZXEEESvbqPa0FnqIutMD6jh4APZ1cS8zRsQatirNcAEc ubmq6wlddTdzDfMC63RyM7lieaAN8VpCTdFAA/QxXmvpY4KW8U2iFThUKpCyD6x+ ay0lXj+D+/HkCd/w7T+Ze8y9enLaGk8MJmLLuM0ENc86VRHKqUbEmI93t9ffW2RQ oMLIs440unZzRm2pi/POO6/wA1Zfe/9Xd+q5wBWKYwtH4Qzc7gucm3IjycHs/hKB X75riNHTa1ZZBS8//usrOaeugPSmQzfJfq031DJkUEbHdroYzhxrv2WveXq1+2dz cz6smPEH7VI9U5f9tleULSE82TWOnQhWpFvZEHjvuXX8z4Zti/HsWxj1NGHE0z7p 5YOb4EpqNYvzJ7lAQKibXVQ77+QAb2yjW81TaQkoK9gbEA9JZU2DGlfvRVd80Xtj 43kTxaxN9PZfNq3ctn4ihNCp0rRdCTkZn8KEBsoDrKrc4iHANK9/AWr3aVfbYuti SBtFYDJuwQ7lcJjyG1ICPZSGAxmct66h2GLRAODI4YA9b3+2CGmAYHV6dOdQI5D7 b6HcW9TvgE9e+gxFoTN8hX4ods3pDfmLWs5DDE97Tnk9a/o96B/Pxson0vvvpHzy 7stVty6m6+YJ5Y75OD9JDOpTW7ZLuQroFBSjyJxqX9s5JVc5oRwkxe9nTIgbKL75 bvVV4GQq8jsIzYFYSk73ZLp3z69EexLaszN0Ap1p2sDNasNqrXPoYFbMkLXTHDa0 OXd/l2kZZVrg1Psl3qabPW23LilVsOGxUxxR8z+k2MKeQ3QWdp0rJK43aZIJr9QA cj+eJwWjkgvfh5xeVzF4d9NcWxbrj0qzOVrFri3iRmifea33AKnhxfRACzi9nCVi mrY2RVzI3XJ6igcTI8uvuxoG2Xfz7EV0wJiFhdWVDqXEbb10x+kIKV2UyfhYCHCd xHn3TvXlEPP24Nd7fXMrJkk86veEXB7k7SR8mgQ/B2CX5uvkPD9j/4ZtxsZCu2+Y NuMczs1kKLlcczvuli7eHvRXCEBTZ66ifd68KvGy2F9XA/PdrqghpZHhYLMthwgm p3/ptnpK6+5ZmoVYoxBWeDxYWr0vdZS1in/PHv0mbw1qgb8A3+hNwWdJ3gYs5vwJ XNW5KT4RehC68X6anxYYcb+4kdVAuT+jlmZvNKSgFGyyqFHyakkFzKQZxYGc/+IC L3yaB8fHRRB6s2tUWfcndZtm39KI061ScZdHwCQmRxsUtLR06/NolIKPQjgEIAjR NQmvMblk+OT+VX01Is4l4ykZccBO8y9N6F6LwO6lAxS8m5wrwv/vY6m1sQWAKYns 2s3o2aO3YOJ//ItzOsDO47YL56+VwxuEWKxfZDYVFl0O0EokjdvDMTDO40OAeIKH 2EtkErPRPk50ztibzvMT7q9GBADClQJwQvHdGLeRV6Wti/ffpsx9ERTao18w9t+N JB+osPu7HC6Jb9YfYYb6nyO6B9me8DZlcJ4ZH+oxoOi1F6s0U5woWzmHHiwR+mtE +tUNXYvYL/BBG+EU85ysmnXp0tlseq3yLTQC23ljEHQ7l+X9ffz6haBz2sRInH2a X9NlyfZ8i+HUBnU8FzkvM7xTJWEp6VQOTOcrfW0nEZ12LtyXGssVzZAjM/7pYg5F r78DBxhPe8+oesTO7hWdn6W/Um4rKcoGkyK8MqB/21KVFSNuSNXVpV9h4RKMw2K4 5dl8gO+TdGq7lNMgK6fmvR6TaCUgJAsXZABV/y2XxR80cjLcYr8l9JQ3DOg91KwP FVomKB94x8worhzUGs/FnsXB31w3en0A/5WyQIkWuGowdx+qOHAYgqq11hKyvMUt k9HPXw6s6E1ZNxteRdQCkCOOtd00+h/VuFPNCGCt8t38AwwBQzKaNNYFdz188ldO +CQBk5kogsvpuCCGmIqsHV0FIVOHlBzqaLS8O9BhgionulHfciaiujk6xlE6uARk 5bFQJPVp/CC97zk5m/JIDxieeKPbQ7PRZAZFEZFkktmiGmyx/nt2/7xOm2dwJ7tC pTFrqHo6lIiCnusYNsqGkoNNVVBOFIKvR5nzMSOl+jMjin/Q3kHb37ewuTyrKJse -----END RSA PRIVATE KEY----- Event-RPC-1.08/t/ssl/server.key0000644000175000017500000000625312600020623015242 0ustar joernjoern-----BEGIN RSA PRIVATE KEY----- MIIJKAIBAAKCAgEAoqZykaTAH0HP07Cq5JThbjxLuUKTUUkyydiXipr95d7VNAgB El9LV/hOhUyG1Aiti17CpUBAOqqYWE/gxXZGdkMrZJeOzDVf3X2jwDBQ7JmYu4Z2 wolVWic0IVKBQ+bZP4mWNq361wFjCHQOfZbimqCbfTqfBQvuD86x1YwEveXkXRG8 cjWLcoiI7EaYIA3uaA6w/Qct+E+mi9RvgpoIj57ShCM/6PqbwWOq7xSWb9goikLs zoFdECYVt0nMU1Wlt2WC+IVqMsBL9Q09/9wmKJKotHa9g9o2Ak3TsNsOdcMjVv/S YbI5H3zgVxpxAzL3oCIAbo6wczItGRJs0g4AZVoVg6xJGNh/FpimjXoqWAvFZzEZ gru5oYgvhEjqUk0dgMiXGcc7N5/RBK2J+7aPBYTmnY9sM8uUKW/s6O4gHGC2jgJG /LDXGBtRA81yDBXxxXe1h71Goszp7OwzWfMVgudaxiqvaVLKmSlNjqL5ca9e/RIe FHdGZHbwB9OsYu5d/qkSHANwHM167zqAesryNgqbOReWZuRsPEn7wMUfWU6K7/FG 3TjFNcdmWJxJhv55a1pr6FuF2fe9UfilwtV+ikEaKLdlcEzyRhSiS+CmoWp6SV85 6FIw1n/Gn1uxGXSoCrDM8F+aBJAWCM2eTX9C1rrMEjiS4HqbOAtjZ/Ebq9MCAwEA AQKCAgAcTXJqPYzg44bSg095bx67G+rhVeBkqKQZ04KrL8U2lsvqvenR1Js7t42S THq5srjgI6EjOEb07nKMC3pFYgto0M9gNa83gaIo3I/+BWpPgXq+RuurdlJP2bqM gdrUgfsTv1FQOn4Ho8oj0m4jFHpiBciIxgadzjGitojja/X3RWWzfD6acQ7O40tQ MgiOq13s5YGOxg0NxG5qrpCo3TzYIP7o12lrlRA9WqaH68ExvR9wz6x9Uq1q/fWR a1oOtjyb6SIdNLoCEswk3CUJvLk3Hi4VGQRpSTNUu0423Cdr/oTLwsBNF8Iw5H31 Kji4IcpNJx2EH3g802JdloMxGhafRUVEEqxp+BtXSrLKoIgjjduATitj46x4+GXK Q7RcCs6ZFxjszsp7QQ7bYI+5SMIiEqQca87bQEPT/7Ym3zQ4W75ksm1rTPKuMM7H yNNGObgqNhyCoR50ijiYStVT0wOiwlMyxeqkZWKvEwWNWrx9Nl1TAkTVFAmX+MQF xFMmfdohbbDR0Q1kyvqVEZu0w6spzyzsD6eYw5G8DtUWqI9Y0cQ+WnE0QYWuEP/Y Grsqhob9j3iRxxPrNtb8CnfVH9+S6mH7JN5ZJJE0Bl5MDpV947QJ8/x8zuWqcrPG Ajit2RAZ14/Ht+V51gN+2EaqRJglL3BIEqkxFz/Q8Ht3fnQLoQKCAQEAzWmxkyfH owkpJjyOUsZ6Gb4+GM+sDYhBQm+Dzi2d48N0qp2sQNAa3KqQzDMxP9yNyV6kHm/l UXR7+gYwmbPTaRlzyIiBJ0/krQdP8zaWGP8SW2tSz2887l2rNB0qfmeF6qKfJA94 qrRSjhfI7in9Uj+ryJ9Yr5e3aWRuGROKTIV9vn56JYg1RFNfwK6UYM3BFy3+oAaK NfIIKf89dcGaHYmzbjNSDMXfgfaypJo33isWCzD4Oi1zFvd6p7dxf9tieAgD6xGZ a9O7yL8KC1OFg1GQraK1QOsWquRB/eZ2OV3Z9qYKFh7daY2fvqSSx3j/+pcve0bd IQCLP8rWu7HuVQKCAQEAyrTFFFw1AIsK2m/7qsj41qmMMFwcM4cGMMQpkjQ5l+Uj mtTLXX0dZrSs0nQcnQ1GVDhZV5chgqy8jl3RQwYFQ5tL89ZrJElxT0mZdlBQbqmF Fdp80RVRYZ7JlryxG/np0TcvWgLAE/L6EHc5FXniBt0y8jhCuC2NqYQXQHU5lhGg y/8gKeN2kVb4WZEbIx4jXcUnJgmcrYX5kTCPNyq2otar+YX4HpMlRhyQoPYJrZsx sjliLOP6hpI8Nf7wRltZILBTKD35eVsMJZVxImwPkxHJfATopJE8L8tzlxvmFpxJ KI+dSuQVBhZxmA48IFfZ/iGAWZkmoPglM3o3u04JhwKCAQEAp+4CmHVrBmSU2Yek KxPL+oPHLG2LET0VbQTR0psEe5HtLRbeHdaEP2bKHca0OqtK1xeiQKfl5+O8/zhU PzP+X+vI9mZyf/sWzkYuHH3B1Amjrk1dU+xy+cRmFKLLfK+RkbMFO2vSkGv/Gd9k CyEU0krvW4K59EOqVGUghSuuYsS3eibYIRrrwUIQA+w1rbZIZ3TYt2bhUxzdg8gB LOXr4r4SjMM0DvEtuog+n8bcaar7yIZuSNGjR2FnSvnztj1akRqsaV7n+HkPChz0 TzIm8qaaCvn8CGipDWiycqoYeOm7KaOwl0kAZiy8LhVJUf4f93PmA3h5i2Nwc+SW DLh4SQKCAQAxCiCvt0r/UaQTion5HFvPGv+WZ4JPGPhvbdWc0FOqor3FZHu6p10o jsdMttiBSkfccjFzFlX+FiobyyioLVmyrGxollQfWEE4bFbbH70FuK9AxTXzI1Qn 6NFeTVIPsZtWiSJEhWvQp7TFrQI7Ztw+yt7baK8DfcnK2/EAIBwJaURcdeFjIOt7 Z+33RTqqeU0XD25ULnkgJcxlyrirIQNES+kZGccYJoMa/igjOMLIpEYWlvlgYNso GVLFwWKBsvHSDbZggvXK3TMIGKphKIFwFBqJjWp2/cfwzCivwwkcKT0tuejUyG8p pN5gafkz3e0YJSS3CG0m/kGJvaSkBNIbAoIBAFGONGZlHYV7KWI7tHTr7o/r4oHd 3SkwGUIvgYqa9JMVzfrR3D+iPKViuwzb7HTcidjvhcPnusggDq5F7uGyudTQGbMJ h0XV1HppT2WBSOaoUBkAgF0ZVElz2vEKF3UjZPAk0N1g4KIqNl688mDBDgoZKqJM fDZcDg+uSSRzNIBZBDsJAHUyHHaZTYAMoWS2pIlypILadzD/aBXismu6z73b3ihh MMvcrrYyN1dfqzFnvxS4aCyna3CNcwK3jAZPqI+sI7jWaTKMhhiI6UqJTBZ7m96f bHh08lIA1pFOnG9ShdM9O6deMBtcpVj8vIVPloBRcURAlg4oguLuAV90TGQ= -----END RSA PRIVATE KEY----- Event-RPC-1.08/t/ssl/server-noca.crt0000644000175000017500000000367012600020623016160 0ustar joernjoern-----BEGIN CERTIFICATE----- MIIFhTCCA22gAwIBAgIJAKmxTeiZx+BiMA0GCSqGSIb3DQEBCwUAMFkxCzAJBgNV BAYTAkFVMRMwEQYDVQQIDApTb21lLVN0YXRlMSEwHwYDVQQKDBhJbnRlcm5ldCBX aWRnaXRzIFB0eSBMdGQxEjAQBgNVBAMMCWxvY2FsaG9zdDAeFw0xNTA5MjAwOTI1 MjJaFw0yNTA5MTcwOTI1MjJaMFkxCzAJBgNVBAYTAkFVMRMwEQYDVQQIDApTb21l LVN0YXRlMSEwHwYDVQQKDBhJbnRlcm5ldCBXaWRnaXRzIFB0eSBMdGQxEjAQBgNV BAMMCWxvY2FsaG9zdDCCAiIwDQYJKoZIhvcNAQEBBQADggIPADCCAgoCggIBAKKm cpGkwB9Bz9OwquSU4W48S7lCk1FJMsnYl4qa/eXe1TQIARJfS1f4ToVMhtQIrYte wqVAQDqqmFhP4MV2RnZDK2SXjsw1X919o8AwUOyZmLuGdsKJVVonNCFSgUPm2T+J ljat+tcBYwh0Dn2W4pqgm306nwUL7g/OsdWMBL3l5F0RvHI1i3KIiOxGmCAN7mgO sP0HLfhPpovUb4KaCI+e0oQjP+j6m8Fjqu8Ulm/YKIpC7M6BXRAmFbdJzFNVpbdl gviFajLAS/UNPf/cJiiSqLR2vYPaNgJN07DbDnXDI1b/0mGyOR984FcacQMy96Ai AG6OsHMyLRkSbNIOAGVaFYOsSRjYfxaYpo16KlgLxWcxGYK7uaGIL4RI6lJNHYDI lxnHOzef0QStifu2jwWE5p2PbDPLlClv7OjuIBxgto4CRvyw1xgbUQPNcgwV8cV3 tYe9RqLM6ezsM1nzFYLnWsYqr2lSypkpTY6i+XGvXv0SHhR3RmR28AfTrGLuXf6p EhwDcBzNeu86gHrK8jYKmzkXlmbkbDxJ+8DFH1lOiu/xRt04xTXHZlicSYb+eWta a+hbhdn3vVH4pcLVfopBGii3ZXBM8kYUokvgpqFqeklfOehSMNZ/xp9bsRl0qAqw zPBfmgSQFgjNnk1/Qta6zBI4kuB6mzgLY2fxG6vTAgMBAAGjUDBOMB0GA1UdDgQW BBQyT81ZMdYm6fHbdTVnqxDN/ZH7UTAfBgNVHSMEGDAWgBQyT81ZMdYm6fHbdTVn qxDN/ZH7UTAMBgNVHRMEBTADAQH/MA0GCSqGSIb3DQEBCwUAA4ICAQB7btgyxdqY Vq9VTbILiJ6AAtJWnfsi0JpmXBd+Xra60BsGo2W3Q2KQGpA3ga8Dk5TwwjEl1cEm 1Sndj+cnEml445gZvJX+eJJI3HfL0gJSq1RGHvCj9HXzVWVpmoT0189thUogOtrA 1ZFgCvfPeYBlNm5chhmJh4Zlq7ASc6EOL4gzXYyjD0JXorlpm0Q/k+ZCK6uBD9Ko YMX3KdBvtJTYPzkCIiOpvR5xEVtrbpj6cBV+gwV5J81xcU4op/MsTEuRUW59U5As 3edjh15a4Z1TLaewC3LYQk+jqz8D8k9P5y6iFgfV3vrtJ2wP1ZugiuSTKgqd2z6q ee61xcCDJY/l5KLEL5LM9acawb7EHz2EKl8lOuhH0cTgxjVGRwMReudqQMiLgjeE aQPwgUt5VDsJMnNFxzhbV9cPSmhrRTJlCarE1IB5OXxMz4hYnAuOQ8PY9kCfofXv aK/nEICnLKTguPtxwVzV3M8uayDGow0Nj1Ng8DQcU1IHCkExyvwhBAzNTTwFwD8A HdVEZ26VIJ+g66o0vrpgL6U2mPfdot5KPj7b/ipWbLgOo5RaY0PndbAK4M90eshF pFoD9KTfe7znNROi0d+uYFSj7FEcu5+lQJmOXajuZTjWTGpRVJGq90zPzHezfD8o lI/XAyAfhJwOGc4TpejeKyOLbaBHWEzLKg== -----END CERTIFICATE----- Event-RPC-1.08/t/ssl/server.crt0000644000175000017500000000352212600020623015236 0ustar joernjoern-----BEGIN CERTIFICATE----- MIIFOzCCAyMCCQCzixMqiJiXQjANBgkqhkiG9w0BAQ0FADBmMQswCQYDVQQGEwJB VTETMBEGA1UECAwKU29tZS1TdGF0ZTEhMB8GA1UECgwYSW50ZXJuZXQgV2lkZ2l0 cyBQdHkgTHRkMR8wHQYDVQQDDBZFdmVudCBSUEMgVGVzdCBSb290IENBMB4XDTE1 MDkwNTEwNDUwMFoXDTQyMDcwNTEwNDUwMFowWTELMAkGA1UEBhMCQVUxEzARBgNV BAgMClNvbWUtU3RhdGUxITAfBgNVBAoMGEludGVybmV0IFdpZGdpdHMgUHR5IEx0 ZDESMBAGA1UEAwwJbG9jYWxob3N0MIICIjANBgkqhkiG9w0BAQEFAAOCAg8AMIIC CgKCAgEAoqZykaTAH0HP07Cq5JThbjxLuUKTUUkyydiXipr95d7VNAgBEl9LV/hO hUyG1Aiti17CpUBAOqqYWE/gxXZGdkMrZJeOzDVf3X2jwDBQ7JmYu4Z2wolVWic0 IVKBQ+bZP4mWNq361wFjCHQOfZbimqCbfTqfBQvuD86x1YwEveXkXRG8cjWLcoiI 7EaYIA3uaA6w/Qct+E+mi9RvgpoIj57ShCM/6PqbwWOq7xSWb9goikLszoFdECYV t0nMU1Wlt2WC+IVqMsBL9Q09/9wmKJKotHa9g9o2Ak3TsNsOdcMjVv/SYbI5H3zg VxpxAzL3oCIAbo6wczItGRJs0g4AZVoVg6xJGNh/FpimjXoqWAvFZzEZgru5oYgv hEjqUk0dgMiXGcc7N5/RBK2J+7aPBYTmnY9sM8uUKW/s6O4gHGC2jgJG/LDXGBtR A81yDBXxxXe1h71Goszp7OwzWfMVgudaxiqvaVLKmSlNjqL5ca9e/RIeFHdGZHbw B9OsYu5d/qkSHANwHM167zqAesryNgqbOReWZuRsPEn7wMUfWU6K7/FG3TjFNcdm WJxJhv55a1pr6FuF2fe9UfilwtV+ikEaKLdlcEzyRhSiS+CmoWp6SV856FIw1n/G n1uxGXSoCrDM8F+aBJAWCM2eTX9C1rrMEjiS4HqbOAtjZ/Ebq9MCAwEAATANBgkq hkiG9w0BAQ0FAAOCAgEAiklnYMOCigfKDLG3gm21Kk8k9J5LJ5xkVxg9OqVuvRd6 OSzKmI5IcHafVWL0jYfEzRF7SLqdSfynTYZKxR9urHDl/JB3Flv79u4xO8iP5OH9 BdanUwx25s7zEhrqjSZVSiqggr5tDEpCC0HtbgYtIyfM8A2vS4YN1iPHBBWeUWdB nofyrz8B/1UcVgjItaRD7t9OFoMlhJ0f0qyqzd5Oxozalww0v6k1lfjbZHqQgtc6 9IrpEPxCB5qmXpeSljwhAYL9zDw6H+h7aaybC0Md4Mbutj4ADkNGx1otgwSGh9ue gNtunD8eayatcEykFtStgfVvCxMO2ul21TM/z5iSb3H25AZwJos+PpPm+I4R92D+ lIUofI4SsrP8FdHcFPKMraT8GCfYOeLQlpQXz8KyvL/47rGnV0hXiPXSlTQ2/A3R 5TaBS8TkX3Y/9q+K11RXvtR1R2F2qGggey/wCXkrKhiQX+7mIygrnnxTuhIjeuCR gT4NwpFNWF5m/VN6DyuMptapKCJ+VBvCCvGpmvJY76DuxlWTOx1CHV0GDqjh3hJZ zIGFoiY2z9OVzmS2ux1Nt0KJ6upKSSEwPK1kRtiH0Rr2bt3aYCjQ9IA+7rIRe2sw U1UpoJVniDgf1BTtaQjOiOOK5pJo0rSnveMZs6dScNu3isWwc4bUqcUd298Tj9M= -----END CERTIFICATE----- Event-RPC-1.08/t/Event_RPC_Test.pm0000644000175000017500000000626312601717663015566 0ustar joernjoern#----------------------------------------------------------------------- # Copyright (C) 2005-2015 by Jörn Reder . # All Rights Reserved. See file COPYRIGHT for details. # # This module is part of Event::RPC, which is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. #----------------------------------------------------------------------- package Event_RPC_Test; use Event_RPC_Test2; use strict; use utf8; sub get_data { shift->{data} } sub get_object2 { shift->{object2} } sub set_data { shift->{data} = $_[1] } sub set_object2 { shift->{object2} = $_[1] } sub new { my $class = shift; my %par = @_; my ($data) = $par{'data'}; my $self = bless { data => $data, object2 => Event_RPC_Test2->new("foo"), }, $class; return $self; } my $SINGLETON; sub singleton { my $class = shift; return $SINGLETON if $SINGLETON; return $SINGLETON = $class->new(data => "singleton"), } sub hello { my $self = shift; return "I hold this data: '".$self->get_data."'"; } sub quit { my $self = shift; my $rpc_server = Event::RPC::Server->instance; $rpc_server->get_loop->add_timer ( after => 1, cb => sub { $rpc_server->stop }, ); return "Server stops in one second"; } sub clone { my $self = shift; my $clone = (ref $self)->new ( data => $self->get_data ); return $clone; } sub multi { my $self = shift; my ($num) = @_; my (@list, %hash); while ($num) { push @list, $hash{$num} = (ref $self)->new ( data => $num ); --$num; } return (\@list, \%hash); } sub echo { my $self = shift; my (@params) = @_; return @params; } sub get_cid { my $self = shift; my $connection = Event::RPC::Server->instance->get_active_connection; my $cid = $connection->get_cid; return $cid; } sub get_object_cnt { my $self = shift; my $connection = Event::RPC::Server->instance->get_active_connection; my $client_oids = $connection->get_client_oids; my $cnt = keys %{$client_oids}; return $cnt; } sub get_undef_object { return undef; } sub new_object2 { my $class = shift; my ($data) = @_; return Event_RPC_Test2->new($data); } sub get_big_data_struct { my @records; for (0..100) { push @records, { a => 123, b => 456789, c => "ABCD ABCD ABCD ABCD ABCD ABCD ABCD ABCD\n", d => ("ABCD ABCD ABCD ABCD ABCD ABCD ABCD ABCD\n" x 20), e => ("ABCD ABCD ABCD ABCD ABCD ABCD ABCD ABCD\n" x 20), f => ("ABCD ABCD ABCD ABCD ABCD ABCD ABCD ABCD\n" x 50), g => ("ABCD ABCD ABCD ABCD ABCD ABCD ABCD ABCD\n" x 50), x => $_, h => { a => 123, b => 456789, c => "ABCD ABCD ABCD ABCD ABCD ABCD ABCD ABCD\n", d => ("ABCD ABCD ABCD ABCD ABCD ABCD ABCD ABCD\n" x 20), e => ("ABCD ABCD ABCD ABCD ABCD ABCD ABCD ABCD\n" x 20), f => ("ABCD ABCD ABCD ABCD ABCD ABCD ABCD ABCD\n" x 50), g => ("ABCD ABCD ABCD ABCD ABCD ABCD ABCD ABCD\n" x 50), x => $_, }, }; } return \@records; } 1; Event-RPC-1.08/t/02.cnct.t0000644000175000017500000000221712601524535013765 0ustar joernjoernuse strict; use utf8; use Test::More; my $depend_modules = 0; eval { require EV }; eval { require AnyEvent } && ++$depend_modules; eval { require Event } && ++$depend_modules; eval { require Glib } && ++$depend_modules; if ( not $depend_modules ) { plan skip_all => "Neither AnyEvent, Event nor Glib installed"; } plan tests => 5; require "t/Event_RPC_Test_Server.pm"; my $PORT = Event_RPC_Test_Server->port; # load client class use_ok('Event::RPC::Client'); # start server in background, without logging Event_RPC_Test_Server->start_server ( p => $PORT, S => 1, L => $ENV{EVENT_RPC_LOOP}, ); # create client instance my $client = Event::RPC::Client->new ( host => "localhost", port => $PORT, ); # connect to server $client->connect; ok(1, "connected"); # create instance of test class over RPC my $object = Event_RPC_Test->new ( data => "Some test data. " x 6 ); ok ((ref $object)=~/Event_RPC_Test/, "object created via RPC"); # disconnect client (this will also stop the server, # because we started it with the -S option) ok ($client->disconnect, "client disconnected"); # wait on server to quit wait; ok (1, "stop server"); Event-RPC-1.08/t/07.maxpacket.t0000644000175000017500000000256612601524535015027 0ustar joernjoernuse strict; use utf8; use Test::More; my $depend_modules = 0; eval { require EV }; eval { require AnyEvent } && ++$depend_modules; eval { require Event } && ++$depend_modules; eval { require Glib } && ++$depend_modules; if ( not $depend_modules ) { plan skip_all => "Neither AnyEvent, Event nor Glib installed"; } plan tests => 9; require "t/Event_RPC_Test_Server.pm"; my $PORT = Event_RPC_Test_Server->port; # load client class use_ok('Event::RPC::Client'); # start server in background, without logging Event_RPC_Test_Server->start_server ( p => $PORT, S => 1, L => $ENV{EVENT_RPC_LOOP}, M => 1024, ); # create client instance my $client = Event::RPC::Client->new ( host => "localhost", port => $PORT, ); # connect to server $client->connect; ok(1, "connected"); ok($client->set_max_packet_size(1024) == 1024, "Client->set_max_packet_size"); ok($client->get_max_packet_size == 1024, "Client->get_max_packet_size"); my $data = "Some test data. " x 6; my $object = Event_RPC_Test->new ( data => $data ); ok ((ref $object)=~/Event_RPC_Test/, "object created via RPC"); eval { $object->get_big_data_struct }; ok ($@ =~ /exceeds/, "packet too big: $@"); eval { $object->get_cid }; ok ($@ eq '', "packet small enough"); # disconnect client ok ($client->disconnect, "client disconnected"); # wait on server to quit wait; ok (1, "server stopped"); Event-RPC-1.08/t/04.cnct-auth-ssl-verifypeer.t0000644000175000017500000000313512601524535017703 0ustar joernjoernuse strict; use utf8; use Test::More; my $depend_modules = 0; eval { require EV }; eval { require AnyEvent } && ++$depend_modules; eval { require Event } && ++$depend_modules; eval { require Glib } && ++$depend_modules; if ( not $depend_modules ) { plan skip_all => "Neither AnyEvent, Event nor Glib installed"; } eval { require IO::Socket::SSL }; if ( $@ ) { plan skip_all => "IO::Socket::SSL required"; } plan tests => 6; require "t/Event_RPC_Test_Server.pm"; my $PORT = Event_RPC_Test_Server->port; my $AUTH_USER = "foo"; my $AUTH_PASS = "bar"; # load client class use_ok('Event::RPC::Client'); # start server in background, without logging Event_RPC_Test_Server->start_server ( p => $PORT, a => "$AUTH_USER:$AUTH_PASS", s => 1, S => 1, L => $ENV{EVENT_RPC_LOOP}, ); # create client instance my $client = Event::RPC::Client->new ( host => "localhost", port => $PORT, auth_user => $AUTH_USER, auth_pass => "wrong pass", ssl => 1, ssl_ca_file => "t/ssl/ca.crt", ); # try to connect with wrong password eval { $client->connect }; ok($@ ne '', "connection failed with wrong pw"); # now set correct password $client->set_auth_pass(Event::RPC->crypt($AUTH_USER,$AUTH_PASS)); # connect to server with correct password $client->connect; ok(1, "connected"); # create instance of test class over RPC my $object = Event_RPC_Test->new ( data => "Some test data. " x 6 ); ok ((ref $object)=~/Event_RPC_Test/, "object created via RPC"); # disconnect client ok ($client->disconnect, "client disconnected"); # wait on server to quit wait; ok (1, "server stopped"); Event-RPC-1.08/t/04.cnct-auth-ssl.t0000644000175000017500000000306212601524535015524 0ustar joernjoernuse strict; use utf8; use Test::More; my $depend_modules = 0; eval { require EV }; eval { require AnyEvent } && ++$depend_modules; eval { require Event } && ++$depend_modules; eval { require Glib } && ++$depend_modules; if ( not $depend_modules ) { plan skip_all => "Neither AnyEvent, Event nor Glib installed"; } eval { require IO::Socket::SSL }; if ( $@ ) { plan skip_all => "IO::Socket::SSL required"; } plan tests => 6; require "t/Event_RPC_Test_Server.pm"; my $PORT = Event_RPC_Test_Server->port; my $AUTH_USER = "foo"; my $AUTH_PASS = "bar"; # load client class use_ok('Event::RPC::Client'); # start server in background, without logging Event_RPC_Test_Server->start_server ( p => $PORT, a => "$AUTH_USER:$AUTH_PASS", s => 1, S => 1, L => $ENV{EVENT_RPC_LOOP}, ); # create client instance my $client = Event::RPC::Client->new ( host => "localhost", port => $PORT, auth_user => $AUTH_USER, auth_pass => "wrong pass", ssl => 1, ); # try to connect with wrong password eval { $client->connect }; ok($@ ne '', "connection failed with wrong pw"); # now set correct password $client->set_auth_pass(Event::RPC->crypt($AUTH_USER,$AUTH_PASS)); # connect to server with correct password $client->connect; ok(1, "connected"); # create instance of test class over RPC my $object = Event_RPC_Test->new ( data => "Some test data. " x 6 ); ok ((ref $object)=~/Event_RPC_Test/, "object created via RPC"); # disconnect client ok ($client->disconnect, "client disconnected"); # wait on server to quit wait; ok (1, "server stopped"); Event-RPC-1.08/t/01.use.t0000644000175000017500000000016012601524535013624 0ustar joernjoernuse strict; use utf8; use Test::More tests => 2; use_ok('Event::RPC::Server'); use_ok('Event::RPC::Client'); Event-RPC-1.08/t/04.cnct-auth-ssl-verifypeer-noca.t0000644000175000017500000000260512601524535020622 0ustar joernjoernuse strict; use utf8; use Test::More; my $depend_modules = 0; eval { require EV }; eval { require AnyEvent } && ++$depend_modules; eval { require Event } && ++$depend_modules; eval { require Glib } && ++$depend_modules; if ( not $depend_modules ) { plan skip_all => "Neither AnyEvent, Event nor Glib installed"; } eval { require IO::Socket::SSL }; if ( $@ ) { plan skip_all => "IO::Socket::SSL required"; } plan tests => 4; require "t/Event_RPC_Test_Server.pm"; my $PORT = Event_RPC_Test_Server->port; my $AUTH_USER = "foo"; my $AUTH_PASS = "bar"; # load client class use_ok('Event::RPC::Client'); # start server in background, without logging my $server_pid = Event_RPC_Test_Server->start_server ( p => $PORT, a => "$AUTH_USER:$AUTH_PASS", s => 1, sf => 't/ssl/server-noca.crt', S => 1, L => $ENV{EVENT_RPC_LOOP}, ); # create client instance my $client = Event::RPC::Client->new ( host => "localhost", port => $PORT, auth_user => $AUTH_USER, auth_pass => Event::RPC->crypt($AUTH_USER,$AUTH_PASS), ssl => 1, ssl_ca_file => "t/ssl/ca.crt", ); # connect to server: should fail due to non signed key eval { $client->connect }; ok($@, "ssl connection failed due to unsigned server key"); # shutdown server process ok(kill(2, $server_pid), "killing server process at PID $server_pid"); # wait on server to quit wait; ok (1, "server stopped"); Event-RPC-1.08/t/08.msg_formats.t0000644000175000017500000001457312601524535015375 0ustar joernjoernuse strict; use utf8; use Test::More; use Event::RPC::Server; use Event::RPC::Message::Negotiate; my $depend_modules = 0; eval { require EV }; eval { require AnyEvent } && ++$depend_modules; eval { require Event } && ++$depend_modules; eval { require Glib } && ++$depend_modules; if ( not $depend_modules ) { plan skip_all => "Neither AnyEvent, Event nor Glib installed"; } require "t/Event_RPC_Test_Server.pm"; my $PORT = Event_RPC_Test_Server->port; # determine available message formats (including the insecure) my $formats = Event::RPC::Server->probe_message_formats( Event::RPC::Message::Negotiate->message_format_order, 1 ); my $modules_by_name = Event::RPC::Message::Negotiate->known_message_formats; my $tests = 1 + @{$formats} * 14 + 9 * 3; plan tests => $tests; # load client class use_ok('Event::RPC::Client'); foreach my $format ( @{$formats} ) { # start server in background, without logging my $server_pid = Event_RPC_Test_Server->start_server ( p => $PORT, S => 1, L => $ENV{EVENT_RPC_LOOP}, f => [ $format ] ); ok($server_pid, "Started server at $server_pid with format '$format'"); # create client instance my $client = Event::RPC::Client->new ( host => "localhost", port => $PORT, ); # connect to server $client->connect; ok(1, "connected"); # check message format ok($client->get_message_format eq $modules_by_name->{$format}, "$format format chosen"); # create instance of test class over RPC my $data = "Some test data with utf8: 你好世界. " x 6; my $object = Event_RPC_Test->new ( data => $data ); # check object ok($object->isa("Event_RPC_Test"), "object is Event_RPC_Test"); # check data ok($object->get_data eq $data, "object data matches"); # set binary data my $bin_data = join("", map { chr($_) } 0..255); $bin_data = $bin_data x 100; ok($object->set_data($bin_data) eq $bin_data, "object bin data set"); ok($object->get_data eq $bin_data, "object bin data get"); # get another object from this object my $object2 = $object->get_object2; ok($object2->isa("Event_RPC_Test2"), "object is Event_RPC_Test2"); # check data of object2 ok($object2->get_data eq 'foo', "object data is 'foo'"); # create another object from this object $object2 = $object->new_object2($$); ok($object2->isa("Event_RPC_Test2"), "object is Event_RPC_Test2"); # check data of object2 ok($object2->get_data == $$, "object data is $$"); $object2->set_data($data); # check if copying the complete object hash works my $ref = $object2->get_object_copy; ok($ref->{data} eq $data, "object copy data matches"); if ( $ENV{EVENT_RPC_BENCHMARK} ) { require Benchmark; my @objects; my @payload = map { $_ => ("Huge payload $_" x 100) } 1..100; diag "Performing benchmark for '$format'"; my $cnt = 20; my $t = Benchmark::timeit($cnt, sub { for ( 1..1000 ) { push @objects, $object->new_object2(\@payload); } $_->set_data(42) for @objects; @objects = (); }); diag "$cnt loops of '$format' took ".Benchmark::timestr($t); } # disconnect client ok ($client->disconnect, "client disconnected"); # wait on server to quit wait; ok (1, "server stopped"); } SKIP: { my ($other_format) = grep { $_ ne "STOR" } @{$formats}; my ($has_storable) = grep { $_ eq "STOR" } @{$formats}; plan skip "Negotations tests skipped due to missing formats", 9*3 unless $other_format and $has_storable; foreach my $client_style (qw/ old insecure secure /) { foreach my $server_style (qw/ old insecure secure /) { if ( $client_style eq 'old' ) { $Event::RPC::Client::DEFAULT_MESSAGE_FORMAT = "Event::RPC::Message::Storable"; } else { $Event::RPC::Client::DEFAULT_MESSAGE_FORMAT = "Event::RPC::Message::Negotiate"; } if ( $server_style eq 'old' ) { $Event::RPC::Server::DEFAULT_MESSAGE_FORMAT = "Event::RPC::Message::Storable"; } else { $Event::RPC::Server::DEFAULT_MESSAGE_FORMAT = "Event::RPC::Message::Negotiate"; } my $client_insecure_ok = $client_style eq 'secure' ? 0 : 1; my $server_insecure_ok = $server_style eq 'secure' ? 0 : 1; my $server_formats = $server_style eq 'old' ? ["STOR"] : $server_style eq 'insecure' ? ["STOR"] : [ $other_format ]; # start server in background, without logging Event_RPC_Test_Server->start_server ( p => $PORT, S => 1, L => $ENV{EVENT_RPC_LOOP}, f => $server_formats, i => $server_insecure_ok, l => 0, ); # create client instance my $client = Event::RPC::Client->new ( host => "localhost", port => $PORT, insecure_msg_fmt_ok => $client_insecure_ok, ); # connect to server eval { $client->connect }; if ( $server_style eq 'secure' and $client_style eq 'old' or $client_style eq 'secure' and $server_style eq 'old') { ok($@, "connection failed, server($server_style) | client($client_style) | si=$server_insecure_ok ci=$client_insecure_ok"); } else { ok(!$@, "connection succeeded, server($server_style) | client($client_style) | si=$server_insecure_ok ci=$client_insecure_ok"); } if ( $client->get_connected ) { ok( ($server_style."|".$client_style =~ /\bsecure\b/ && $client->get_message_format !~ /Storable/) || ($server_style."|".$client_style !~ /\bsecure\b/ && $client->get_message_format =~ /Storable/), "Correct message format chosen" ); $client->disconnect; } else { ok(1, "No security check on connection failure"); } # wait on server to quit wait; ok (1, "server stopped"); } } } Event-RPC-1.08/t/Event_RPC_Test2.pm0000644000175000017500000000050012601524535015626 0ustar joernjoernpackage Event_RPC_Test2; use strict; use utf8; sub get_data { shift->{data} } sub set_data { shift->{data} = $_[1] } sub new { my $class = shift; my ($data) = @_; return bless { data => $data, }, $class; } sub get_object_copy { my $self = shift; return $self; } 1; Event-RPC-1.08/t/Event_RPC_Test_Server.pm0000644000175000017500000001247312601524535017106 0ustar joernjoernpackage Event_RPC_Test_Server; use strict; use utf8; use lib qw(t); use Fcntl qw( :flock ); sub start_server { my $class = shift; my %opts = @_; #-- fork my $server_pid = fork(); die "can't fork" unless defined $server_pid; #-- Client? if ( $server_pid ) { #-- client tries to make a log connection to #-- verify that the server is up and running #-- (20 times with a usleep of 0.25, so the #-- overall timeout is 5 seconds) for ( 1..20 ) { eval { Event::RPC::Client->log_connect ( server => "localhost", port => $opts{p}+1, ); }; #-- return to client code if connect succeeded return $server_pid if !$@; #-- bail out if the limit is reached if ( $_ == 20 ) { die "Couldn't start server: $@"; } #-- wait a quarter second... select(undef, undef, undef, 0.25); } #-- Client is finished here return $server_pid; } #-- We're in the server require Event::RPC::Server; require Event::RPC::Logger; require Event_RPC_Test; require Event_RPC_Test2; #-- This code is mainly copied from the server.pl #-- example and works with a command line style #-- %opts hash my %ssl_args; if ( $opts{s} ) { %ssl_args = ( ssl => 1, ssl_key_file => 't/ssl/server.key', ssl_cert_file => ($opts{sf}||'t/ssl/server.crt'), ssl_passwd_cb => sub { 'eventrpc' }, ); if ( not -f 't/ssl/server.key' ) { print "please execute from toplevel directory\n"; } } my %auth_args; if ( $opts{a} ) { my ($user, $pass) = split(":", $opts{a}); $pass = Event::RPC->crypt($user, $pass); %auth_args = ( auth_required => 1, auth_passwd_href => { $user => $pass }, ); } #-- Create a logger object my $logger = $opts{l} ? Event::RPC::Logger->new ( min_level => $opts{l}, fh_lref => [ \*STDOUT ], ) : undef; #-- Create a loop object my $loop; my $loop_module = $opts{L}; if ( $loop_module ) { eval "use $loop_module"; die $@ if $@; $loop = $loop_module->new(); } my $port = $opts{p} || 5555; my $disconnect_cnt = $opts{S}; #-- Create a Server instance and declare the #-- exported interface my $server; $server = Event::RPC::Server->new ( name => "test daemon", port => $port, loop => $loop, logger => $logger, start_log_listener => 1, load_modules => 0, message_formats => $opts{f}, insecure_msg_fmt_ok => $opts{i}, %auth_args, %ssl_args, classes => { 'Event_RPC_Test' => { new => '_constructor', singleton => '_singleton', set_data => 1, get_data => 1, hello => 1, quit => 1, clone => '_object', multi => '_object', get_object2 => '_object', new_object2 => '_object', echo => 1, get_cid => 1, get_object_cnt => 1, get_undef_object => '_object', get_big_data_struct => 1, async_call_1 => 'object:async:reeintrant' }, 'Event_RPC_Test2' => { new => '_constructor', set_data => 1, get_data => 1, hello => 1, quit => 1, clone => '_object', multi => '_object', get_object2 => '_object', new_object2 => '_object', echo => 1, get_cid => 1, get_object_cnt => 1, get_undef_object => '_object', get_big_data_struct => 1, async_call_1 => 'object:async:reeintrant' }, 'Event_RPC_Test2' => { new => '_constructor', set_data => 1, get_data => 1, get_object_copy => 1, }, }, connection_hook => sub { my ($conn, $event) = @_; return if $event eq 'connect'; --$disconnect_cnt; $server->stop if $disconnect_cnt <= 0 && $server->get_clients_connected == 0; 1; }, ); $server->set_max_packet_size($opts{M}) if $opts{M}; #-- Start the server resp. the Event loop. $server->start; #-- Exit the program exit; } sub port { my $file = "port.txt"; open (my $fh, "+>>", $file) or die "Can't open '$file': $!"; flock($fh, LOCK_EX) or die "Cannot lock $file: $!"; seek $fh, 0, 0; my $port = <$fh> || 27808; chomp $port; truncate $fh, 0; $port += 2; $port = 27810 if $port > 65000; print $fh "$port\n"; close $fh; return $port; } 1; Event-RPC-1.08/t/04.cnct-auth-ssl-verifypeer-wrongca.t0000644000175000017500000000265312601524535021345 0ustar joernjoernuse strict; use utf8; use Test::More; my $depend_modules = 0; eval { require EV }; eval { require AnyEvent } && ++$depend_modules; eval { require Event } && ++$depend_modules; eval { require Glib } && ++$depend_modules; if ( not $depend_modules ) { plan skip_all => "Neither AnyEvent, Event nor Glib installed"; } eval { require IO::Socket::SSL }; if ( $@ ) { plan skip_all => "IO::Socket::SSL required"; } plan tests => 5; require "t/Event_RPC_Test_Server.pm"; my $PORT = Event_RPC_Test_Server->port; my $AUTH_USER = "foo"; my $AUTH_PASS = "bar"; # load client class use_ok('Event::RPC::Client'); # start server in background, without logging Event_RPC_Test_Server->start_server ( p => $PORT, a => "$AUTH_USER:$AUTH_PASS", s => 1, S => 1, L => $ENV{EVENT_RPC_LOOP}, ); # create client instance my $client = Event::RPC::Client->new ( host => "localhost", port => $PORT, auth_user => $AUTH_USER, auth_pass => Event::RPC->crypt($AUTH_USER,$AUTH_PASS), ssl => 1, ssl_ca_file => "t/ssl/ca-wrong.crt", ); # connect to server: should fail due to wrong ca eval { $client->connect }; ok($@, "ssl connection failed with wrong ca"); # now correct ca to shut down server $client->set_ssl_ca_file("t/ssl/ca.crt"); ok($client->connect, "connect with corract ca"); # disconnect client ok ($client->disconnect, "client disconnected"); # wait on server to quit wait; ok (1, "server stopped"); Event-RPC-1.08/t/05.func.t0000644000175000017500000000521512601507045013772 0ustar joernjoernuse strict; use utf8; use Test::More; my $depend_modules = 0; eval { require EV }; eval { require AnyEvent } && ++$depend_modules; eval { require Event } && ++$depend_modules; eval { require Glib } && ++$depend_modules; if ( not $depend_modules ) { plan skip_all => "Neither AnyEvent, Event nor Glib installed"; } plan tests => 18; require "t/Event_RPC_Test_Server.pm"; my $PORT = Event_RPC_Test_Server->port; # load client class use_ok('Event::RPC::Client'); # start server in background, without logging Event_RPC_Test_Server->start_server ( p => $PORT, S => 1, L => $ENV{EVENT_RPC_LOOP}, ); # create client instance my $client = Event::RPC::Client->new ( host => "localhost", port => $PORT, ); # count created objects my $object_cnt = 0; # connect to server $client->connect; ok(1, "connected"); # create instance of test class over RPC my $data = "Some test data. " x 6; my $object = Event_RPC_Test->new ( data => $data ); ++$object_cnt; ok ((ref $object)=~/Event_RPC_Test/, "object created via RPC"); # test data ok ($object->get_data eq $data, "data member ok"); # set data, some utf8 ok ($object->set_data("你好世界") eq "你好世界", "set data utf8"); # check set data, some utf8 ok ($object->get_data eq "你好世界", "get data utf8"); # set data ok ($object->set_data("foo") eq "foo", "set data"); # check set data ok ($object->get_data eq "foo", "get data"); # object transfer my $clone; ++$object_cnt; ok ( $clone = $object->clone, "object transfer"); # check clone $clone->set_data("bar"); ok ( $clone->get_data eq 'bar' && $object->get_data eq 'foo', "clone"); # transfer a list of objects my ($lref, $href) = $object->multi(10); $object_cnt += 10; ok ( @$lref == 10 && $lref->[5]->get_data == 5, "multi object list"); ok ( keys(%$href) == 10 && $href->{4}->get_data == 4, "multi object hash"); # complex parameter transfer my @params = ( "scalar", { 1 => "hash" }, [ "a", "list" ], ); my @result = $object->echo(@params); ok ( @result == 3 && $result[0] eq 'scalar' && ref $result[1] eq 'HASH' && $result[1]->{1} eq 'hash' && ref $result[2] eq 'ARRAY' && $result[2]->[1] eq 'list' , "complex parameter transfer" ); # get connection cid ok ($object->get_cid == 1, "access connection object"); # get client object cnt via connection ok ($object->get_object_cnt == $object_cnt, "client object cnt via connection"); # check undef object returner ok (!defined $object->get_undef_object, "get undef from an object returner"); # disconnect client ok ($client->disconnect, "client disconnected"); # wait on server to quit wait; ok (1, "server stopped"); Event-RPC-1.08/t/03.cnct-auth.t0000644000175000017500000000277512601524535014736 0ustar joernjoernuse strict; use utf8; use Test::More; my $depend_modules = 0; eval { require EV }; eval { require AnyEvent } && ++$depend_modules; eval { require Event } && ++$depend_modules; eval { require Glib } && ++$depend_modules; if ( not $depend_modules ) { plan skip_all => "Neither AnyEvent, Event nor Glib installed"; } plan tests => 6; require "t/Event_RPC_Test_Server.pm"; my $PORT = Event_RPC_Test_Server->port; my $AUTH_USER = "foo"; my $AUTH_PASS = "bar"; # load client class use_ok('Event::RPC::Client'); # start server in background, without logging Event_RPC_Test_Server->start_server ( p => $PORT, a => "$AUTH_USER:$AUTH_PASS", S => 2, L => $ENV{EVENT_RPC_LOOP}, ); # create client instance my $client = Event::RPC::Client->new ( host => "localhost", port => $PORT, auth_user => $AUTH_USER, auth_pass => "wrong", ); # try to connect with wrong password eval { $client->connect }; ok($@ ne '', "connection failed with wrong pw"); # now set correct password $client->set_auth_pass(Event::RPC->crypt($AUTH_USER,$AUTH_PASS)); # connect to server with correct password $client->connect; ok(1, "connected"); # create instance of test class over RPC my $object = Event_RPC_Test->new ( data => "Some test data. " x 6 ); ok ((ref $object)=~/Event_RPC_Test/, "object created via RPC"); # disconnect client (this will also stop the server, # because we started it with the -D option) ok ($client->disconnect, "client disconnected"); # wait on server to quit wait; ok (1, "server stopped"); Event-RPC-1.08/t/06.object2.t0000644000175000017500000000330712601524535014373 0ustar joernjoern#!/usr/bin/perl use strict; use utf8; use Test::More; my $depend_modules = 0; eval { require EV }; eval { require AnyEvent } && ++$depend_modules; eval { require Event } && ++$depend_modules; eval { require Glib } && ++$depend_modules; if ( not $depend_modules ) { plan skip_all => "Neither AnyEvent, Event nor Glib installed"; } plan tests => 10; require "t/Event_RPC_Test_Server.pm"; my $PORT = Event_RPC_Test_Server->port; # load client class use_ok('Event::RPC::Client'); # start server in background, without logging Event_RPC_Test_Server->start_server ( p => $PORT, S => 1, L => $ENV{EVENT_RPC_LOOP}, ); # create client instance my $client = Event::RPC::Client->new ( host => "localhost", port => $PORT, ); # connect to server $client->connect; ok(1, "connected"); # create instance of test class over RPC my $data = "Some test data. " x 6; my $object = Event_RPC_Test->new ( data => $data ); # check object ok($object->isa("Event_RPC_Test"), "object is Event_RPC_Test"); # get another object from this object my $object2 = $object->get_object2; ok($object2->isa("Event_RPC_Test2"), "object is Event_RPC_Test2"); # check data of object2 ok($object2->get_data eq 'foo', "object data is 'foo'"); # create another object from this object $object2 = $object->new_object2($$); ok($object2->isa("Event_RPC_Test2"), "object is Event_RPC_Test2"); # check data of object2 ok($object2->get_data == $$, "object data is $$"); # check if copying the complete object hash works my $ref = $object2->get_object_copy; ok($ref->{data} == $$, "object copy data is $$"); # disconnect client ok ($client->disconnect, "client disconnected"); # wait on server to quit wait; ok (1, "server stopped"); Event-RPC-1.08/Makefile.PL0000644000175000017500000000557012601524535014145 0ustar joernjoern# $Id: Makefile.PL,v 1.2 2005/04/15 21:11:49 joern Exp $ use strict; use ExtUtils::MakeMaker; my $loop_modules = 0; my $has_event = 0; my $has_glib = 0; my $has_anyevent = 0; my $format_modules = 0; my $has_sereal = 0; my $has_cbor_xs = 0; my $has_json_xs = 0; my $has_storable = 0; eval { require Event; $has_event = 1 } && ++$loop_modules; eval { require Glib; $has_glib = 1 } && ++$loop_modules; eval { require AnyEvent; $has_anyevent = 1 } && ++$loop_modules; eval { require Sereal; $has_sereal = 1 } && ++$format_modules; eval { require CBOR::XS; $has_cbor_xs = 1 } && ++$format_modules; eval { require JSON::XS; $has_json_xs = 1 } && ++$format_modules; eval { require Storable; $has_storable = 1 } && ++$format_modules; if ( !$loop_modules ) { print "\n"; print "*****************************************************************\n"; print "WARNING: You need Event, Glib or AnyEvent for Event::RPC to work!\n"; print "*****************************************************************\n"; print "\n"; } if ( !$format_modules ) { print "\n"; print "*****************************************************************\n"; print "WARNING: You need Sereal, CBOR::XS, JSON::XS or Storable module\n"; print "*****************************************************************\n"; print "\n"; } my $has_ssl; eval { require IO::Socket::SSL; $has_ssl = 1 } || do { print "\n"; print "NOTE: Event::RPC is capable of SSL encrypted connections,\n"; print " but your Perl is missing the IO::Socket::SSL module.\n"; print " Event::RPC works perfectly without the module, but you\n"; print " can't use SSL connections until IO::Socket::SSL is\n"; print " installed.\n"; print "\n"; }; #-- Add found modules to PREREQ_PM, so CPAN Testers add #-- version numbers of these modules to the reports, which #-- are very important in case of failing tests. my @add_prereq; push @add_prereq, 'AnyEvent', 0 if not $loop_modules; push @add_prereq, 'Event', 0 if $has_event; push @add_prereq, 'Glib', 0 if $has_glib; push @add_prereq, "Sereal", 3.0 if $has_sereal or not $format_modules; push @add_prereq, "CBOR::XS", 0 if $has_cbor_xs; push @add_prereq, "JSON::XS", 3.0 if $has_json_xs; push @add_prereq, "Storable", 0 if $has_storable; push @add_prereq, 'IO::Socket::SSL', 0 if $has_ssl; push @add_prereq, 'Net::SSLeay', 0 if $has_ssl; WriteMakefile( 'NAME' => 'Event::RPC', 'VERSION_FROM' => 'lib/Event/RPC.pm', 'PREREQ_PM' => { 'Test::More' => 0, 'Storable' => 0, 'IO::Socket::INET' => 0, @add_prereq, }, 'dist' => { COMPRESS => "gzip", SUFFIX => "gz", PREOP => q[pod2text lib/Event/RPC.pm > README], POSTOP => q[mkdir -p dist && mv Event-RPC-*tar.gz dist/], }, ); Event-RPC-1.08/MANIFEST0000644000175000017500000000227612601717775013336 0ustar joernjoernChanges MANIFEST Makefile.PL META.yml README lib/Event/RPC.pm lib/Event/RPC/AuthPasswdHash.pm lib/Event/RPC/Client.pm lib/Event/RPC/Logger.pm lib/Event/RPC/Loop.pm lib/Event/RPC/Loop/AnyEvent.pm lib/Event/RPC/Loop/Event.pm lib/Event/RPC/Loop/Glib.pm lib/Event/RPC/Server.pm lib/Event/RPC/Connection.pm lib/Event/RPC/LogConnection.pm lib/Event/RPC/Message.pm lib/Event/RPC/Message/Negotiate.pm lib/Event/RPC/Message/Storable.pm lib/Event/RPC/Message/JSON.pm lib/Event/RPC/Message/CBOR.pm lib/Event/RPC/Message/Sereal.pm lib/Event/RPC/Message/SerialiserBase.pm t/01.use.t t/02.cnct.t t/03.cnct-auth.t t/04.cnct-auth-ssl.t t/04.cnct-auth-ssl-verifypeer-noca.t t/04.cnct-auth-ssl-verifypeer.t t/04.cnct-auth-ssl-verifypeer-wrongca.t t/05.func.t t/06.object2.t t/07.maxpacket.t t/08.msg_formats.t t/Event_RPC_Test.pm t/Event_RPC_Test2.pm t/Event_RPC_Test_Server.pm t/ssl/ca.crt t/ssl/ca.key t/ssl/ca-wrong.crt t/ssl/ca-wrong.key t/ssl/server.crt t/ssl/server.csr t/ssl/server.key t/ssl/server-noca.crt examples/server.pl examples/client.pl examples/Test_class.pm examples/ssl/server.key examples/ssl/server.csr examples/ssl/server.crt META.json Module JSON meta-data (added by MakeMaker) Event-RPC-1.08/META.json0000664000175000017500000000212212601717775013616 0ustar joernjoern{ "abstract" : "unknown", "author" : [ "unknown" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.1, CPAN::Meta::Converter version 2.142690", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Event-RPC", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "CBOR::XS" : "0", "Event" : "0", "Glib" : "0", "IO::Socket::INET" : "0", "IO::Socket::SSL" : "0", "JSON::XS" : "3", "Net::SSLeay" : "0", "Sereal" : "3", "Storable" : "0", "Test::More" : "0" } } }, "release_status" : "stable", "version" : "1.08" } Event-RPC-1.08/README0000644000175000017500000001437212601717775013065 0ustar joernjoernNAME Event::RPC - Event based transparent Client/Server RPC framework SYNOPSIS #-- Server Code use Event::RPC::Server; use My::TestModule; my $server = Event::RPC::Server->new ( port => 5555, classes => { "My::TestModule" => { ... } }, ); $server->start; ---------------------------------------------------------- #-- Client Code use Event::RPC::Client; my $client = Event::RPC::Client->new ( server => "localhost", port => 5555, ); $client->connect; #-- Call methods of My::TestModule on the server my $obj = My::TestModule->new ( foo => "bar" ); my $foo = $obj->get_foo; ABSTRACT Event::RPC supports you in developing Event based networking client/server applications with transparent object/method access from the client to the server. Network communication is optionally encrypted using IO::Socket::SSL. Several event loop managers are supported due to an extensible API. Currently Event, Glib and AnyEvent are implemented. The latter lets you use nearly every event loop implementation available for Perl. AnyEvent was invented after Event::RPC was created and thus Event::RPC started using it's own abstraction model. DESCRIPTION Event::RPC consists of a server and a client library. The server exports a list of classes and methods, which are allowed to be called over the network. More specific it acts as a proxy for objects created on the server side (on demand of the connected clients) which handles client side methods calls with transport of method arguments and return values. The object proxy handles refcounting and destruction of objects created by clients properly. Objects as method parameters and return values are handled as well (although with some limitations, see below). For the client the whole thing is totally transparent - once connected to the server it doesn't know whether it calls methods on local or remote objects. Also the methods on the server newer know whether they are called locally or from a connected client. Your application logic is not affected by Event::RPC at all, at least if it has a rudimentary clean OO design. For details on implementing servers and clients please refer to the man pages of Event::RPC::Server and Event::RPC::Client. REQUIREMENTS Event::RPC needs either one of the following modules on the server (they're not necessary on the client): Event Glib AnyEvent They're needed for event handling resp. mainloop implementation. If you like to use SSL encryption you need to install IO::Socket::SSL Event::RPC needs minimum one of the following modules for data serialisation: Sereal (::Decoder and ::Encoder) CBOR::XS JSON::XS Storable Server and client negotiate automatically which serialiser to use to achieve maximum compatibility. Some words about the Storable module: it's known to be insecure, so Event::RPC uses it as the last option. You can even prevent Event::RPC from using it at all (even when it's installed, which is the case for nearly every Perl installation) - check manpages of Event::Server and Event::Client about the details. In case you use Storable take care that both client and server use exactly the same version of the Storable module! Otherwise Event::RPC client/server communication will fail badly. INSTALLATION You get the latest installation tarballs and online documentation at this location: http://www.exit1.org/Event-RPC/ If your system meets the requirements mentioned above, installation is just: perl Makefile.PL make test make install To test a specific Event loop implementation, export the variable EVENT_RPC_LOOP: export EVENT_RPC_LOOP=Event::RPC::Loop::Glib make test Otherwise Event::RPC will fallback to the most appropriate module installed on your system. EXAMPLES The tarball includes an examples/ directory which contains two programs: server.pl client.pl Just execute them with --help to get the usage. They do some very simple communication but are good to test your setup, in particular in a mixed environment. LIMITATIONS Although the classes and objects on the server are accessed transparently by the client there are some limitations should be aware of. With a clean object oriented design these should be no problem in real applications: Direct object data manipulation is forbidden All objects reside on the server and they keep there! The client just has specially wrapped proxy objects, which trigger the necessary magic to access the object's methods on the server. Complete objects are never transferred from the server to the client, so something like this does not work: $object->{data} = "changed data"; (assuming $object is a hash ref on the server). Only method calls are transferred to the server, so even for "simple" data manipulation a method call is necessary: $object->set_data ("changed data"); As well for reading an object attribute. Accessing a hash key will fail: my $data = $object->{data}; Instead call a method which returns the 'data' member: my $data = $object->get_data; Methods may exchange objects, but not in a too complex structure Event::RPC handles methods which return objects. The only requirement is that they are declared as a Object returner on the server (refer to Event::RPC::Server for details), but not if the object is hidden inside a deep complex data structure. An array or hash ref of objects is Ok, but not more. This would require to much expensive runtime data inspection. Object receiving parameters are more restrictive, since even hiding them inside one array or hash ref is not allowed. They must be passed as a direkt argument of the method subroutine. AUTHORS Jörn Reder COPYRIGHT AND LICENSE Copyright (C) 2005-2015 by Jörn Reder . This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Event-RPC-1.08/examples/0000755000175000017500000000000012601717775014014 5ustar joernjoernEvent-RPC-1.08/examples/ssl/0000755000175000017500000000000012601717775014615 5ustar joernjoernEvent-RPC-1.08/examples/ssl/server.csr0000644000175000017500000000131010230026674016612 0ustar joernjoern-----BEGIN CERTIFICATE REQUEST----- MIIB1jCCAT8CAQAwgZUxCzAJBgNVBAYTAkRFMREwDwYDVQQIEwhJcmdlbmR3bzEO MAwGA1UEBxMFS29lbG4xEjAQBgNVBAoTCWV4aXQxLm9yZzEdMBsGA1UECxMUU29m dHdhcmUgRGV2ZWxvcG1lbnQxEzARBgNVBAMUCkr2cm4gUmVkZXIxGzAZBgkqhkiG 9w0BCQEWDGpvZXJuQHp5bi5kZTCBnzANBgkqhkiG9w0BAQEFAAOBjQAwgYkCgYEA pKvgMocsWLb3SQw1UukxcCORSDYgge1d1LAGIPlRtLRhCCNfUufY8Jslmn/4hZI4 wpeRQ5M2NLMkP8kaCgmMviyl20I+jCikLqQFTTMmwU35uWoMw343kZA4G6eLqjWV y8NHNABTthgigHaVGWld0lRFpYD4DcWIze50Afg8dl8CAwEAAaAAMA0GCSqGSIb3 DQEBBAUAA4GBAJmfq2IqvN+m9IIRzNTHBjEaOeYIEFVKcqWIiui/hvw8M7Yi0op2 ifOjRKSfYTsgNAst1Ilwg6wgblSngg6f9GpGtWAYr1xQpoWS8PDaqjx1sLE40qi2 aNrCtrSCLxzLh9o0qeUydcrjvIK6sWe6lGRntjNoj2VCqlBm0EFQ7vNF -----END CERTIFICATE REQUEST----- Event-RPC-1.08/examples/ssl/server.key0000644000175000017500000000170310230026674016621 0ustar joernjoern-----BEGIN RSA PRIVATE KEY----- Proc-Type: 4,ENCRYPTED DEK-Info: DES-EDE3-CBC,CEB8A2E7F9C59066 mUDYr4fgc2lba+qobTYxcq/8ZpRS1cdoiCe1QQeSQ2Bywrsgx8H40hqkBsKOYBPa ZFC+EEQTfhGOswTD5YsgqfTyWc7w0qlXDlPCVgV28r96gKzpP6oEDoclriWsToDF ZOsANyGcdl4D4VyY+oOf9crUFqIC4C/IfUJ++pZCUlGy8k/J0qHl/kCEP1bPg92q tKrG/gcDtrqnVHYB22MruAXHSAo4JOO7A6ZmrRGH4XY5SKGZPF/T7kwLLzEXbPq2 MDrcPg3xWcCvODswrptdmK73PyF5oWkA7NXAofecu51jW1Y9G48p1lQi0mAgP3qP LDxCFQUU52G9UAxmfd8pZBSntRIsaIQV+6ffM8TemObgf1VkisCGDUCnEgvj2zDN AaieLhR4MKIQuYZSTLfCI5mKZK0vCFP5t19wK6Clt7p9bq1aUu8HkqEZ5yrNmf04 acKvUkDbVCPL1pkAsyNAEQ4Zs3f3VxkuRrtf7gqzEEFK1TQoH7JmaALqGftgkPYJ eEYX8Om/Gr8NxTftSNbnoaFUyeoBOQ1iZY2g4qqE0rZlc7lfXiXAV3ajtgPcreZa +uU4g8DF7zfQ7F8FK7w2ryLJFdlgk7SzEjv1VzCQTQ2MjBOCs0gJ3SPF6wx6lfyH 9HqYRu2OwPJlaTzVrdhwKesROuBr1+rJym18uvzObSgkbTrFQuuYcR0dNbs+AuqQ dkhOC6bzpOdZNWVnVQ7klbsj8iUSMs4QnSI0+DpSls5VOMJiAXqPCAy4YJ0GAcGv EDF12ONiToyGb0Jolo+WOXyDebHR19TxokTcC5Ri7305mtRAP7g1fQ== -----END RSA PRIVATE KEY----- Event-RPC-1.08/examples/ssl/server.crt0000644000175000017500000000172110230026674016621 0ustar joernjoern-----BEGIN CERTIFICATE----- MIICozCCAgwCCQC7s/EOvPkeSTANBgkqhkiG9w0BAQQFADCBlTELMAkGA1UEBhMC REUxETAPBgNVBAgTCElyZ2VuZHdvMQ4wDAYDVQQHEwVLb2VsbjESMBAGA1UEChMJ ZXhpdDEub3JnMR0wGwYDVQQLExRTb2Z0d2FyZSBEZXZlbG9wbWVudDETMBEGA1UE AxQKSvZybiBSZWRlcjEbMBkGCSqGSIb3DQEJARYMam9lcm5AenluLmRlMB4XDTA1 MDMxMzE3NDg1NloXDTE1MDEyMDE3NDg1NlowgZUxCzAJBgNVBAYTAkRFMREwDwYD VQQIEwhJcmdlbmR3bzEOMAwGA1UEBxMFS29lbG4xEjAQBgNVBAoTCWV4aXQxLm9y ZzEdMBsGA1UECxMUU29mdHdhcmUgRGV2ZWxvcG1lbnQxEzARBgNVBAMUCkr2cm4g UmVkZXIxGzAZBgkqhkiG9w0BCQEWDGpvZXJuQHp5bi5kZTCBnzANBgkqhkiG9w0B AQEFAAOBjQAwgYkCgYEApKvgMocsWLb3SQw1UukxcCORSDYgge1d1LAGIPlRtLRh CCNfUufY8Jslmn/4hZI4wpeRQ5M2NLMkP8kaCgmMviyl20I+jCikLqQFTTMmwU35 uWoMw343kZA4G6eLqjWVy8NHNABTthgigHaVGWld0lRFpYD4DcWIze50Afg8dl8C AwEAATANBgkqhkiG9w0BAQQFAAOBgQAaahVlE9jXt0GO+Zk9ZDUmyiLQ31lhRbvr /fFqLYB3WS0xGnKKaj3IQFREkke7an4rhUaZLGstAhF3bXcN//t9bgZKQfnRPsM2 bQHEVWAtwjebv0Rn0uR53gZBxoCHZyGwCL0Tj0Gvynpou4Y8UDGnfc1E/r+HOTCO yvVrQL359w== -----END CERTIFICATE----- Event-RPC-1.08/examples/server.pl0000644000175000017500000000635412601717663015663 0ustar joernjoern#!/usr/bin/perl -w #----------------------------------------------------------------------- # Copyright (C) 2005-2015 by Jörn Reder . # All Rights Reserved. See file COPYRIGHT for details. # # This module is part of Event::RPC, which is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. #----------------------------------------------------------------------- use strict; use strict; use Event::RPC::Server; use Event::RPC::Logger; use Getopt::Std; my $USAGE = <<__EOU; Usage: server.pl [-l log-level] [-s] [-a user:pass] [-L loop-module] Description: Event::RPC server demonstration program. Execute this from the distribution's base or examples/ directory. Then execute examples/client.pl on another console. Options: -l log-level Logging level. Default: 4 -s Use SSL encryption -a user:pass Require authorization -h host Bind to this host interface. Default: localhost -L loop-module Event loop module to use. Default: Event::RPC::Loop::Event __EOU sub HELP_MESSAGE { my ($fh) = @_; $fh ||= \*STDOUT; print $fh $USAGE; exit; } main: { my %opts; my $opts_ok = getopts('h:L:l:a:s',\%opts); HELP_MESSAGE() unless $opts_ok; my %ssl_args; if ( $opts{s} ) { %ssl_args = ( ssl => 1, ssl_key_file => 'ssl/server.key', ssl_cert_file => 'ssl/server.crt', ssl_passwd_cb => sub { 'eventrpc' }, ); if ( not -f 'ssl/server.key' ) { chdir ("examples"); if ( not -f 'ssl/server.key' ) { print "please execute from toplevel or examples/ directory\n"; exit 1; } } } my %auth_args; if ( $opts{a} ) { my ($user, $pass) = split(":", $opts{a}); $pass = Event::RPC->crypt($user, $pass); %auth_args = ( auth_required => 1, auth_passwd_href => { $user => $pass }, ); } #-- Create a logger object my $logger = Event::RPC::Logger->new ( min_level => ($opts{l}||4), fh_lref => [ \*STDOUT ], ); #-- Create a loop object my $loop; my $loop_module = $opts{L}; if ( $loop_module ) { eval "use $loop_module"; die $@ if $@; $loop = $loop_module->new(); } #-- Host parameter my $host = $opts{h} || "localhost"; #-- Create a Server instance and declare the #-- exported interface my $server = Event::RPC::Server->new ( name => "test daemon", host => $host, port => 5555, logger => $logger, loop => $loop, start_log_listener => 1, auto_reload_modules => 1, message_formats => [qw/ SERL CBOR JSON STOR /], %auth_args, %ssl_args, classes => { 'Test_class' => { new => '_constructor', set_data => 1, get_data => 1, hello => 1, quit => 1, }, }, ); #-- Start the server resp. the Event loop. $server->start; } Event-RPC-1.08/examples/Test_class.pm0000644000175000017500000000176312601717663016461 0ustar joernjoern#----------------------------------------------------------------------- # Copyright (C) 2005-2015 by Jörn Reder . # All Rights Reserved. See file COPYRIGHT for details. # # This module is part of Event::RPC, which is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. #----------------------------------------------------------------------- package Test_class; use strict; sub get_data { shift->{data} } sub set_data { shift->{data} = $_[1] } sub new { my $class = shift; my %par = @_; my ($data) = $par{'data'}; my $self = bless { data => $data, }, $class; return $self; } sub hello { my $self = shift; return "Hello again. My data is: '".$self->get_data."' and event model is: $AnyEvent::MODEL"; } sub quit { my $self = shift; my $rpc_server = Event::RPC::Server->instance; $rpc_server->get_loop->add_timer ( after => 3, cb => sub { $rpc_server->stop }, ); return "Server stops in 3 seconds"; } 1; Event-RPC-1.08/examples/client.pl0000644000175000017500000000563012601717663015627 0ustar joernjoern#!/usr/bin/perl -w #----------------------------------------------------------------------- # Copyright (C) 2005-2015 by Jörn Reder . # All Rights Reserved. See file COPYRIGHT for details. # # This module is part of Event::RPC, which is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. #----------------------------------------------------------------------- use strict; use Event::RPC::Client; use Getopt::Std; my $USAGE = <<__EOU; Usage: client.pl [-s] [-a user:pass] Description: Event::RPC client demonstration program. Execute this from the distribution's base or examples/ directory after starting the correspondent examples/server.pl program. Options: -s Use SSL encryption -a user:pass Pass this authorization data to the server -h host Server hostname. Default: localhost __EOU sub HELP_MESSAGE { my ($fh) = @_; $fh ||= \*STDOUT; print $fh $USAGE; exit; } main: { my %opts; my $opts_ok = getopts('h:l:a:s',\%opts); HELP_MESSAGE() unless $opts_ok; my $ssl = $opts{s} || 0; my %auth_args; if ( $opts{a} ) { my ($user, $pass) = split(":", $opts{a}); $pass = Event::RPC->crypt($user,$pass); %auth_args = ( auth_user => $user, auth_pass => $pass, ); } #-- Host parameter my $host = $opts{h} || 'localhost'; #-- This connects to the server, requests the exported #-- interfaces and establishes correspondent proxy methods #-- in the correspondent packages. my $client; $client = Event::RPC::Client->new ( host => $host, port => 5555, ssl => $ssl, %auth_args, error_cb => sub { my ($client, $error) = @_; print "An RPC error occured!\n> $error"; print "Disconnect and exit.\n"; $client->disconnect if $client; exit; }, classes => [ "Test_class" ], ); $client->connect; print "\nConnected to localhost:5555\n\n"; print "Server version: ".$client->get_server_version,"\n"; print "Server protocol: ".$client->get_server_protocol,"\n"; print "Message format: ".eval { $client->get_message_format },"\n"; print "\n"; #-- So the call to Event::RPC::Test->new is handled transparently #-- by Event::RPC::Client print "** Create object on server\n"; my $object = Test_class->new ( data => "Initial data", ); print "=> Object created with data: '".$object->get_data."'\n\n"; #-- and methods calls as well... print "** Say hello to server.\n"; print "=> Server returned: >>".$object->hello,"<<\n"; print "\n** Update object data.\n"; $object->set_data ("Yes, updating works"); print "=> Retrieve data from server: '".$object->get_data."'\n"; print "\n** Disconnecting\n\n"; $client->disconnect; } Event-RPC-1.08/META.yml0000664000175000017500000000113012601717775013444 0ustar joernjoern--- abstract: unknown author: - unknown build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.1, CPAN::Meta::Converter version 2.142690' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Event-RPC no_index: directory: - t - inc requires: CBOR::XS: '0' Event: '0' Glib: '0' IO::Socket::INET: '0' IO::Socket::SSL: '0' JSON::XS: '3' Net::SSLeay: '0' Sereal: '3' Storable: '0' Test::More: '0' version: '1.08' Event-RPC-1.08/lib/0000755000175000017500000000000012601717775012744 5ustar joernjoernEvent-RPC-1.08/lib/Event/0000755000175000017500000000000012601717775014025 5ustar joernjoernEvent-RPC-1.08/lib/Event/RPC.pm0000644000175000017500000001412712601717663015010 0ustar joernjoernpackage Event::RPC; $VERSION = "1.08"; $PROTOCOL = "1.00"; use strict; use utf8; sub crypt { my $class = shift; my ($user, $pass) = @_; return crypt($pass, $user); } __END__ =encoding utf8 =head1 NAME Event::RPC - Event based transparent Client/Server RPC framework =head1 SYNOPSIS #-- Server Code use Event::RPC::Server; use My::TestModule; my $server = Event::RPC::Server->new ( port => 5555, classes => { "My::TestModule" => { ... } }, ); $server->start; ---------------------------------------------------------- #-- Client Code use Event::RPC::Client; my $client = Event::RPC::Client->new ( server => "localhost", port => 5555, ); $client->connect; #-- Call methods of My::TestModule on the server my $obj = My::TestModule->new ( foo => "bar" ); my $foo = $obj->get_foo; =head1 ABSTRACT Event::RPC supports you in developing Event based networking client/server applications with transparent object/method access from the client to the server. Network communication is optionally encrypted using IO::Socket::SSL. Several event loop managers are supported due to an extensible API. Currently Event, Glib and AnyEvent are implemented. The latter lets you use nearly every event loop implementation available for Perl. AnyEvent was invented after Event::RPC was created and thus Event::RPC started using it's own abstraction model. =head1 DESCRIPTION Event::RPC consists of a server and a client library. The server exports a list of classes and methods, which are allowed to be called over the network. More specific it acts as a proxy for objects created on the server side (on demand of the connected clients) which handles client side methods calls with transport of method arguments and return values. The object proxy handles refcounting and destruction of objects created by clients properly. Objects as method parameters and return values are handled as well (although with some limitations, see below). For the client the whole thing is totally transparent - once connected to the server it doesn't know whether it calls methods on local or remote objects. Also the methods on the server newer know whether they are called locally or from a connected client. Your application logic is not affected by Event::RPC at all, at least if it has a rudimentary clean OO design. For details on implementing servers and clients please refer to the man pages of Event::RPC::Server and Event::RPC::Client. =head1 REQUIREMENTS Event::RPC needs either one of the following modules on the server (they're not necessary on the client): Event Glib AnyEvent They're needed for event handling resp. mainloop implementation. If you like to use SSL encryption you need to install IO::Socket::SSL Event::RPC needs minimum one of the following modules for data serialisation: Sereal (::Decoder and ::Encoder) CBOR::XS JSON::XS Storable Server and client negotiate automatically which serialiser to use to achieve maximum compatibility. Some words about the Storable module: it's known to be insecure, so Event::RPC uses it as the last option. You can even prevent Event::RPC from using it at all (even when it's installed, which is the case for nearly every Perl installation) - check manpages of Event::Server and Event::Client about the details. In case you use Storable take care that both client and server use B! Otherwise Event::RPC client/server communication will fail badly. =head1 INSTALLATION You get the latest installation tarballs and online documentation at this location: http://www.exit1.org/Event-RPC/ If your system meets the requirements mentioned above, installation is just: perl Makefile.PL make test make install To test a specific Event loop implementation, export the variable EVENT_RPC_LOOP: export EVENT_RPC_LOOP=Event::RPC::Loop::Glib make test Otherwise Event::RPC will fallback to the most appropriate module installed on your system. =head1 EXAMPLES The tarball includes an examples/ directory which contains two programs: server.pl client.pl Just execute them with --help to get the usage. They do some very simple communication but are good to test your setup, in particular in a mixed environment. =head1 LIMITATIONS Although the classes and objects on the server are accessed transparently by the client there are some limitations should be aware of. With a clean object oriented design these should be no problem in real applications: =head2 Direct object data manipulation is forbidden All objects reside on the server and they keep there! The client just has specially wrapped proxy objects, which trigger the necessary magic to access the object's B on the server. Complete objects are never transferred from the server to the client, so something like this does B work: $object->{data} = "changed data"; (assuming $object is a hash ref on the server). Only method calls are transferred to the server, so even for "simple" data manipulation a method call is necessary: $object->set_data ("changed data"); As well for reading an object attribute. Accessing a hash key will fail: my $data = $object->{data}; Instead call a method which returns the 'data' member: my $data = $object->get_data; =head2 Methods may exchange objects, but not in a too complex structure Event::RPC handles methods which return objects. The only requirement is that they are declared as a B on the server (refer to Event::RPC::Server for details), but not if the object is hidden inside a deep complex data structure. An array or hash ref of objects is Ok, but not more. This would require to much expensive runtime data inspection. Object receiving parameters are more restrictive, since even hiding them inside one array or hash ref is not allowed. They must be passed as a direkt argument of the method subroutine. =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright (C) 2005-2015 by Jörn Reder . This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Event-RPC-1.08/lib/Event/RPC/0000755000175000017500000000000012601717775014451 5ustar joernjoernEvent-RPC-1.08/lib/Event/RPC/Loop/0000755000175000017500000000000012601717775015362 5ustar joernjoernEvent-RPC-1.08/lib/Event/RPC/Loop/Event.pm0000644000175000017500000000445012601717663017000 0ustar joernjoern#----------------------------------------------------------------------- # Copyright (C) 2005-2015 by Jörn Reder . # All Rights Reserved. See file COPYRIGHT for details. # # This module is part of Event::RPC, which is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. #----------------------------------------------------------------------- package Event::RPC::Loop::Event; use base qw( Event::RPC::Loop ); use strict; use utf8; use Event; sub add_io_watcher { my $self = shift; my %par = @_; my ($fh, $cb, $desc, $poll) = @par{'fh','cb','desc','poll'}; return Event->io ( fd => $fh, poll => $poll, cb => $cb, desc => $desc, reentrant => 0, parked => 0, ); } sub del_io_watcher { my $self = shift; my ($watcher) = @_; $watcher->cancel; 1; } sub add_timer { my $self = shift; my %par = @_; my ($interval, $after, $cb, $desc) = @par{'interval','after','cb','desc'}; die "interval and after can't be used together" if $interval && $after; return Event->timer ( interval => $interval, after => $after, cb => $cb, desc => $desc, ); } sub del_timer { my $self = shift; my ($timer) = @_; $timer->cancel; 1; } sub enter { my $self = shift; Event::loop(); 1; } sub leave { my $self = shift; Event::unloop_all("ok"); 1; } 1; __END__ =encoding utf8 =head1 NAME Event::RPC::Loop::Event - Event mainloop for Event::RPC =head1 SYNOPSIS use Event::RPC::Server; use Event::RPC::Loop::Event; my $server = Event::RPC::Server->new ( ... loop => Event::RPC::Loop::Event->new(), ... ); $server->start; =head1 DESCRIPTION This modules implements a mainloop using the Event module for the Event::RPC::Server module. It implements the interface of Event::RPC::Loop. Please refer to the manpage of Event::RPC::Loop for details. =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright (C) 2005-2015 by Jörn Reder . This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Event-RPC-1.08/lib/Event/RPC/Loop/Glib.pm0000644000175000017500000000536412601717663016601 0ustar joernjoern#----------------------------------------------------------------------- # Copyright (C) 2005-2015 by Jörn Reder . # All Rights Reserved. See file COPYRIGHT for details. # # This module is part of Event::RPC, which is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. #----------------------------------------------------------------------- package Event::RPC::Loop::Glib; use base qw( Event::RPC::Loop ); use strict; use utf8; use Glib; sub get_glib_main_loop { shift->{glib_main_loop} } sub set_glib_main_loop { shift->{glib_main_loop} = $_[1] } sub add_io_watcher { my $self = shift; my %par = @_; my ($fh, $cb, $desc, $poll) = @par{'fh','cb','desc','poll'}; my $cond = $poll eq 'r' ? ['G_IO_IN', 'G_IO_HUP']: ['G_IO_OUT','G_IO_HUP']; return Glib::IO->add_watch ($fh->fileno, $cond, sub { &$cb(); 1 } ); } sub del_io_watcher { my $self = shift; my ($watcher) = @_; Glib::Source->remove ($watcher); 1; } sub add_timer { my $self = shift; my %par = @_; my ($interval, $after, $cb, $desc) = @par{'interval','after','cb','desc'}; die "interval and after can't be used together" if $interval && $after; if ( $interval ) { return Glib::Timeout->add ( $interval * 1000, sub { &$cb(); 1 } ); } else { return Glib::Timeout->add ( $after * 1000, sub { &$cb(); 0 } ); } 1; } sub del_timer { my $self = shift; my ($timer) = @_; Glib::Source->remove($timer); 1; } sub enter { my $self = shift; Glib->install_exception_handler(sub { print "Event::RPC::Loop::Glib caught an exception: $@\n"; 1; }); my $main_loop = Glib::MainLoop->new; $self->set_glib_main_loop($main_loop); $main_loop->run; 1; } sub leave { my $self = shift; $self->get_glib_main_loop->quit; 1; } 1; __END__ =encoding utf8 =head1 NAME Event::RPC::Loop::Glib - Glib mainloop for Event::RPC =head1 SYNOPSIS use Event::RPC::Server; use Event::RPC::Loop::Glib; my $server = Event::RPC::Server->new ( ... loop => Event::RPC::Loop::Glib->new(), ... ); $server->start; =head1 DESCRIPTION This modules implements a mainloop using Glib for the Event::RPC::Server module. It implements the interface of Event::RPC::Loop. Please refer to the manpage of Event::RPC::Loop for details. =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright (C) 2005-2015 by Jörn Reder . This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Event-RPC-1.08/lib/Event/RPC/Loop/AnyEvent.pm0000644000175000017500000000474312601717663017455 0ustar joernjoern#----------------------------------------------------------------------- # Copyright (C) 2005-2015 by Jörn Reder . # All Rights Reserved. See file COPYRIGHT for details. # # This module is part of Event::RPC, which is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. #----------------------------------------------------------------------- package Event::RPC::Loop::AnyEvent; use base qw( Event::RPC::Loop ); use strict; use utf8; use AnyEvent; my %watchers; sub get_loop_cv { shift->{loop_cv} } sub set_loop_cv { shift->{loop_cv} = $_[1] } sub add_io_watcher { my $self = shift; my %par = @_; my ($fh, $cb, $desc, $poll) = @par{'fh','cb','desc','poll'}; my $watcher = AnyEvent->io ( fh => $fh, poll => $poll, cb => $cb, ); $watchers{"$watcher"} = $watcher; return $watcher; } sub del_io_watcher { my $self = shift; my ($watcher) = @_; delete $watchers{"$watcher"}; 1; } sub add_timer { my $self = shift; my %par = @_; my ($interval, $after, $cb, $desc) = @par{'interval','after','cb','desc'}; my $timer = AnyEvent->timer ( after => $after, interval => $interval, cb => $cb, ); $watchers{"$timer"} = $timer; return $timer; } sub del_timer { my $self = shift; my ($timer) = @_; delete $watchers{"$timer"}; 1; } sub enter { my $self = shift; my $loop_cv = AnyEvent->condvar; $self->set_loop_cv($loop_cv); $loop_cv->wait; 1; } sub leave { my $self = shift; $self->get_loop_cv->send; 1; } 1; __END__ =encoding utf8 =head1 NAME Event::RPC::Loop::AnyEvent - AnyEvent mainloop for Event::RPC =head1 SYNOPSIS use Event::RPC::Server; use Event::RPC::Loop::AnyEvent; my $server = Event::RPC::Server->new ( ... loop => Event::RPC::Loop::AnyEvent->new(), ... ); $server->start; =head1 DESCRIPTION This modules implements a mainloop using AnyEvent for the Event::RPC::Server module. It implements the interface of Event::RPC::Loop. Please refer to the manpage of Event::RPC::Loop for details. =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright (C) 2005-2015 by Jörn Reder . This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Event-RPC-1.08/lib/Event/RPC/Message.pm0000644000175000017500000001372512601717663016377 0ustar joernjoern#----------------------------------------------------------------------- # Copyright (C) 2005-2015 by Jörn Reder . # All Rights Reserved. See file COPYRIGHT for details. # # This module is part of Event::RPC, which is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. #----------------------------------------------------------------------- package Event::RPC::Message; use Carp; use strict; use utf8; my %DECODERS = ( STOR => sub { require Storable; Storable::thaw($_[0]) }, JSON => sub { require JSON::XS; JSON::XS->new->allow_tags->decode($_[0]) }, CBOR => sub { require CBOR::XS; CBOR::XS->new->decode($_[0]) }, SERL => sub { require Sereal; Sereal::decode_sereal($_[0]) }, TEST => sub { require Storable; Storable::thaw($_[0]) }, ); my %ENCODERS = ( STOR => sub { require Storable; Storable::nfreeze ($_[0]) }, JSON => sub { require JSON::XS; '%E:R:JSON%'.JSON::XS->new->latin1->allow_blessed->allow_tags->encode($_[0]) }, CBOR => sub { require CBOR::XS; '%E:R:CBOR%'.CBOR::XS->new->encode($_[0]) }, SERL => sub { require Sereal; '%E:R:SERL%'.Sereal::encode_sereal($_[0]) }, TEST => sub { "//NEGOTIATE(A,B,C)//" }, ); my $DEBUG = 0; my $MAX_PACKET_SIZE = 2*1024*1024*1024; sub get_sock { shift->{sock} } sub get_buffer { shift->{buffer} } sub get_length { shift->{length} } sub get_written { shift->{written} } sub set_buffer { shift->{buffer} = $_[1] } sub set_length { shift->{length} = $_[1] } sub set_written { shift->{written} = $_[1] } sub get_max_packet_size { return $MAX_PACKET_SIZE; } sub set_max_packet_size { my $class = shift; my ($value) = @_; $MAX_PACKET_SIZE = $value; } sub new { my $class = shift; my ($sock) = @_; my $self = bless { sock => $sock, buffer => undef, length => 0, written => 0, }, $class; return $self; } sub read { my $self = shift; my ($blocking) = @_; $self->get_sock->blocking($blocking?1:0); if ( not defined $self->{buffer} ) { my $length_packed; $DEBUG && print "DEBUG: going to read header...\n"; my $rc = sysread ($self->get_sock, $length_packed, 4); $DEBUG && print "DEBUG: header read rc=$rc\n"; die "DISCONNECTED" if !(defined $rc) || $rc == 0; $self->{length} = unpack("N", $length_packed); $DEBUG && print "DEBUG: packet size=$self->{length}\n"; die "Incoming message size exceeds limit of $MAX_PACKET_SIZE bytes" if $self->{length} > $MAX_PACKET_SIZE; } my $buffer_length = length($self->{buffer}||''); $DEBUG && print "DEBUG: going to read packet... (buffer_length=$buffer_length)\n"; my $rc = sysread ( $self->get_sock, $self->{buffer}, $self->{length} - $buffer_length, $buffer_length ); $DEBUG && print "DEBUG: packet read rc=$rc\n"; return if not defined $rc; die "DISCONNECTED" if $rc == 0; $buffer_length = length($self->{buffer}); $DEBUG && print "DEBUG: more to read... ($self->{length} != $buffer_length)\n" if $self->{length} != $buffer_length; return if $self->{length} != $buffer_length; $DEBUG && print "DEBUG: read finished, length=$buffer_length\n"; my $data = $self->decode_message($self->{buffer}); $self->{buffer} = undef; $self->{length} = 0; return $data; } sub read_blocked { my $self = shift; my $rc; $rc = $self->read(1) while not defined $rc; return $rc; } sub set_data { my $self = shift; my ($data) = @_; $DEBUG && print "DEBUG: Message->set_data($data)\n"; my $packed = $self->encode_message($data); if ( length($packed) > $MAX_PACKET_SIZE ) { Event::RPC::Server->instance->log("ERROR: response packet exceeds limit of $MAX_PACKET_SIZE bytes"); $data = { rc => 0, msg => "Response packed exceeds limit of $MAX_PACKET_SIZE bytes" }; $packed = $self->encode_message($data); } $self->{buffer} = pack("N", length($packed)).$packed; $self->{length} = length($self->{buffer}); $self->{written} = 0; 1; } sub write { my $self = shift; my ($blocking) = @_; $self->get_sock->blocking($blocking?1:0); my $rc = syswrite ( $self->get_sock, $self->{buffer}, $self->{length}-$self->{written}, $self->{written}, ); $DEBUG && print "DEBUG: written rc=$rc\n"; return if not defined $rc; $self->{written} += $rc; if ( $self->{written} == $self->{length} ) { $DEBUG && print "DEBUG: write finished\n"; $self->{buffer} = undef; $self->{length} = 0; return 1; } $DEBUG && print "DEBUG: more to be written...\n"; return; } sub write_blocked { my $self = shift; my ($data) = @_; $self->set_data($data); my $finished = 0; $finished = $self->write(1) while not $finished; 1; } 1; __END__ =encoding utf8 =head1 NAME Event::RPC::Message - Implementation of Event::RPC network protocol =head1 SYNOPSIS # Internal module. No documented public interface. =head1 DESCRIPTION This module implements the network protocol of Event::RPC. Objects of this class are created internally by Event::RPC::Server and Event::RPC::Client and performs message passing over the network. =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright (C) 2005-2015 by Jörn Reder . This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Event-RPC-1.08/lib/Event/RPC/Message/0000755000175000017500000000000012601717775016035 5ustar joernjoernEvent-RPC-1.08/lib/Event/RPC/Message/Sereal.pm0000644000175000017500000000273712601717663017613 0ustar joernjoern# $Id: Message.pm,v 1.9 2014-01-28 15:40:10 joern Exp $ #----------------------------------------------------------------------- # Copyright (C) 2005-2015 by Jörn Reder . # All Rights Reserved. See file COPYRIGHT for details. # # This module is part of Event::RPC, which is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. #----------------------------------------------------------------------- package Event::RPC::Message::Sereal; use base Event::RPC::Message; use strict; use utf8; use Sereal qw(sereal_encode_with_object sereal_decode_with_object); my $decoder = Sereal::Decoder->new; my $encoder = Sereal::Encoder->new; sub decode_message { sereal_decode_with_object($decoder, $_[1]) } sub encode_message { sereal_encode_with_object($encoder, $_[1]) } 1; __END__ =encoding utf8 =head1 NAME Event::RPC::Message::Sereal - Sereal message formatting =head1 SYNOPSIS # Internal module. No documented public interface. =head1 DESCRIPTION This module implements the message formatting of Event::RPC using Sereal. Objects of this class are created internally by Event::RPC::Server and Event::RPC::Client and performs message passing over the network. =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright (C) 2005-2015 by Jörn Reder . This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Event-RPC-1.08/lib/Event/RPC/Message/SerialiserBase.pm0000644000175000017500000000401612601717663021265 0ustar joernjoern# $Id: Message.pm,v 1.9 2014-01-28 15:40:10 joern Exp $ #----------------------------------------------------------------------- # Copyright (C) 2005-2015 by Jörn Reder . # All Rights Reserved. See file COPYRIGHT for details. # # This module is part of Event::RPC, which is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. #----------------------------------------------------------------------- package Event::RPC::Message::SerialiserBase; use base Event::RPC::Message; use strict; use utf8; sub UNIVERSAL::FREEZE { my ($object, $serialiser) = @_; my ($ref_type) = "$object" =~ /=(\w+)\(/; return $ref_type eq 'HASH' ? [ $ref_type, [%{$object}] ] : $ref_type eq 'ARRAY' ? [ $ref_type, [@{$object}] ] : $ref_type eq 'SCALAR' ? [ $ref_type, ${$object} ] : die "Unsupported reference type '$ref_type'"; } sub UNIVERSAL::THAW { my ($class, $serialiser, $obj) = @_; return $obj->[0] eq 'HASH' ? bless { @{$obj->[1]} }, $class : $obj->[0] eq 'ARRAY' ? bless [ @{$obj->[1]} ], $class : $obj->[0] eq 'SCALAR' ? bless \ $obj->[1], $class : die "Unsupported reference type '$obj->[0]'"; } 1; __END__ =encoding utf8 =head1 NAME Event::RPC::Message::SerialiserBase - Base for some message classes =head1 SYNOPSIS # Internal module. No documented public interface. =head1 DESCRIPTION This module implements universal FREEZE/THAW methodes for JSON and CBOR based message format classes. Unfortunately these modules can't take callbacks for these tasks but require to pollute UNIVERSAL namespace for this, so when loading several modules overriding these methodes by each other throw warnings. This module exist just to prevent these. =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright (C) 2005-2015 by Jörn Reder . This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Event-RPC-1.08/lib/Event/RPC/Message/CBOR.pm0000644000175000017500000000251112601717663017113 0ustar joernjoern# $Id: Message.pm,v 1.9 2014-01-28 15:40:10 joern Exp $ #----------------------------------------------------------------------- # Copyright (C) 2005-2015 by Jörn Reder . # All Rights Reserved. See file COPYRIGHT for details. # # This module is part of Event::RPC, which is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. #----------------------------------------------------------------------- package Event::RPC::Message::CBOR; use base Event::RPC::Message::SerialiserBase; use strict; use utf8; use CBOR::XS; my $cbor = CBOR::XS->new; sub decode_message { $cbor->decode($_[1]) } sub encode_message { $cbor->encode($_[1]) } 1; __END__ =encoding utf8 =head1 NAME Event::RPC::Message::CBOR - CBOR message formatting =head1 SYNOPSIS # Internal module. No documented public interface. =head1 DESCRIPTION This module implements the message formatting of Event::RPC using CBOR. Objects of this class are created internally by Event::RPC::Server and Event::RPC::Client and performs message passing over the network. =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright (C) 2005-2015 by Jörn Reder . This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Event-RPC-1.08/lib/Event/RPC/Message/Storable.pm0000644000175000017500000000311512601717663020142 0ustar joernjoern# $Id: Message.pm,v 1.9 2014-01-28 15:40:10 joern Exp $ #----------------------------------------------------------------------- # Copyright (C) 2005-2015 by Jörn Reder . # All Rights Reserved. See file COPYRIGHT for details. # # This module is part of Event::RPC, which is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. #----------------------------------------------------------------------- package Event::RPC::Message::Storable; use base Event::RPC::Message; use strict; use utf8; use Storable; sub decode_message { Storable::thaw($_[1]) } sub encode_message { Storable::nfreeze ($_[1]) } 1; __END__ =encoding utf8 =head1 NAME Event::RPC::Message::Storable - Storable message formatting =head1 SYNOPSIS # Internal module. No documented public interface. =head1 DESCRIPTION This module implements the message formatting of Event::RPC using Storable. Objects of this class are created internally by Event::RPC::Server and Event::RPC::Client and performs message passing over the network. =head1 IMPORTANT NOTE This module is shipped for client/server backward compatibility with Event::RPC prior to 1.06. Due to security considerations it's not recommended to use Storable in real world szenarios. Better use one of the other alternatives (Sereal, CBOR or JSON). =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright (C) 2005-2015 by Jörn Reder . This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Event-RPC-1.08/lib/Event/RPC/Message/Negotiate.pm0000644000175000017500000000532612601717663020314 0ustar joernjoern# $Id: Message.pm,v 1.9 2014-01-28 15:40:10 joern Exp $ #----------------------------------------------------------------------- # Copyright (C) 2005-2015 by Jörn Reder . # All Rights Reserved. See file COPYRIGHT for details. # # This module is part of Event::RPC, which is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. #----------------------------------------------------------------------- package Event::RPC::Message::Negotiate; use base Event::RPC::Message; use Carp; use strict; use utf8; my %MESSAGE_FORMATS = ( "SERL" => "Event::RPC::Message::Sereal", "CBOR" => "Event::RPC::Message::CBOR", "JSON" => "Event::RPC::Message::JSON", "STOR" => "Event::RPC::Message::Storable", ); my @MESSAGE_FORMAT_ORDER = qw( SERL CBOR JSON STOR ); sub known_message_formats { \%MESSAGE_FORMATS } sub message_format_order { \@MESSAGE_FORMAT_ORDER } my $STORABLE_FALLBACK_OK = 0; sub get_storable_fallback_ok { $STORABLE_FALLBACK_OK } sub set_storable_fallback_ok { $STORABLE_FALLBACK_OK = $_[1] } sub encode_message { my $self = shift; my ($decoded) = @_; my $ok = $decoded->{ok} || ""; my $msg = $decoded->{msg} || ""; my $cmd = $decoded->{cmd} || ""; s,/\d/,,g for ( $ok, $msg, $cmd ); return "/0/E:R:M:N/1/$ok/2/$msg/3/$cmd/0/"; } sub decode_message { my $self = shift; my ($encoded) = @_; return { ok => $1, msg => $2, cmd => $3 } if $encoded =~ m,^/0/E:R:M:N/1/(.*?)/2/(.*?)/3/(.*?)/0/$,; #-- An old client or server may not know our message #-- format negotiation protocol, so we provide a Storable #-- fallback mechanism, if we're allowed to do so. if ( $self->get_storable_fallback_ok ) { require Event::RPC::Message::Storable; bless $self, "Event::RPC::Message::Storable"; return $self->decode_message($encoded); } #-- No Storable fallback allowed. We bail out! die "Error on message format negotitation and no fallback to Storable allowed\n"; } 1; __END__ =encoding utf8 =head1 NAME Event::RPC::Message::Negotiate - Message format negotiation protocol =head1 SYNOPSIS # Internal module. No documented public interface. =head1 DESCRIPTION This module implements the message format negotitation protocol of Event::RPC. Objects of this class are created internally by Event::RPC::Server and Event::RPC::Client and performs message passing over the network. =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright (C) 2005-2015 by Jörn Reder . This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Event-RPC-1.08/lib/Event/RPC/Message/JSON.pm0000644000175000017500000000264212601717663017144 0ustar joernjoern# $Id: Message.pm,v 1.9 2014-01-28 15:40:10 joern Exp $ #----------------------------------------------------------------------- # Copyright (C) 2005-2015 by Jörn Reder . # All Rights Reserved. See file COPYRIGHT for details. # # This module is part of Event::RPC, which is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. #----------------------------------------------------------------------- package Event::RPC::Message::JSON; use base Event::RPC::Message::SerialiserBase; use strict; use utf8; use JSON::XS 3.0; my $decoder = JSON::XS->new->allow_tags; my $encoder = JSON::XS->new->latin1->allow_blessed->allow_tags; sub decode_message { $decoder->decode($_[1]) } sub encode_message { $encoder->encode($_[1]) } 1; __END__ =encoding utf8 =head1 NAME Event::RPC::Message::JSON - JSON message formatting =head1 SYNOPSIS # Internal module. No documented public interface. =head1 DESCRIPTION This module implements the message formatting of Event::RPC using JSON. Objects of this class are created internally by Event::RPC::Server and Event::RPC::Client and performs message passing over the network. =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright (C) 2005-2015 by Jörn Reder . This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Event-RPC-1.08/lib/Event/RPC/Connection.pm0000644000175000017500000004565512601717663017121 0ustar joernjoernpackage Event::RPC::Connection; use strict; use utf8; use Carp; use Event::RPC::Message::Negotiate; #-- This can be changed for testing purposes e.g. to simulate #-- old servers which don't perform any format negotitation. $Event::RPC::Server::DEFAULT_MESSAGE_FORMAT = "Event::RPC::Message::Negotiate"; my $CONNECTION_ID; sub get_cid { shift->{cid} } sub get_sock { shift->{sock} } sub get_server { shift->{server} } sub get_classes { shift->{server}->{classes} } sub get_loaded_classes { shift->{server}->{loaded_classes} } sub get_objects { shift->{server}->{objects} } sub get_client_oids { shift->{client_oids} } sub get_message_format { shift->{message_format} } sub get_watcher { shift->{watcher} } sub get_write_watcher { shift->{write_watcher} } sub get_message { shift->{message} } sub get_is_authenticated { shift->{is_authenticated} } sub get_auth_user { shift->{auth_user} } sub set_message_format { shift->{message_format} = $_[1] } sub set_watcher { shift->{watcher} = $_[1] } sub set_write_watcher { shift->{write_watcher} = $_[1] } sub set_message { shift->{message} = $_[1] } sub set_is_authenticated { shift->{is_authenticated} = $_[1] } sub set_auth_user { shift->{auth_user} = $_[1] } sub new { my $class = shift; my ($server, $sock) = @_; my $cid = ++$CONNECTION_ID; my $self = bless { cid => $cid, sock => $sock, server => $server, is_authenticated => (!$server->get_auth_required), auth_user => "", watcher => undef, write_watcher => undef, message => undef, client_oids => {}, message_format => $Event::RPC::Server::DEFAULT_MESSAGE_FORMAT, }, $class; if ( $sock ) { $self->log (2, "Got new RPC connection. Connection ID is $cid" ); $self->{watcher} = $self->get_server->get_loop->add_io_watcher ( fh => $sock, poll => 'r', cb => sub { $self->input; 1 }, desc => "rpc client cid=$cid", ); } my $connection_hook = $server->get_connection_hook; &$connection_hook($self, "connect") if $connection_hook; return $self; } sub disconnect { my $self = shift; $self->get_server->get_loop->del_io_watcher($self->get_watcher); $self->get_server->get_loop->del_io_watcher($self->get_write_watcher) if $self->get_write_watcher; $self->set_watcher(undef); $self->set_write_watcher(undef); close $self->get_sock; my $server = $self->get_server; $server->set_clients_connected ( $self->get_server->get_clients_connected - 1 ); foreach my $oid ( keys %{$self->get_client_oids} ) { $server->deregister_object($oid); } $self->log(2, "Client disconnected"); my $connection_hook = $server->get_connection_hook; &$connection_hook($self, "disconnect") if $connection_hook; 1; } sub get_client_object { my $self = shift; my ($oid) = @_; croak "No object registered with oid '$oid'" unless $self->get_client_objects->{$oid}; return $self->get_client_objects->{$oid}; } sub log { my $self = shift; my ($level, $msg); if ( @_ == 2 ) { ($level, $msg) = @_; } else { ($msg) = @_; $level = 1; } $msg = "cid=".$self->get_cid.": $msg"; return $self->get_server->log ($level, $msg); } sub input { my $self = shift; my ($e) = @_; my $server = $self->get_server; my $message = $self->get_message; if ( not $message ) { $message = $self->get_message_format->new ($self->get_sock); $self->set_message($message); } my $request = eval { $message->read } || ''; my $error = $@; return if $request eq '' && $error eq ''; $self->set_message(undef); return $self->disconnect if $request eq "DISCONNECT\n" or $error =~ /DISCONNECTED/; $server->set_active_connection($self); my ($cmd, $rc); $cmd = $request->{cmd} if not $error; $self->log(4, "RPC command: $cmd"); if ( $error ) { $self->log ("Unexpected error on incoming RPC call: $@"); $rc = { ok => 0, msg => "Unexpected error on incoming RPC call: $@", }; } elsif ( $cmd eq 'neg_formats_avail') { $rc = { ok => 1, msg => join(",", @{$self->get_server->get_message_formats}) }; } elsif ( $cmd eq 'neg_format_set') { $rc = $self->client_requests_message_format($request->{msg}); } elsif ( $cmd eq 'version' ) { #-- Probably we have fallen back to Storable because an old #-- client has connected. so we change the negotiation #-- message handler to the fallback handler for further #-- communication on this connection. $self->set_message_format(ref $message); $rc = { ok => 1, version => $Event::RPC::VERSION, protocol => $Event::RPC::PROTOCOL, }; } elsif ( $cmd eq 'auth' ) { $rc = $self->authorize_user ($request); } elsif ( $server->get_auth_required && !$self->get_is_authenticated ) { $rc = { ok => 0, msg => "Authorization required", }; } elsif ( $cmd eq 'new' ) { $rc = $self->create_new_object ($request); } elsif ( $cmd eq 'exec' ) { $rc = $self->execute_object_method ($request); } elsif ( $cmd eq 'classes_list' ) { $rc = $self->get_classes_list ($request); } elsif ( $cmd eq 'class_info' ) { $rc = $self->get_class_info ($request); } elsif ( $cmd eq 'class_info_all' ) { $rc = $self->get_class_info_all ($request); } elsif ( $cmd eq 'client_destroy' ) { $rc = $self->object_destroyed_on_client ($request); } else { $self->log ("Unknown request command '$cmd'"); $rc = { ok => 0, msg => "Unknown request command '$cmd'", }; } $server->set_active_connection(undef); $message->set_data($rc); my $watcher = $self->get_server->get_loop->add_io_watcher ( fh => $self->get_sock, poll => 'w', cb => sub { if ( $message->write ) { $self->get_server->get_loop->del_io_watcher($self->get_write_watcher) if $self->get_write_watcher; $self->set_write_watcher(); } 1; }, ); $self->set_write_watcher($watcher); 1; } sub client_requests_message_format { my $self = shift; my ($client_format) = @_; foreach my $format ( @{$self->get_server->get_message_formats} ) { if ( $client_format eq $format ) { $self->set_message_format( Event::RPC::Message::Negotiate->known_message_formats ->{$client_format} ); eval "use ".$self->get_message_format; return { ok => 0, msg => "Server rejected format '$client_format': $@" } if $@; return { ok => 1 }; } } return { ok => 0, msg => "Server rejected format '$client_format'" }; } sub authorize_user { my $self = shift; my ($request) = @_; my $user = $request->{user}; my $pass = $request->{pass}; my $auth_module = $self->get_server->get_auth_module; return { ok => 1, msg => "Not authorization required", } unless $auth_module; my $ok = $auth_module->check_credentials ($user, $pass); if ( $ok ) { $self->set_auth_user($user); $self->set_is_authenticated(1); $self->log("User '$user' successfully authorized"); return { ok => 1, msg => "Credentials Ok", }; } else { $self->log("Illegal credentials for user '$user'"); return { ok => 0, msg => "Illegal credentials", }; } } sub create_new_object { my $self = shift; my ($request) = @_; # Let's create a new object my $class_method = $request->{method}; my $class = $class_method; $class =~ s/::[^:]+$//; $class_method =~ s/^.*:://; # check if access to this class/method is allowed if ( not defined $self->get_classes->{$class}->{$class_method} or $self->get_classes->{$class}->{$class_method} ne '_constructor' ) { $self->log ("Illegal constructor access to $class->$class_method"); return { ok => 0, msg => "Illegal constructor access to $class->$class_method" }; } # ok, load class and execute the method my $object = eval { # load the class if not done yet $self->load_class($class) if $self->get_server->get_load_modules; # resolve object params $self->resolve_object_params ($request->{params}); $class->$class_method (@{$request->{params}}) }; # report error if ( $@ ) { $self->log ("Error: can't create object ". "($class->$class_method): $@"); return { ok => 0, msg => $@, }; } # register object $self->get_server->register_object ($object, $class); $self->get_client_oids->{"$object"} = 1; # log and return $self->log (5, "Created new object $class->$class_method with oid '$object'", ); return { ok => 1, oid => "$object", }; } sub load_class { my $self = shift; my ($class) = @_; my $mtime; my $load_class_info = $self->get_loaded_classes->{$class}; if ( not $load_class_info or ( $self->get_server->get_auto_reload_modules && ( $mtime = (stat($load_class_info->{filename}))[9]) > $load_class_info->{mtime} ) ) { if ( not $load_class_info->{filename} ) { my $filename; my $rel_filename = $class; $rel_filename =~ s!::!/!g; $rel_filename .= ".pm"; foreach my $dir ( @INC ) { $filename = "$dir/$rel_filename", last if -f "$dir/$rel_filename"; } croak "File for class '$class' not found\n" if not $filename; $load_class_info->{filename} = $filename; $load_class_info->{mtime} = 0; } $mtime ||= 0; $self->log (3, "Class '$class' ($load_class_info->{filename}) changed on disk. Reloading...") if $mtime > $load_class_info->{mtime}; do $load_class_info->{filename}; if ( $@ ) { $self->log ("Can't load class '$class': $@"); $load_class_info->{mtime} = 0; die "Can't load class $class: $@"; } else { $self->log (3, "Class '$class' successfully loaded"); $load_class_info->{mtime} = time; } } $self->log (5, "filename=".$load_class_info->{filename}. ", mtime=".$load_class_info->{mtime} ); $self->get_loaded_classes->{$class} ||= $load_class_info; 1; } sub execute_object_method { my $self = shift; my ($request) = @_; # Method call of an existent object my $oid = $request->{oid}; my $object_entry = $self->get_objects->{$oid}; my $method = $request->{method}; if ( not defined $object_entry ) { # object does not exist $self->log ("Illegal access to unknown object with oid=$oid"); return { ok => 0, msg => "Illegal access to unknown object with oid=$oid" }; } my $class = $object_entry->{class}; if ( not defined $self->get_classes->{$class} or not defined $self->get_classes->{$class}->{$method} ) { # illegal access to this method $self->log ("Illegal access to $class->$method"); return { ok => 0, msg => "Illegal access to $class->$method" }; } my $return_type = $self->get_classes->{$class}->{$method}; # ok, try loading class and executing the method my @rc = eval { # (re)load the class if not done yet $self->load_class($class) if $self->get_server->get_load_modules; # resolve object params $self->resolve_object_params ($request->{params}); # exeute method $object_entry->{object}->$method (@{$request->{params}}) }; # report error if ( $@ ) { $self->log ("Error: can't call '$method' of object ". "with oid=$oid: $@"); return { ok => 0, msg => "$@", }; } # log $self->log (4, "Called method '$method' of object ". "with oid=$oid"); if ( $return_type eq '_object' ) { # check if objects are returned by this method # and register them in our internal object table # (if not already done yet) my $key; foreach my $rc ( @rc ) { if ( ref ($rc) and ref ($rc) !~ /ARRAY|HASH|SCALAR/ ) { # returns a single object $self->log (4, "Method returns object: $rc"); $key = "$rc"; $self->get_client_oids->{$key} = 1; $self->get_server->register_object($rc, ref $rc); $rc = $key; } elsif ( ref $rc eq 'ARRAY' ) { # possibly returns a list of objects # make a copy, otherwise the original object references # will be overwritten my @val = @{$rc}; $rc = \@val; foreach my $val ( @val ) { if ( ref ($val) and ref ($val) !~ /ARRAY|HASH|SCALAR/ ) { $self->log (4, "Method returns object lref: $val"); $key = "$val"; $self->get_client_oids->{$key} = 1; $self->get_server->register_object($val, ref $val); $val = $key; } } } elsif ( ref $rc eq 'HASH' ) { # possibly returns a hash of objects # make a copy, otherwise the original object references # will be overwritten my %val = %{$rc}; $rc = \%val; foreach my $val ( values %val ) { if ( ref ($val) and ref ($val) !~ /ARRAY|HASH|SCALAR/ ) { $self->log (4, "Method returns object href: $val"); $key = "$val"; $self->get_client_oids->{$key} = 1; $self->get_server->register_object($val, ref $val); $val = $key; } } } } } # return rc return { ok => 1, rc => \@rc, }; } sub object_destroyed_on_client { my $self = shift; my ($request) = @_; $self->log(5, "Object with oid=$request->{oid} destroyed on client"); delete $self->get_client_oids->{$request->{oid}}; $self->get_server->deregister_object($request->{oid}); return { ok => 1 }; } sub get_classes_list { my $self = shift; my ($request) = @_; my @classes = keys %{$self->get_classes}; return { ok => 1, classes => \@classes, } } sub get_class_info { my $self = shift; my ($request) = @_; my $class = $request->{class}; if ( not defined $self->get_classes->{$class} ) { $self->log ("Unknown class '$class'"); return { ok => 0, msg => "Unknown class '$class'" }; } $self->log (4, "Class info for '$class' requested"); return { ok => 1, methods => $self->get_classes->{$class}, }; } sub get_class_info_all { my $self = shift; my ($request) = @_; return { ok => 1, class_info_all => $self->get_classes, } } sub resolve_object_params { my $self = shift; my ($params) = @_; my $key; foreach my $par ( @{$params} ) { if ( defined $self->get_classes->{ref($par)} ) { $key = ${$par}; $key = "$key"; croak "unknown object with key '$key'" if not defined $self->get_objects->{$key}; $par = $self->get_objects->{$key}->{object}; } } 1; } 1; __END__ =encoding utf8 =head1 NAME Event::RPC::Connection - Represents a RPC connection =head1 SYNOPSIS Note: you never create instances of this class in your own code, it's only used internally by Event::RPC::Server. But you may request connection objects using the B of Event::RPC::Server and then having some read access on them. my $connection = Event::RPC::Server::Connection->new ( $rpc_server, $client_socket ); As well you can get the currently active connection from your Event::RPC::Server object: my $server = Event::RPC::Server->instance; my $connection = $server->get_active_connection; =head1 DESCRIPTION Objects of this class represents a connection from an Event::RPC::Client to an Event::RPC::Server instance. They live inside the server and the whole Client/Server protocol is implemented here. =head1 READ ONLY ATTRIBUTES The following attributes may be read using the corresponding get_ATTRIBUTE accessors: =over 4 =item B The connection ID of this connection. A number which is unique for this server instance. =item B The Event::RPC::Server instance this connection belongs to. =item B This boolean value reflects whether the connection is authenticated resp. whether the client passed correct credentials. =item B This is the name of the user who was authenticated successfully for this connection. =item B This is a hash reference of object id's which are in use by the client of this connection. Keys are the object ids, value is always 1. You can get the corresponding objects by using the $connection->get_client_object($oid) method. Don't change anything in this hash, in particular don't delete or add entries. Event::RPC does all the necessary garbage collection transparently, no need to mess with that. =back =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright (C) 2005-2015 by Jörn Reder . This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Event-RPC-1.08/lib/Event/RPC/LogConnection.pm0000644000175000017500000000440612601717663017550 0ustar joernjoernpackage Event::RPC::LogConnection; use Carp; use strict; use utf8; use Socket; my $LOG_CONNECTION_ID; sub get_cid { shift->{cid} } sub get_sock { shift->{sock} } sub get_server { shift->{server} } sub get_watcher { shift->{watcher} } sub set_watcher { shift->{watcher} = $_[1] } sub new { my $class = shift; my ($server, $sock) = @_; my $cid = ++$LOG_CONNECTION_ID; my $self = bless { cid => $cid, sock => $sock, server => $server, watcher => undef, }, $class; $self->{watcher} = $server->get_loop->add_io_watcher( fh => $sock, poll => 'r', cb => sub { $self->input; 1 }, desc => "log reader $cid", ); $self->get_server->log (2, "Got new logger connection. Connection ID is $cid" ); return $self; } sub disconnect { my $self = shift; my $sock = $self->get_sock; $self->get_server->get_logger->remove_fh($sock) if $self->get_server->get_logger; $self->get_server->get_loop->del_io_watcher($self->get_watcher); $self->set_watcher(undef); close $sock; $self->get_server->set_log_clients_connected ( $self->get_server->get_log_clients_connected - 1 ); delete $self->get_server->get_logging_clients->{$self->get_cid}; $self->get_server->log(2, "Log client disconnected"); 1; } sub input { my $self = shift; my $buffer; $self->disconnect if not sysread($self->get_sock, $buffer, 4096); 1; } 1; __END__ =encoding utf8 =head1 NAME Event::RPC::LogConnection - Represents a logging connection =head1 SYNOPSIS # Internal module. No documented public interface. =head1 DESCRIPTION Objects of this class are created by Event::RPC server if a client connects to the logging port of the server. It's an internal module and has no public interface. =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright (C) 2005-2015 by Jörn Reder . This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Event-RPC-1.08/lib/Event/RPC/Logger.pm0000644000175000017500000001052012601717663016220 0ustar joernjoern#----------------------------------------------------------------------- # Copyright (C) 2005-2015 by Jörn Reder . # All Rights Reserved. See file COPYRIGHT for details. # # This module is part of Event::RPC, which is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. #----------------------------------------------------------------------- package Event::RPC::Logger; use strict; use utf8; use FileHandle; sub get_filename { shift->{filename} } sub get_filename_fh { shift->{filename_fh} } sub get_fh_lref { shift->{fh_lref} } sub get_min_level { shift->{min_level} } sub set_fh_lref { shift->{fh_lref} = $_[1] } sub set_min_level { shift->{min_level} = $_[1] } sub new { my $class = shift; my %par = @_; my ($filename, $fh_lref, $min_level) = @par{'filename','fh_lref','min_level'}; my $filename_fh; if ( $filename ) { $filename_fh = FileHandle->new; open ($filename_fh, ">>$filename") or die "can't write log $filename"; $filename_fh->autoflush(1); } if ( $fh_lref ) { foreach my $fh ( @{$fh_lref} ) { my $old_fh = select $fh; $| = 1; select $old_fh; } } else { $fh_lref = []; } my $self = bless { filename => $filename, filename_fh => $filename_fh, fh_lref => $fh_lref, min_level => $min_level, }, $class; return $self; } sub DESTROY { my $self = shift; my $filename_fh = $self->get_filename_fh; close $filename_fh if $filename_fh; 1; } sub log { my $self = shift; my ($level, $msg); if ( @_ == 2 ) { $level = $_[0]; $msg = $_[1]; } else { $level = 1; $msg = $_[0]; } return if $level > $self->get_min_level; $msg .= "\n" if $msg !~ /\n$/; my $str = localtime(time)." [$level] $msg"; for my $fh ( @{$self->get_fh_lref} ) { print $fh $str if $fh; } my $fh = $self->get_filename_fh; print $fh $str if $fh; 1; } sub add_fh { my $self = shift; my ($fh) = @_; push @{$self->get_fh_lref}, $fh; 1; } sub remove_fh { my $self = shift; my ($fh) = @_; my $fh_lref = $self->get_fh_lref; my $i; for ( $i=0; $i<@{$fh_lref}; ++$i ) { last if $fh_lref->[$i] eq $fh; } return if $i == @{$fh_lref}; splice @{$fh_lref}, $i, 1; 1; } 1; __END__ =encoding utf8 =head1 NAME Event::RPC::Logger - Logging facility for Event::RPC =head1 SYNOPSIS use Event::RPC::Server; use Event::RPC::Logger; my $server = Event::RPC::Server->new ( ... logger => Event::RPC::Logger->new( filename => "/var/log/myserver.log", fh_lref => [ $fh, $sock ], min_level => 2, ), ... ); $server->start; =head1 DESCRIPTION This modules implements a simple logging facility for the Event::RPC framework. Log messages may be written to a specific file and/or a bunch of filehandles, which may be sockets as well. =head1 CONFIGURATION OPTIONS This is a list of options you can pass to the new() constructor: =over 4 =item B All log messages are appended to this file. =item B All log messages are printed into this list of filehandles. =item B This is the minimum log level. Output of messages with a lower level is suppressed. This option may be altered using set_min_level() even in a running server. =back =head1 METHODS =over 4 =item $logger->B ( [$level, ] $msg ) The log() method does the actual logging. Called with one argument the messages gets the default level of 1. With two argumens the first is the level for the message. =item $logger->B ( $fh ) This adds a filehandle to the internal list of filhandles all log messages are written to. =item $logger->B ( $fh ) Removes a filehandle. =back =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright (C) 2005-2015 by Jörn Reder . This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Event-RPC-1.08/lib/Event/RPC/Server.pm0000644000175000017500000007573312601717663016270 0ustar joernjoern#----------------------------------------------------------------------- # Copyright (C) 2005-2015 by Jörn Reder . # All Rights Reserved. See file COPYRIGHT for details. # # This module is part of Event::RPC, which is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. #----------------------------------------------------------------------- package Event::RPC::Server; use Event::RPC; use Event::RPC::Connection; use Event::RPC::LogConnection; use Event::RPC::Message::Negotiate; use Carp; use strict; use utf8; use IO::Socket::INET; use Sys::Hostname; sub get_host { shift->{host} } sub get_port { shift->{port} } sub get_name { shift->{name} } sub get_loop { shift->{loop} } sub get_classes { shift->{classes} } sub get_singleton_classes { shift->{singleton_classes} } sub get_loaded_classes { shift->{loaded_classes} } sub get_clients_connected { shift->{clients_connected} } sub get_log_clients_connected { shift->{log_clients_connected} } sub get_logging_clients { shift->{logging_clients} } sub get_logger { shift->{logger} } sub get_start_log_listener { shift->{start_log_listener} } sub get_objects { shift->{objects} } sub get_rpc_socket { shift->{rpc_socket} } sub get_ssl { shift->{ssl} } sub get_ssl_key_file { shift->{ssl_key_file} } sub get_ssl_cert_file { shift->{ssl_cert_file} } sub get_ssl_passwd_cb { shift->{ssl_passwd_cb} } sub get_ssl_opts { shift->{ssl_opts} } sub get_auth_required { shift->{auth_required} } sub get_auth_passwd_href { shift->{auth_passwd_href} } sub get_auth_module { shift->{auth_module} } sub get_listeners_started { shift->{listeners_started} } sub get_connection_hook { shift->{connection_hook} } sub get_load_modules { shift->{load_modules} } sub get_auto_reload_modules { shift->{auto_reload_modules} } sub get_active_connection { shift->{active_connection} } sub get_message_formats { shift->{message_formats} } sub get_insecure_msg_fmt_ok { shift->{insecure_msg_fmt_ok} } sub set_host { shift->{host} = $_[1] } sub set_port { shift->{port} = $_[1] } sub set_name { shift->{name} = $_[1] } sub set_loop { shift->{loop} = $_[1] } sub set_classes { shift->{classes} = $_[1] } sub set_singleton_classes { shift->{singleton_classes} = $_[1] } sub set_loaded_classes { shift->{loaded_classes} = $_[1] } sub set_clients_connected { shift->{clients_connected} = $_[1] } sub set_log_clients_connected { shift->{log_clients_connected}= $_[1] } sub set_logging_clients { shift->{logging_clients} = $_[1] } sub set_logger { shift->{logger} = $_[1] } sub set_start_log_listener { shift->{start_log_listener} = $_[1] } sub set_objects { shift->{objects} = $_[1] } sub set_rpc_socket { shift->{rpc_socket} = $_[1] } sub set_ssl { shift->{ssl} = $_[1] } sub set_ssl_key_file { shift->{ssl_key_file} = $_[1] } sub set_ssl_cert_file { shift->{ssl_cert_file} = $_[1] } sub set_ssl_passwd_cb { shift->{ssl_passwd_cb} = $_[1] } sub set_ssl_opts { shift->{ssl_opts} = $_[1] } sub set_auth_required { shift->{auth_required} = $_[1] } sub set_auth_passwd_href { shift->{auth_passwd_href} = $_[1] } sub set_auth_module { shift->{auth_module} = $_[1] } sub set_listeners_started { shift->{listeners_started} = $_[1] } sub set_connection_hook { shift->{connection_hook} = $_[1] } sub set_load_modules { shift->{load_modules} = $_[1] } sub set_auto_reload_modules { shift->{auto_reload_modules} = $_[1] } sub set_active_connection { shift->{active_connection} = $_[1] } sub set_message_formats { shift->{message_formats} = $_[1] } sub set_insecure_msg_fmt_ok { shift->{insecure_msg_fmt_ok} = $_[1] } my $INSTANCE; sub instance { $INSTANCE } sub get_max_packet_size { return Event::RPC::Message->get_max_packet_size; } sub set_max_packet_size { my $class = shift; my ($value) = @_; Event::RPC::Message->set_max_packet_size($value); } sub new { my $class = shift; my %par = @_; my ($host, $port, $classes, $name, $logger, $start_log_listener) = @par{'host','port','classes','name','logger','start_log_listener'}; my ($ssl, $ssl_key_file, $ssl_cert_file, $ssl_passwd_cb, $ssl_opts) = @par{'ssl','ssl_key_file','ssl_cert_file','ssl_passwd_cb','ssl_opts'}; my ($auth_required, $auth_passwd_href, $auth_module, $loop) = @par{'auth_required','auth_passwd_href','auth_module','loop'}; my ($connection_hook, $auto_reload_modules) = @par{'connection_hook','auto_reload_modules'}; my ($load_modules, $message_formats, $insecure_msg_fmt_ok) = @par{'load_modules','message_formats','insecure_msg_fmt_ok'}; $name ||= "Event-RPC-Server"; $insecure_msg_fmt_ok = 1 unless defined $insecure_msg_fmt_ok; #-- for backwards compatibility 'load_modules' defaults to 1 if ( !exists $par{load_modules} ) { $load_modules = 1; } if ( not $loop ) { foreach my $impl ( qw/AnyEvent Event Glib/ ) { $loop = "Event::RPC::Loop::$impl"; eval "use $loop"; if ( $@ ) { $loop = undef; } else { $loop = $loop->new; last; } } die "It seems no supported event loop module is installed" unless $loop; } my $self = bless { host => $host, port => $port, name => $name, classes => $classes, singleton_classes => {}, logger => $logger, start_log_listener => $start_log_listener, loop => $loop, ssl => $ssl, ssl_key_file => $ssl_key_file, ssl_cert_file => $ssl_cert_file, ssl_passwd_cb => $ssl_passwd_cb, ssl_opts => $ssl_opts, auth_required => $auth_required, auth_passwd_href => $auth_passwd_href, auth_module => $auth_module, load_modules => $load_modules, auto_reload_modules => $auto_reload_modules, connection_hook => $connection_hook, message_formats => $message_formats, insecure_msg_fmt_ok => $insecure_msg_fmt_ok, rpc_socket => undef, loaded_classes => {}, objects => {}, logging_clients => {}, clients_connected => 0, listeners_started => 0, log_clients_connected => 0, active_connection => undef, }, $class; $INSTANCE = $self; $self->log ($self->get_name." started"); return $self; } sub DESTROY { my $self = shift; my $rpc_socket = $self->get_rpc_socket; close ($rpc_socket) if $rpc_socket; 1; } sub probe_message_formats { my $class = shift; my ($user_supplied_formats, $insecure_msg_fmt_ok) = @_; my $order_lref = Event::RPC::Message::Negotiate->message_format_order; my $modules_by_name = Event::RPC::Message::Negotiate->known_message_formats; my %probe_formats; if ( $user_supplied_formats ) { @probe_formats{@{$user_supplied_formats}} = (1) x @{$user_supplied_formats}; } else { %probe_formats = %{$modules_by_name}; } #-- By default we probe all supported formats, but #-- not Storable. User has to activate this explicitely. if ( not $insecure_msg_fmt_ok ) { delete $probe_formats{STOR}; } Event::RPC::Message::Negotiate->set_storable_fallback_ok($insecure_msg_fmt_ok); my @supported_formats; foreach my $name ( @{$order_lref} ) { next unless $probe_formats{$name}; my $module = $modules_by_name->{$name}; eval "use $module"; push @supported_formats, $name unless $@; } return \@supported_formats; } sub setup_listeners { my $self = shift; #-- Listener options my $host = $self->get_host; my $port = $self->get_port; my @LocalHost = $host ? ( LocalHost => $host ) : (); $host ||= "*"; #-- get event loop manager my $loop = $self->get_loop; #-- setup rpc listener my $rpc_socket; if ( $self->get_ssl ) { eval { require IO::Socket::SSL }; croak "SSL requested, but IO::Socket::SSL not installed" if $@; croak "ssl_key_file not set" unless $self->get_ssl_key_file; croak "ssl_cert_file not set" unless $self->get_ssl_cert_file; my $ssl_opts = $self->get_ssl_opts; $rpc_socket = IO::Socket::SSL->new ( Listen => SOMAXCONN, @LocalHost, LocalPort => $port, Proto => 'tcp', ReuseAddr => 1, SSL_key_file => $self->get_ssl_key_file, SSL_cert_file => $self->get_ssl_cert_file, SSL_passwd_cb => $self->get_ssl_passwd_cb, ($ssl_opts?%{$ssl_opts}:()), ) or die "can't start SSL RPC listener: $IO::Socket::SSL::ERROR"; } else { $rpc_socket = IO::Socket::INET->new ( Listen => SOMAXCONN, @LocalHost, LocalPort => $port, Proto => 'tcp', ReuseAddr => 1, ) or die "can't start RPC listener: $!"; } $self->set_rpc_socket($rpc_socket); $loop->add_io_watcher ( fh => $rpc_socket, poll => 'r', cb => sub { $self->accept_new_client($rpc_socket); 1 }, desc => "rpc listener port $port", ); if ( $self->get_ssl ) { $self->log ("Started SSL RPC listener on port $host:$port"); } else { $self->log ("Started RPC listener on $host:$port"); } # setup log listener if ( $self->get_start_log_listener ) { my $log_socket = IO::Socket::INET->new ( Listen => SOMAXCONN, LocalPort => $port + 1, @LocalHost, Proto => 'tcp', ReuseAddr => 1, ) or die "can't start log listener: $!"; $loop->add_io_watcher ( fh => $log_socket, poll => 'r', cb => sub { $self->accept_new_log_client($log_socket); 1 }, desc => "log listener port ".($port+1), ); $self->log ("Started log listener on $host:".($port+1)); } $self->determine_singletons; $self->set_listeners_started(1); 1; } sub setup_auth_module { my $self = shift; #-- Exit if no auth is required or setup already return if not $self->get_auth_required; return if $self->get_auth_module; #-- Default to Event::RPC::AuthPasswdHash require Event::RPC::AuthPasswdHash; #-- Setup an instance my $passwd_href = $self->get_auth_passwd_href; my $auth_module = Event::RPC::AuthPasswdHash->new ($passwd_href); $self->set_auth_module($auth_module); 1; } sub start { my $self = shift; $self->setup_listeners unless $self->get_listeners_started; $self->setup_auth_module; #-- Filter unsupported message formats $self->set_message_formats( $self->probe_message_formats( $self->get_message_formats, $self->get_insecure_msg_fmt_ok ) ); my $loop = $self->get_loop; $self->log ("Enter main loop using ".ref($loop)); $loop->enter; $self->log ("Server stopped"); 1; } sub stop { my $self = shift; $self->get_loop->leave; 1; } sub determine_singletons { my $self = shift; my $classes = $self->get_classes; my $singleton_classes = $self->get_singleton_classes; foreach my $class ( keys %{$classes} ) { foreach my $method ( keys %{$classes->{$class}} ) { # check for singleton returner if ( $classes->{$class}->{$method} eq '_singleton' ) { # change to constructor $classes->{$class}->{$method} = '_constructor'; # track that this class is a singleton $singleton_classes->{$class} = 1; last; } } } 1; } sub accept_new_client { my $self = shift; my ($rpc_socket) = @_; my $client_socket = $rpc_socket->accept or return; Event::RPC::Connection->new ($self, $client_socket); $self->set_clients_connected ( 1 + $self->get_clients_connected ); 1; } sub accept_new_log_client { my $self = shift; my ($log_socket) = @_; my $client_socket = $log_socket->accept or return; my $log_client = Event::RPC::LogConnection->new($self, $client_socket); $self->set_log_clients_connected ( 1 + $self->get_log_clients_connected ); $self->get_logging_clients->{$log_client->get_cid} = $log_client; $self->get_logger->add_fh($client_socket) if $self->get_logger; $self->log(2, "New log client connected"); 1; } sub load_class { my $self = shift; my ($class) = @_; Event::RPC::Connection->new ($self)->load_class($class); return $class; } sub log { my $self = shift; my $logger = $self->get_logger; return unless $logger; $logger->log(@_); 1; } sub remove_object { my $self = shift; my ($object) = @_; my $objects = $self->get_objects; if ( not $objects->{"$object"} ) { warn "Object $object not registered"; return; } delete $objects->{"$object"}; $self->log(5, "Object '$object' removed"); 1; } sub register_object { my $self = shift; my ($object, $class) = @_; my $objects = $self->get_objects; my $refcount; if ( $objects->{"$object"} ) { $refcount = ++$objects->{"$object"}->{refcount}; } else { $refcount = 1; $objects->{"$object"} = { object => $object, class => $class, refcount => 1, }; } $self->log(5, "Object '$object' registered. Refcount=$refcount"); 1; } sub deregister_object { my $self = shift; my ($object) = @_; my $objects = $self->get_objects; if ( not $objects->{"$object"} ) { warn "Object $object not registered"; return; } my $refcount = --$objects->{"$object"}->{refcount}; my ($class) = split(/=/, $object); if ( $self->get_singleton_classes->{$class} ) { # never deregister singletons $self->log(4, "Skip deregistration of singleton '$object'"); return; } $self->log(5, "Object '$object' deregistered. Refcount=$refcount"); $self->remove_object($object) if $refcount == 0; 1; } sub print_object_register { my $self = shift; print "-"x70,"\n"; my $objects = $self->get_objects; foreach my $oid ( sort keys %{$objects} ) { print "$oid\t$objects->{$oid}->{refcount}\n"; } 1; } 1; __END__ =encoding utf8 =head1 NAME Event::RPC::Server - Simple API for event driven RPC servers =head1 SYNOPSIS use Event::RPC::Server; use My::TestModule; my $server = Event::RPC::Server->new ( #-- Required arguments port => 8888, classes => { "My::TestModule" => { new => "_constructor", get_data => 1, set_data => 1, clone => "_object", }, }, #-- Optional arguments name => "Test server", logger => Event::RPC::Logger->new(), start_log_listener => 1, ssl => 1 ssl_key_file => "server.key", ssl_cert_file => "server.crt", ssl_passwd_cb => sub { "topsecret" }, ssl_opts => { ... }, auth_required => 1, auth_passwd_href => { $user => Event::RPC->crypt($user,$pass) }, auth_module => Your::Own::Auth::Module->new(...), loop => Event::RPC::Loop::Event->new(), host => "localhost", load_modules => 1, auto_reload_modules => 1, connection_hook => sub { ... }, message_formats => [qw/ SERL CBOR JSON STOR /], insecure_msg_fmt_ok => 1, ); $server->set_max_packet_size(2*1024*1024*1024); $server->start; # and later from inside your server implementation Event::RPC::Server->instance->stop; =head1 DESCRIPTION Use this module to add a simple to use RPC mechanism to your event driven server application. Just create an instance of the Event::RPC::Server class with a bunch of required settings. Then enter the main event loop through it, or take control over the main loop on your own if you like (refer to the MAINLOOP chapter for details). General information about the architecture of Event::RPC driven applications is collected in the Event::RPC manpage. =head1 CONFIGURATION OPTIONS All options described here may be passed to the new() constructor of Event::RPC::Server. As well you may set or modify them using set_OPTION style mutators, but not after start() or setup_listeners() was called! All options may be read using get_OPTION style accessors. =head2 REQUIRED OPTIONS If you just pass the required options listed beyond you have a RPC server which listens to a network port and allows everyone connecting to it to access a well defined list of classes and methods resp. using the correspondent server objects. There is no authentication or encryption active in this minimal configuration, so aware that this may be a big security risk! Adding security is easy, refer to the chapters about SSL and authentication. These are the required options: =over 4 =item B TCP port number of the RPC listener. =item B This is a hash ref with the following structure: classes => { "Class1" => { new => "_constructor", simple_method => 1, object_returner => "_object", }, "Class2" => { ... }, ... }, Each class which should be accessible for clients needs to be listed here at the first level, assigned a hash of methods allowed to be called. Event::RPC disuinguishes three types of methods by classifying their return value: =over 4 =item B A constructor method creates a new object of the corresponding class and returns it. You need to assign the string "_constructor" to the method entry to mark a method as a constructor. =item B For singleton classes the method which returns the singleton instance should be declared with "_singleton". This way the server takes care that references get never destroyed on server side. =item B What's simple about these methods is their return value: it's a scalar, array, hash or even any complex reference structure (Ok, not simple anymore ;), but in particular it returns B objects, because this needs to handled specially (see below). Declare simple methods by assigning 1 in the method declaration. =item B Methods which return objects need to be declared by assigning "_object" to the method name here. They're not bound to return just one scalar object reference and may return an array or list reference with a bunch of objects as well. =back =back =head2 SSL OPTIONS The client/server protocol of Event::RPC is not encrypted by default, so everyone listening on your network can read or even manipulate data. To prevent this efficiently you can enable SSL encryption. Event::RPC uses the IO::Socket::SSL Perl module for this. First you need to generate a server key and certificate for your server using the openssl command which is part of the OpenSSL distribution, e.g. by issueing these commands (please refer to the manpage of openssl for details - this is a very rough example, which works in general, but probably you want to tweak some parameters): % openssl genrsa -des3 -out server.key 1024 % openssl req -new -key server.key -out server.csr % openssl x509 -req -days 3600 -in server.csr \ -signkey server.key -out server.crt After executing these commands you have the following files server.crt server.key server.csr Event::RPC needs the first two of them to operate with SSL encryption. To enable SSL encryption you need to pass the following options to the constructor: =over 4 =item B The ssl option needs to be set to 1. =item B This is the filename of the server.key you generated with the openssl command. =item B This is the filename of the server.crt file you generated with the openssl command. =item B Your server key is encrypted with a password you entered during the key creation process described above. This callback must return it. Depending on how critical your application is you probably must request the password from the user during server startup or place it into a more or less secured file. For testing purposes you can specify a simple anonymous sub here, which just returns the password, e.g. ssl_passwd_cb => sub { return "topsecret" } But note: having the password in plaintext in your program code is insecure! =item B This optional parameter takes a hash reference of options passed to IO::Socket::SSL->new(...) to have more control over the server SSL listener. =back =head2 AUTHENTICATION OPTIONS SSL encryption is fine, now it's really hard for an attacker to listen or modify your network communication. But without any further configuration any user on your network is able to connect to your server. To prevent this users resp. connections to your server needs to be authenticated somehow. Since version 0.87 Event::RPC has an API to delegate authentication tasks to a module, which can be implemented outside Event::RPC. To be compatible with prior releases it ships the module Event::RPC::AuthPasswdHash which implements the old behaviour transparently. This default implementation is a simple user/password based model. For now this controls just the right to connect to your server, so knowing one valid user/password pair is enough to access all exported methods of your server. Probably a more differentiated model will be added later which allows granting access to a subset of exported methods only for each user who is allowed to connect. The following options control the authentication: =over 4 =item B Set this to 1 to enable authentication and nobody can connect your server until he passes a valid user/password pair. =item B If you like to use the builtin Event::RPC::AuthPasswdHash module simply set this attribute. If you decide to use B (explained beyound) it's not necessary. B is a hash of valid user/password pairs. The password stored here needs to be encrypted using Perl's crypt() function, using the username as the salt. Event::RPC has a convenience function for generating such a crypted password, although it's currently just a 1:1 wrapper around Perl's builtin crypt() function, but probably this changes someday, so better use this method: $crypted_pass = Event::RPC->crypt($user, $pass); This is a simple example of setting up a proper B with two users: auth_passwd_href => { fred => Event::RPC->crypt("fred", $freds_password), nick => Event::RPC->crypt("nick", $nicks_password), }, =item B If you like to implement a more complex authentication method yourself you may set the B attribute to an instance of your class. For now your implementation just needs to have this method: $auth_module->check_credentials($user, $pass) Aware that $pass is encrypted as explained above, so your original password needs to by crypted using Event::RPC->crypt as well, at least for the comparison itself. =back B you can use the authentication module without SSL but aware that an attacker listening to the network connection will be able to grab the encrypted password token and authenticate himself with it to the server (replay attack). Probably a more sophisticated challenge/response mechanism will be added to Event::RPC to prevent this. But you definitely should use SSL encryption in a critical environment anyway, which renders grabbing the password from the net impossible. =head2 LOGGING OPTIONS Event::RPC has some logging abilities, primarily for debugging purposes. It uses a B for this, which is an object implementing the Event::RPC::Logger interface. The documentation of Event::RPC::Logger describes this interface and Event::RPC's logging facilities in general. =over 4 =item B To enable logging just pass such an Event::RPC::Logger object to the constructor. =item B Additionally Event::RPC can start a log listener on the server's port number incremented by 1. All clients connected to this port (e.g. by using telnet) get the server's log output. Note: currently the logging port supports neither SSL nor authentication, so be careful enabling the log listener in critical environments. =back =head2 MAINLOOP OPTIONS Event::RPC derived it's name from the fact that it follows the event driven paradigm. There are several toolkits for Perl which allow event driven software development. Event::RPC has an abstraction layer for this and thus should be able to work with any toolkit. =over 4 =item B This option takes an object of the loop abstraction layer you want to use. Currently the following modules are implemented: Event::RPC::Loop::AnyEvent Use the AnyEvent module Event::RPC::Loop::Event Use the Event module Event::RPC::Loop::Glib Use the Glib module If B isn't set, Event::RPC::Server tries all supported modules in a row and aborts the program, if no module was found. More modules will be added in the future. If you want to implement one just take a look at the code in the modules above: it's really easy and I appreciate your patch. The interface is roughly described in the documentation of Event::RPC::Loop. =back If you use the Event::RPC->start() method as described in the SYNOPSIS Event::RPC will enter the correspondent main loop for you. If you want to have full control over the main loop, use this method to setup all necessary Event::RPC listeners: $rpc_server->setup_listeners(); and manage the main loop stuff on your own. =head2 MESSAGE FORMAT OPTIONS Event::RPC supports different CPAN modules for data serialisation, named "message formats" here: SERL -- Sereal::Encoder, Sereal::Decoder CBOR -- CBOR::XS JSON -- JSON::XS STOR -- Storable Server and client negotiate automatically which format is best to use but you can manipulate this behaviour with the following options: =over 4 =item B This takes an array of format identifiers from the list above. Event::RPC::Server will only use / accept these formats. =item B The Storable module is known to be insecure. But for backward compatibility reasons Event::RPC::Server accepts clients which can't offer anything but Storable. You can prevent that by setting this option explicitely to 0. It's enabled by default. =back =head2 MISCELLANEOUS OPTIONS =over 4 =item B By default the network listeners are bound to all interfaces in the system. Use the host option to bind to a specific interface, e.g. "localhost" if you efficiently want to prevent network clients from accessing your server. =item B Control whether the class module files should be loaded automatically when first accesed by a client. This options defaults to true, for backward compatibility reasons. =item B If this option is set Event::RPC::Server will check on each method call if the corresponding module changed on disk and reloads it automatically. Of course this has an effect on performance, but it's very useful during development. You probably shouldn't enable this in production environments. =item B This callback is called on each connection / disconnection with two arguments: the Event::RPC::Connection object and a string containing either "connect" or "disconnect" depending what's currently happening with this connection. =back =head1 METHODS The following methods are publically available: =over 4 =item Event::RPC::Server->B This returns the latest created Event::RPC::Server instance (usually you have only one instance in one program). =item $rpc_server->B Start the mainloop of your Event::RPC::Server. =item $rpc_server->B Stops the mainloop which usually means, that the server exits, as long you don't do more sophisticated mainloop stuff by your own. =item $rpc_server->B This method initializes all networking listeners needed for Event::RPC::Server to work, using the configured loop module. Use this method if you don't use the start() method but manage the mainloop on your own. =item $rpc_server->B ( [$level,] $msg ) Convenience method for logging. It simply passes the arguments to the configured logger's log() method. =item $rpc_server->B Returns the number of currently connected Event::RPC clients. =item $rpc_server->B Returns the number of currently connected logging clients. =item $rpc_server->B This returns the currently active Event::RPC::Connection object representing the connection resp. the client which currently requests method invocation. This is undef if no client call is active. =item $rpc_client->B ( $bytes ) By default Event::RPC does not handle network packages which exceed 2 GB in size (was 4 MB with version 1.04 and earlier). You can change this value using this method at any time, but 4 GB is the maximum. An attempt of the server to send a bigger packet will be aborted and reported as an exception on the client and logged as an error message on the server. Note: you have to set the same value on client and server side! =item $rpc_client->B Returns the currently active max packet size. =back =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright (C) 2005-2015 by Jörn Reder . This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Event-RPC-1.08/lib/Event/RPC/Loop.pm0000644000175000017500000000726012601717663015721 0ustar joernjoern#----------------------------------------------------------------------- # Copyright (C) 2005-2015 by Jörn Reder . # All Rights Reserved. See file COPYRIGHT for details. # # This module is part of Event::RPC, which is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. #----------------------------------------------------------------------- package Event::RPC::Loop; use strict; use utf8; sub new { my $class = shift; return bless {}, $class; } 1; __END__ =encoding utf8 =head1 NAME Event::RPC::Loop - Mainloop Abstraction layer for Event::RPC =head1 SYNOPSIS use Event::RPC::Server; use Event::RPC::Loop::Glib; my $server = Event::RPC::Server->new ( ... loop => Event::RPC::Loop::Glib->new(), ... ); $server->start; =head1 DESCRIPTION This modules defines the interface of Event::RPC's mainloop abstraction layer. It's a virtual class all mainloop modules should inherit from. =head1 INTERFACE The following methods need to be implemented: =over 4 =item $loop->B () Enter resp. start a mainloop. =item $loop->B () Leave the mainloop, which was started with the enter() method. =item $watcher = $loop->B ( %options ) Add an I/O watcher. Options are passed as a hash of key/value pairs. The following options are known: =over 4 =item B The filehandle to be watched. =item B This callback is called, without any parameters, if an event occured on the filehandle above. =item B A description of the watcher. Not necessarily implemented by all modules, so it may be ignored. =item B Either 'r', if your program reads from the filehandle, or 'w' if it writes to it. =back A watcher object is returned. What this exactly is depends on the implementation, so you can't do anything useful with it besides passing it back to del_io_watcher(). =item $loop->B ( $watcher ) Deletes an I/O watcher which was added with $loop->add_io_watcher(). =item $timer = $loop->B ( %options ) This sets a timer, a subroutine called after a specific timeout or on a regularly basis with a fixed time interval. Options are passed as a hash of key/value pairs. The following options are known: =over 4 =item B A time interval in seconds, may be fractional. =item B Callback is called once after this amount of seconds, may be fractional. =item B The callback. =item B A description of the timer. Not necessarily implemented by all modules, so it may be ignored. =back A timer object is returned. What this exactly is depends on the implementation, so you can't do anything useful with it besides passing it back to del_io_timer(). =item $loop->B ( $timer ) Deletes a timer which was added with $loop->add_timer(). =back =head1 DIRECT USAGE IN YOUR SERVER You may use the methods of Event::RPC::Loop by yourself if you like. This way your program keeps independent of the actual mainloop module in use, if the simplified interface of Event::RPC::Loop is sufficient for you. In your server program you access the actual mainloop object this way: my $loop = Event::RPC::Server->instance->get_loop; Naturally nothing speaks against making your program to work only with a specific mainloop implementation, if you need its features. In that case you may use the corresponding API directly (e.g. of Event or Glib), no need to access it through Event::RPC::Loop. =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright (C) 2005-2015 by Jörn Reder . This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Event-RPC-1.08/lib/Event/RPC/Client.pm0000644000175000017500000006374712601717663016242 0ustar joernjoern#----------------------------------------------------------------------- # Copyright (C) 2005-2015 by Jörn Reder . # All Rights Reserved. See file COPYRIGHT for details. # # This module is part of Event::RPC, which is free software; you can # redistribute it and/or modify it under the same terms as Perl itself. #----------------------------------------------------------------------- package Event::RPC::Client; use Event::RPC; use Event::RPC::Message::Negotiate; use Carp; use strict; use utf8; use IO::Socket::INET; #-- This can be changed for testing purposes e.g. to simulate #-- old clients connecting straight with Storable format. $Event::RPC::Client::DEFAULT_MESSAGE_FORMAT = "Event::RPC::Message::Negotiate"; sub get_client_version { $Event::RPC::VERSION } sub get_client_protocol { $Event::RPC::PROTOCOL } sub get_host { shift->{host} } sub get_port { shift->{port} } sub get_sock { shift->{sock} } sub get_timeout { shift->{timeout} } sub get_classes { shift->{classes} } sub get_class_map { shift->{class_map} } sub get_loaded_classes { shift->{loaded_classes} } sub get_error_cb { shift->{error_cb} } sub get_ssl { shift->{ssl} } sub get_ssl_ca_file { shift->{ssl_ca_file} } sub get_ssl_ca_path { shift->{ssl_ca_path} } sub get_ssl_opts { shift->{ssl_opts} } sub get_auth_user { shift->{auth_user} } sub get_auth_pass { shift->{auth_pass} } sub get_connected { shift->{connected} } sub get_server { shift->{server} } sub get_server_version { shift->{server_version} } sub get_server_protocol { shift->{server_protocol} } sub get_message_format { shift->{message_format} } sub get_insecure_msg_fmt_ok { shift->{insecure_msg_fmt_ok} } sub set_host { shift->{host} = $_[1] } sub set_port { shift->{port} = $_[1] } sub set_sock { shift->{sock} = $_[1] } sub set_timeout { shift->{timeout} = $_[1] } sub set_classes { shift->{classes} = $_[1] } sub set_class_map { shift->{class_map} = $_[1] } sub set_loaded_classes { shift->{loaded_classes} = $_[1] } sub set_error_cb { shift->{error_cb} = $_[1] } sub set_ssl { shift->{ssl} = $_[1] } sub set_ssl_ca_file { shift->{ssl_ca_file} = $_[1] } sub set_ssl_ca_path { shift->{ssl_ca_path} = $_[1] } sub set_ssl_opts { shift->{ssl_opts} = $_[1] } sub set_auth_user { shift->{auth_user} = $_[1] } sub set_auth_pass { shift->{auth_pass} = $_[1] } sub set_connected { shift->{connected} = $_[1] } sub set_server { shift->{server} = $_[1] } sub set_server_version { shift->{server_version} = $_[1] } sub set_server_protocol { shift->{server_protocol} = $_[1] } sub set_message_format { shift->{message_format} = $_[1] } sub set_insecure_msg_fmt_ok { shift->{insecure_msg_fmt_ok} = $_[1] } sub get_max_packet_size { return Event::RPC::Message->get_max_packet_size; } sub set_max_packet_size { my $class = shift; my ($value) = @_; Event::RPC::Message->set_max_packet_size($value); } sub new { my $class = shift; my %par = @_; my ($server, $host, $port, $classes, $class_map, $error_cb, $timeout) = @par{'server','host','port','classes','class_map','error_cb','timeout'}; my ($ssl, $ssl_ca_file, $ssl_opts, $auth_user, $auth_pass, $insecure_msg_fmt_ok) = @par{'ssl','ssl_ca_file','ssl_opts','auth_user','auth_pass','insecure_msg_fmt_ok'}; $server ||= ''; $host ||= ''; $insecure_msg_fmt_ok = 1 unless defined $insecure_msg_fmt_ok; if ( $server ne '' and $host eq '' ) { warn "Option 'server' is deprecated. Use 'host' instead."; $host = $server; } my $self = bless { host => $server, server => $host, port => $port, timeout => $timeout, classes => $classes, class_map => $class_map, ssl => $ssl, ssl_ca_file => $ssl_ca_file, ssl_opts => $ssl_opts, auth_user => $auth_user, auth_pass => $auth_pass, error_cb => $error_cb, message_format => $Event::RPC::Client::DEFAULT_MESSAGE_FORMAT, insecure_msg_fmt_ok => $insecure_msg_fmt_ok, loaded_classes => {}, connected => 0, }, $class; return $self; } sub connect { my $self = shift; croak "Client is already connected" if $self->get_connected; my $ssl = $self->get_ssl; my $server = $self->get_server; my $port = $self->get_port; my $timeout = $self->get_timeout; $self->set_message_format($Event::RPC::Client::DEFAULT_MESSAGE_FORMAT); #-- Client may try to fallback to Storable Event::RPC::Message::Negotiate->set_storable_fallback_ok(1) if $self->get_message_format eq 'Event::RPC::Message::Negotiate' and $self->get_insecure_msg_fmt_ok; if ( $ssl ) { eval { require IO::Socket::SSL }; croak "SSL requested, but IO::Socket::SSL not installed" if $@; } my $sock; if ( $ssl ) { my @verify_opts; if ( $self->get_ssl_ca_file or $self->get_ssl_ca_path ) { push @verify_opts, ( SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_PEER(), SSL_ca_file => $self->get_ssl_ca_file, SSL_ca_path => $self->get_ssl_ca_path, ); } else { push @verify_opts, ( SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE(), ); } my $ssl_opts = $self->get_ssl_opts; $sock = IO::Socket::SSL->new( Proto => 'tcp', PeerPort => $port, PeerAddr => $server, Type => SOCK_STREAM, Timeout => $timeout, @verify_opts, ($ssl_opts?%{$ssl_opts}:()), ) or croak "Can't open SSL connection to $server:$port: $IO::Socket::SSL::ERROR"; } else { $sock = IO::Socket::INET->new( Proto => 'tcp', PeerPort => $port, PeerAddr => $server, Type => SOCK_STREAM, Timeout => $timeout, ) or croak "Can't open connection to $server:$port - $!"; } $sock->autoflush(1); $self->set_sock($sock); eval { #-- Perform message format negotitation if we are not #-- configured to a specific format already. $self->negotiate_message_format if $self->get_message_format eq 'Event::RPC::Message::Negotiate'; $self->check_version; }; if ( $@ ) { $self->disconnect; die $@; } my $auth_user = $self->get_auth_user; my $auth_pass = $self->get_auth_pass; if ( $auth_user ) { my $rc = $self->send_request( { cmd => 'auth', user => $auth_user, pass => $auth_pass, } ); if ( not $rc->{ok} ) { $self->disconnect; croak $rc->{msg}; } } if ( not $self->get_classes ) { $self->load_all_classes; } else { $self->load_classes; } $self->set_connected(1); 1; } sub log_connect { my $class = shift; my %par = @_; my ( $server, $port ) = @par{ 'server', 'port' }; my $sock = IO::Socket::INET->new( Proto => 'tcp', PeerPort => $port, PeerAddr => $server, Type => SOCK_STREAM ) or croak "Can't open connection to $server:$port - $!"; return $sock; } sub disconnect { my $self = shift; close( $self->get_sock ) if $self->get_sock; $self->set_connected(0); 1; } sub DESTROY { shift->disconnect; } sub error { my $self = shift; my ($message) = @_; my $error_cb = $self->get_error_cb; if ($error_cb) { &$error_cb( $self, $message ); } else { die "Unhandled error in client/server communication: $message"; } 1; } sub negotiate_message_format { my $self = shift; my $rc = eval { $self->send_request({ cmd => "neg_formats_avail" }) }; if ( $@ ) { #-- On error we probably may fall back to Storable #-- (we connected to an old server) if ( $self->get_insecure_msg_fmt_ok ) { require Event::RPC::Message::Storable; $self->set_message_format("Event::RPC::Message::Storable"); return; } #-- die if Storable is not allowed die "Error on message format negotiation and client is not ". "allowed to fall back to Storable\n"; } my $modules_by_format_name = Event::RPC::Message::Negotiate->known_message_formats; my @formats = split(/,/, $rc->{msg}); my $format_chosen = ''; my $module_chosen = ''; foreach my $format ( @formats ) { my $module = $modules_by_format_name->{$format} or die "Unknown message format '$format"; eval "use $module"; if ( not $@ ) { $format_chosen = $format; $module_chosen = $module; last; }; } die "Can't negotiate message format\n" unless $format_chosen; eval { $self->send_request({ cmd => "neg_format_set", msg => $format_chosen, }) }; die "Error on neg_format_set: $@" if $@; $self->set_message_format($module_chosen); 1; } sub check_version { my $self = shift; my $rc = eval { $self->send_request( { cmd => 'version', } ) }; die "CATCHED $@" if $@; $self->set_server_version( $rc->{version} ); $self->set_server_protocol( $rc->{protocol} ); if ( $rc->{version} ne $self->get_client_version ) { warn "Event::RPC warning: server version $rc->{version} != " . "client version " . $self->get_client_version; } if ( $rc->{protocol} < $self->get_client_protocol ) { die "FATAL: Server protocol version $rc->{protocol} < " . "client protocol version " . $self->get_client_protocol; } 1; } sub load_all_classes { my $self = shift; my $rc = $self->send_request( { cmd => 'class_info_all', } ); my $class_info_all = $rc->{class_info_all}; foreach my $class ( keys %{$class_info_all} ) { $self->load_class( $class, $class_info_all->{$class} ); } 1; } sub load_classes { my $self = shift; my $classes = $self->get_classes; my %classes; @classes{ @{$classes} } = (1) x @{$classes}; my $rc = $self->send_request( { cmd => 'classes_list', } ); foreach my $class ( @{ $rc->{classes} } ) { next if not $classes{$class}; $classes{$class} = 0; my $rc = $self->send_request( { cmd => 'class_info', class => $class, } ); $self->load_class( $class, $rc->{methods} ); } foreach my $class ( @{$classes} ) { warn "WARNING: Class '$class' not exported by server" if $classes{$class}; } 1; } sub load_class { my $self = shift; my ( $class, $methods ) = @_; my $loaded_classes = $self->get_loaded_classes; return 1 if $loaded_classes->{$class}; $loaded_classes->{$class} = 1; my $local_method; my $class_map = $self->get_class_map; my $local_class = $class_map->{$class} || $class; # create local destructor for this class { no strict 'refs'; my $local_method = $local_class . '::' . "DESTROY"; *$local_method = sub { return if not $self->get_connected; my $oid_ref = shift; $self->send_request({ cmd => "client_destroy", oid => ${$oid_ref}, }); }; } # create local methods for this class foreach my $method ( keys %{$methods} ) { $local_method = $local_class . '::' . $method; my $method_type = $methods->{$method}; if ( $method_type eq '_constructor' ) { # this is a constructor for this class my $request_method = $class . '::' . $method; no strict 'refs'; *$local_method = sub { shift; my $rc = $self->send_request({ cmd => 'new', method => $request_method, params => \@_, }); my $oid = $rc->{oid}; return bless \$oid, $local_class; }; } elsif ( $method_type eq '1' ) { # this is a simple method my $request_method = $method; no strict 'refs'; *$local_method = sub { my $oid_ref = shift; my $rc = $self->send_request({ cmd => 'exec', oid => ${$oid_ref}, method => $request_method, params => \@_, }); return unless $rc; $rc = $rc->{rc}; return @{$rc} if wantarray; return $rc->[0]; }; } else { # this is a object returner my $request_method = $method; no strict 'refs'; *$local_method = sub { my $oid_ref = shift; my $rc = $self->send_request({ cmd => 'exec', oid => ${$oid_ref}, method => $request_method, params => \@_, }); return unless $rc; $rc = $rc->{rc}; foreach my $val ( @{$rc} ) { if ( ref $val eq 'ARRAY' ) { foreach my $list_elem ( @{$val} ) { my ($class) = split( "=", "$list_elem", 2 ); $self->load_class($class) unless $loaded_classes->{$class}; my $list_elem_copy = $list_elem; $list_elem = \$list_elem_copy; bless $list_elem, ( $class_map->{$class} || $class ); } } elsif ( ref $val eq 'HASH' ) { foreach my $hash_elem ( values %{$val} ) { my ($class) = split( "=", "$hash_elem", 2 ); $self->load_class($class) unless $loaded_classes->{$class}; my $hash_elem_copy = $hash_elem; $hash_elem = \$hash_elem_copy; bless $hash_elem, ( $class_map->{$class} || $class ); } } elsif ( defined $val ) { my ($class) = split( "=", "$val", 2 ); $self->load_class($class) unless $loaded_classes->{$class}; my $val_copy = $val; $val = \$val_copy; bless $val, ( $class_map->{$class} || $class ); } } return @{$rc} if wantarray; return $rc->[0]; }; } } return $local_class; } sub send_request { my $self = shift; my ($request) = @_; my $message = $self->get_message_format->new( $self->get_sock ); $message->write_blocked($request); my $rc = eval { $message->read_blocked }; if ($@) { $self->error($@); return; } if ( not $rc->{ok} ) { $rc->{msg} .= "\n" if not $rc->{msg} =~ /\n$/; croak ("$rc->{msg} -- called via Event::RPC::Client"); } return $rc; } 1; __END__ =encoding utf8 =head1 NAME Event::RPC::Client - Client API to connect to Event::RPC Servers =head1 SYNOPSIS use Event::RPC::Client; my $rpc_client = Event::RPC::Client->new ( #-- Required arguments host => "localhost", port => 5555, #-- Optional arguments classes => [ "Event::RPC::Test" ], class_map => { "Event::RPC::Test" => "My::Event::RPC::Test" }, ssl => 1, ssl_ca_file => "some/ca.crt", ssl_ca_path => "some/ca/dir", ssl_opts => { SSL_verifycn_name => 'server-hostname' }, timeout => 10, auth_user => "fred", auth_pass => Event::RPC->crypt("fred",$password), insecure_msg_fmt_ok => 1, error_cb => sub { my ($client, $error) = @_; print "An RPC error occured: $error\n"; $client->disconnect; exit; }, ); $rpc_client->set_max_packet_size(2*1024*1024*1024); $rpc_client->connect; #-- And now use classes and methods to which the #-- server allows access via RPC, here My::TestModule #-- from the Event::RPC::Server manpage SYNPOSIS. my $obj = My::TestModule->new( data => "foobar" ); print "obj says hello: ".$obj->hello."\n"; $obj->set_data("new foobar"); print "updated data: ".$obj->get_data."\n"; $rpc_client->disconnect; =head1 DESCRIPTION Use this module to write clients accessing objects and methods exported by a Event::RPC driven server. Just connect to the server over the network, optionally with SSL and user authentication, and then simply use the exported classes and methods like having them locally in the client. General information about the architecture of Event::RPC driven applications is collected in the Event::RPC manpage. The following documentation describes the client connection options in detail. =head1 CONFIGURATION OPTIONS You need to specify at least the server hostname and TCP port to connect a Event::RPC server instance. If the server requires a SSL connection or user authentication you need to supply the corresponding options as well, otherwise connecting will fail. All options described here may be passed to the new() constructor of Event::RPC::Client. As well you may set or modify them using set_OPTION style mutators, but not after connect() was called! All options may be read using get_OPTION style accessors. =head2 REQUIRED OPTIONS These are necessary to connect the server: =over 4 =item B This is the hostname of the server running Event::RPC::Server. Use a IP address or DNS name here. =item B This is the TCP port the server is listening to. =back =head2 NETWORK OPTIONS =over 4 =item B Specify a timeout (in seconds), which is applied when connecting the server. =back =head2 CLASS IMPORT OPTION =over 4 =item B This is reference to a list of classes which should be imported into the client. You get a warning if you request a class which is not exported by the server. By default all server classes are imported. Use this feature if your server exports a huge list of classes, but your client doesn't need all of them. This saves memory in the client and connect performance increases. =item B Optionally you can map the class names from the server to a different name on the local client using the B hash. This is necessary if you like to use the same classes locally and remotely. Imported classes from the server are by default registered under the same name on the client, so this conflicts with local classes named identically. On the client you access the remote classes under the name assigned in the class map. For example with this map class_map => { "Event::ExecFlow::Job" => "_srv::Event::ExecFlow::Job" } you need to write this on the client, if you like to create an object remotely on the server: my $server_job = _srv::Event::ExecFlow::Job->new ( ... ); and this to create an object on the client: my $client_job = Event::ExecFlow::Job->new ( ... ); The server knows nothing of the renaming on client side, so you still write this on the server to create objects there: my $job = Event::ExecFlow::Job->new ( ... ); =back =head2 SSL OPTIONS If the server accepts only SSL connections you need to enable ssl here in the client as well. By default the SSL connection will be established without any peer verification, which makes Man-in-the-Middle attacks possible. If you want to prevent that, you need to set either B or B option. =over 4 =item B Set this option to 1 to encrypt the network connection using SSL. =item B Path to the the Certificate Authority's certificate file (ca.crt), your server key was signed with. =item B Path of a directory containing several trusted certificates with a proper index. Please refer to the OpenSSL documentation for details about setting up such a directory. =item B This optional parameter takes a hash reference of options passed to IO::Socket::SSL->new(...) to have more control over the SSL connection. For example you can set the 'SSL_verifycn_name' here if the server certificate common name doesn't match to the hostname you use to resolve the server IP or use you have to use a static server IP address or something like that. =back =head2 AUTHENTICATION OPTIONS If the server requires user authentication you need to set the following options: =over 4 =item B A valid username. =item B The corresponding password, encrypted using Perl's crypt() function, using the username as the salt. Event::RPC has a convenience function for generating such a crypted password, although it's currently just a wrapper around Perl's builtin crypt() function, but probably this changes someday, so better use this method: $crypted_pass = Event::RPC->crypt($user, $pass); =back If the passed credentials are invalid the Event::RPC::Client->connect() method throws a correspondent exception. =head2 MESSAGE FORMAT OPTIONS Event::RPC supports different CPAN modules for data serialisation, named "message formats" here: SERL -- Sereal::Encoder, Sereal::Decoder CBOR -- CBOR::XS JSON -- JSON::XS STOR -- Storable Server and client negotiate automatically which format is best to use. The server sends a list of supported formats to the client which takes the first one which is available. For the client there is one option to influence this format negotiation mechanism: =over 4 =item B The Storable module is known to be insecure, so it should be taken as the last option only. By default the Client would do so. You can prevent that by setting this option explicitely to 0. It's enabled by default. Most likely the connection will fail in that case, because the server only will offer Storable if no other serialiser is available. =back =head2 ERROR HANDLING Any exceptions thrown on the server during execution of a remote method will result in a corresponding exception on the client. So you can use normal exception handling with eval {} when executing remote methods. But besides this the network connection between your client and the server may break at any time. This raises an exception as well, but you can override this behaviour with the following attribute: =over 4 =item B This subroutine is called if any error occurs in the network communication between the client and the server. The actual Event::RPC::Client object and an error string are passed as arguments. This is B generic exception handler for exceptions thrown from the executed methods on the server! If you like to catch such exceptions you need to put an eval {} around your method calls, as you would do for local method calls. If you don't specify an B an exception is thrown instead. =back =head1 METHODS =over 4 =item $rpc_client->B This establishes the configured connection to the server. An exception is thrown if something goes wrong, e.g. server not available, credentials are invalid or something like this. =item $rpc_client->B Closes the connection to the server. You may omit explicit disconnecting since it's done automatically once the Event::RPC::Client object gets destroyed. =item $rpc_client->B ( $bytes ) By default Event::RPC does not handle network packages which exceed 2 GB in size (was 4 MB with version 1.04 and earlier). You can change this value using this method at any time, but 4 GB is the maximum. An attempt of the server to send a bigger packet will be aborted and reported as an exception on the client and logged as an error message on the server. Note: you have to set the same value on client and server side! =item $rpc_client->B Returns the currently active max packet size. =back =head1 READY ONLY ATTRIBUTES =over 4 =item $rpc_client->B Returns the Event::RPC version number of the server after connecting. =item $rpc_client->B Returns the Event::RPC protocol number of the server after connecting. =item $rpc_client->B Returns the Event::RPC version number of the client. =item $rpc_client->B Returns the Event::RPC protocol number of the client. =back =head1 AUTHORS Jörn Reder =head1 COPYRIGHT AND LICENSE Copyright (C) 2005-2015 by Jörn Reder . This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Event-RPC-1.08/lib/Event/RPC/AuthPasswdHash.pm0000644000175000017500000000076110351260040017654 0ustar joernjoernpackage Event::RPC::AuthPasswdHash; use strict; use Carp; sub get_passwd_href { shift->{passwd_href} } sub set_passwd_href { shift->{passwd_href} = $_[1] } sub new { my $class = shift; my ($passwd_href) = @_; my $self = bless { passwd_href => $passwd_href, }; return $self; } sub check_credentials { my $self = shift; my ($user, $pass) = @_; return $pass eq $self->get_passwd_href->{$user}; } 1;