commit de116796d4aaccbeef81d6a042486fa5cc37211f Author: Dmitry Kustov Date: Mon Dec 9 18:54:19 2024 +0300 start diff --git a/.gear/rules b/.gear/rules new file mode 100644 index 0000000..461a5cb --- /dev/null +++ b/.gear/rules @@ -0,0 +1 @@ +tar: . diff --git a/.gear/upstream/remotes b/.gear/upstream/remotes new file mode 100644 index 0000000..9487925 --- /dev/null +++ b/.gear/upstream/remotes @@ -0,0 +1,3 @@ +[remote "upstream"] + url = git://git.proxmox.com/git/pve-http-server.git + fetch = +refs/heads/*:refs/remotes/upstream/* diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..d6fa5ab --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +build/ +*.deb +*.buildinfo +*.changes diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..42258ca --- /dev/null +++ b/Makefile @@ -0,0 +1,50 @@ +include /usr/share/dpkg/pkg-info.mk + +PACKAGE=libpve-http-server-perl + +GITVERSION:=$(shell git rev-parse HEAD) +BUILDDIR ?= $(PACKAGE)-$(DEB_VERSION) + +DSC=$(PACKAGE)_$(DEB_VERSION).dsc +DEB=$(PACKAGE)_$(DEB_VERSION)_all.deb + +all: + +$(BUILDDIR): src debian + rm -rf $@ $@.tmp + cp -a src $@.tmp + cp -a debian $@.tmp/ + echo "git clone git://git.proxmox.com/git/pve-http-server\\ngit checkout $(GITVERSION)" > $@.tmp/debian/SOURCE + mv $@.tmp $@ + +.PHONY: deb +deb: $(DEB) +$(DEB): $(BUILDDIR) + cd $(BUILDDIR); dpkg-buildpackage -b -us -uc + lintian $(DEB) + +.PHONY: dsc +dsc: $(DSC) +$(DSC): $(BUILDDIR) + cd $(BUILDDIR); dpkg-buildpackage -S -us -uc + lintian $(DSC) + +sbuild: $(DSC) + sbuild $(DSC) + +.PHONY: upload +upload: UPLOAD_DIST ?= $(DEB_DISTRIBUTION) +upload: $(DEB) + tar cf - $(DEB) | ssh -X repoman@repo.proxmox.com -- upload --product pve,pmg --dist $(UPLOAD_DIST) + +.PHONY: clean distclean +distclean: clean + $(MAKE) -C src $@ + +clean: + $(MAKE) -C src $@ + rm -rf $(PACKAGE)-*/ *.deb *.dsc *.tar.* *.changes *.build *.buildinfo examples/simple-demo.lck + +.PHONY: dinstall +dinstall: $(DEB) + dpkg -i $(DEB) diff --git a/debian/changelog b/debian/changelog new file mode 100644 index 0000000..26e50fe --- /dev/null +++ b/debian/changelog @@ -0,0 +1,426 @@ +libpve-http-server-perl (5.1.2) bookworm; urgency=medium + + * fix #5391: proxy request: avoid "HTTP 599 Too many redirections" error + that could occur due to long-running requests and bad timing during + connection reuse. Disable connection reuse for all but GET requests that + are proxied between different nodes, and allow one retry in this case. + + This can add a tiny bit of overhead if many PUT requests that are proxied + to other nodes are issued with only a small delay between each other. + However, such a high-frequency PUT request pattern is considered an edge + case, and benchmarks show that the slowdown is about 2ms on average, which + is often negligible compared to the actual time required to process the + request. + + -- Proxmox Support Team Fri, 04 Oct 2024 14:02:39 +0200 + +libpve-http-server-perl (5.1.1) bookworm; urgency=medium + + * handler: only allow downloads for annotated endpoints and remove support + for directly returned download info + + -- Proxmox Support Team Mon, 23 Sep 2024 11:07:22 +0200 + +libpve-http-server-perl (5.1.0) bookworm; urgency=medium + + * http: support the deflate compression content encoding + + -- Proxmox Support Team Mon, 22 Apr 2024 13:14:26 +0200 + +libpve-http-server-perl (5.0.6) bookworm; urgency=medium + + * access control: avoid "uninitialized value" warning if using IP + ranges + + -- Proxmox Support Team Tue, 26 Mar 2024 09:16:48 +0100 + +libpve-http-server-perl (5.0.5) bookworm; urgency=medium + + * fix #4859: properly configure TLSv1.3 only mode + + -- Proxmox Support Team Fri, 03 Nov 2023 12:06:31 +0100 + +libpve-http-server-perl (5.0.4) bookworm; urgency=medium + + * fix #4802: reduce CA lookups while proxying with OpenSSL as packaged in + Debian 12 Bookworm. + + * avoid AnyEvent::AIO to fix CPU spinning if the pure-perl implementation + libanyevent-aio-perl is installed, for example on development machines + when trying to use the perl language server. + + -- Proxmox Support Team Mon, 03 Jul 2023 09:38:56 +0200 + +libpve-http-server-perl (5.0.3) bookworm; urgency=medium + + * proxy request: handle missing content-type header + + -- Proxmox Support Team Fri, 09 Jun 2023 18:58:05 +0200 + +libpve-http-server-perl (5.0.2) bookworm; urgency=medium + + * formatter/bootstrap: set SameSite attr of auth cookie to 'strict' + + * when proxying requests, preserve json formatting instead of converting to + x-www-form-urlencoded + + * support actual arrays for array parameters, as a replacement for '-list' and + '-alist' formats + + -- Proxmox Support Team Wed, 07 Jun 2023 13:21:19 +0200 + +libpve-http-server-perl (5.0.1) bookworm; urgency=medium + + * fix regression in the html (bootstrap) based API debug explorer, which + came in through a more strict pattern checking in a newer version of the + used URL encoding library + + -- Proxmox Support Team Sat, 03 Jun 2023 15:15:47 +0200 + +libpve-http-server-perl (5.0.0) bookworm; urgency=medium + + * switch over to native versioning + + * various small code and packaging clean ups + + * re-build for Debian 12 Bookworm based releases + + -- Proxmox Support Team Wed, 17 May 2023 07:26:11 +0200 + +libpve-http-server-perl (4.2-3) bullseye; urgency=medium + + * file upload: don't always calculate MD5 for syslog message, rather log the + file name instead, + + * explicitly disallow tmpfilename parameter in query URL + + -- Proxmox Support Team Fri, 14 Apr 2023 16:27:07 +0200 + +libpve-http-server-perl (4.2-2) bullseye; urgency=medium + + * multipart upload: properly parse file parts without Content-Type + + -- Proxmox Support Team Tue, 11 Apr 2023 14:44:03 +0200 + +libpve-http-server-perl (4.2-1) bullseye; urgency=medium + + * fix #4494: redirect incoming HTTP requests to HTTPS to avoid common + pitfall when opening the Proxmox VE or Proxmox Mail Gateway web-interface + for the first time + + -- Proxmox Support Team Thu, 16 Mar 2023 16:57:59 +0100 + +libpve-http-server-perl (4.1-6) bullseye; urgency=medium + + * multipart upload: fix upload of files starting with newlines + + * multipart upload: don't fail on presebce of additional headers + + * multipart upload: loosen trailing-newline requirement from spec, as some + more popular clients (e.g., postman) violate that rule. + + * fix #4344: http-server: fix regression that required the 'Content-Type' to + be always present for multipart headers, while it wasn't used at all. + + -- Proxmox Support Team Mon, 06 Mar 2023 13:39:57 +0100 + +libpve-http-server-perl (4.1-5) bullseye; urgency=medium + + * upload: re-allow having white-space in filenames + + -- Proxmox Support Team Mon, 07 Nov 2022 16:43:31 +0100 + +libpve-http-server-perl (4.1-4) bullseye; urgency=medium + + * acknowledge content-disposition header + + * request: add missing early return to future proof error check + + -- Proxmox Support Team Thu, 29 Sep 2022 14:37:05 +0200 + +libpve-http-server-perl (4.1-3) bullseye; urgency=medium + + * response: forbid linefeeds in response status message + + * proxy request: assert that API url starts with a slash + + * pass through streaming: only allow from privileged local pvedaemon as + safety net + + * requests: assert that there is no @ in the URLs authority + + -- Proxmox Support Team Sat, 02 Jul 2022 09:16:21 +0200 + +libpve-http-server-perl (4.1-2) bullseye; urgency=medium + + * tls: log failure to apply TLS 1.3 ciphers + + * html formatter: encode href attributes for API debug viewer + + -- Proxmox Support Team Tue, 17 May 2022 16:40:12 +0200 + +libpve-http-server-perl (4.1-1) bullseye; urgency=medium + + * web socket: guard disconnect block check properly + + * avoid warning if request params does not exist + + * fix #3807: don't attempt response on closed handle + + * fix #3790: allow setting TLS 1.3 cipher suites + + * fix #3745: allow overriding TLS key location + + * fix #3789: allow disabling TLS v1.2/v1.3 + + -- Proxmox Support Team Thu, 13 Jan 2022 13:32:43 +0100 + +libpve-http-server-perl (4.0-4) bullseye; urgency=medium + + * webproxy: handle unflushed write buffer + + * fix #3724: disable TLS renegotiation + + * download-stream: allow the api call to set the content-encoding + + -- Proxmox Support Team Wed, 24 Nov 2021 18:14:53 +0100 + +libpve-http-server-perl (4.0-3) bullseye; urgency=medium + + * anyevent: move unlink from http-server to endpoint + + -- Proxmox Support Team Mon, 04 Oct 2021 10:18:12 +0200 + +libpve-http-server-perl (4.0-2) pve pmg; urgency=medium + + * AnyEvent/websocket_proxy: remove 'base64' handling + + * AnyEvent/websocket_proxy: drop handling of websocket subprotocols + + -- Proxmox Support Team Tue, 18 May 2021 10:19:00 +0200 + +libpve-http-server-perl (4.0-1) bullseye; urgency=medium + + * rebuild for Debian 11 Bullseye based releases + + -- Proxmox Support Team Fri, 14 May 2021 16:37:34 +0200 + +libpve-http-server-perl (3.2-2) pve pmg; urgency=medium + + * access control: correctly match v4-mapped-v6 addresses + + * access control: also match any IPv6 in 'ALL' + + -- Proxmox Support Team Fri, 07 May 2021 17:49:34 +0200 + +libpve-http-server-perl (3.2-1) pve pmg; urgency=medium + + * allow 'download' to be passed from API handler + + * utils: add LISTEN_IP option in proxy configuration + + * support streaming data form a file handle to a client + + * allow stream download from path and over short-cutted pvedaemon-proxy + + -- Proxmox Support Team Fri, 23 Apr 2021 13:54:04 +0200 + +libpve-http-server-perl (3.1-1) pve pmg; urgency=medium + + * accept connection phase: fix connection count leak + + * accept connection phase: immediately close socket on early error + + -- Proxmox Support Team Fri, 11 Dec 2020 08:39:36 +0100 + +libpve-http-server-perl (3.0-6) pve pmg; urgency=medium + + * fix #2766: allow application/json as content-type for post/put requests + + * increase maximal accepted header count to 64. Modern browsers and proxy + combinations can exceed the old limit of 30. The maximal accumulated total + header size of 8 KiB stays untouched. + + -- Proxmox Support Team Thu, 02 Jul 2020 09:42:39 +0200 + +libpve-http-server-perl (3.0-5) pve pmg; urgency=medium + + * partially fix #2618: use new unified spice port range helper from + pve-common, increases maximum proxy port for spice to 61999 + + * Websocket: implement ping/pong from RFC + + * Websocket: performance improvements + + -- Proxmox Support Team Mon, 09 Mar 2020 16:12:45 +0100 + +libpve-http-server-perl (3.0-4) pve pmg; urgency=medium + + * allow ticket in 'Authorization' header as fallback + + * api-server: extract, set and handle API token header + + -- Proxmox Support Team Wed, 29 Jan 2020 09:32:04 +0100 + +libpve-http-server-perl (3.0-3) pve pmg; urgency=medium + + * send_file_start: allow to pass a open fh and content-type + + -- Proxmox Support Team Fri, 11 Oct 2019 11:25:12 +0200 + +libpve-http-server-perl (3.0-2) pve pmg; urgency=medium + + * decode_urlencoded: cope with undefined values + + * anyevent: rpcenv is optional and from our child instance + + -- Proxmox Support Team Thu, 11 Jul 2019 19:30:23 +0200 + +libpve-http-server-perl (3.0-1) pve pmg; urgency=medium + + * rebuild for Debian Buster / PVE 6.0 + + * update jQuery to 3.4.1 + + * update Bootstrap to 3.4.1 + + -- Proxmox Support Team Tue, 21 May 2019 21:35:00 +0200 + +libpve-http-server-perl (2.0-13) unstable; urgency=medium + + * tls: make dh to openssl 1.1 compatible + + * store Host header in rpc environment + + * forward Host header in proxy_request + + -- Proxmox Support Team Wed, 03 Apr 2019 13:55:44 +0200 + +libpve-http-server-perl (2.0-12) unstable; urgency=medium + + * Allow one to specify 'honor_cipher_order' and 'compression' parameters + + * move read_proxy_conf from PVE::API2Tools to new PVE::ApiServer::Utils module + + -- Proxmox Support Team Tue, 26 Feb 2019 07:07:31 +0100 + +libpve-http-server-perl (2.0-11) unstable; urgency=medium + + * fix #1935: spice proxy: read empty line after 200 OK + + -- Proxmox Support Team Fri, 28 Sep 2018 10:41:22 +0200 + +libpve-http-server-perl (2.0-10) unstable; urgency=medium + + * fix #1869: send correct http response in spice proxy + + * websocket: set $max_payload_size = 128*1024; (131072) + + -- Proxmox Support Team Fri, 17 Aug 2018 08:29:53 +0200 + +libpve-http-server-perl (2.0-9) unstable; urgency=medium + + * Fix #1684 WebSocket proxy behind a buffered proxy + + -- Proxmox Support Team Mon, 28 May 2018 10:33:41 +0200 + +libpve-http-server-perl (2.0-8) unstable; urgency=medium + + * auth_handler: handle exceptions correctly instead of always returning 401 + + * add 'map' filetype to http-server + + * do not send websocket status code to port + + -- Proxmox Support Team Mon, 11 Dec 2017 15:35:34 +0100 + +libpve-http-server-perl (2.0-7) unstable; urgency=medium + + * add content type application/x-compressed-tar + + * allow API calls to download file contents + + * build: reformat debian/control + + -- Proxmox Support Team Tue, 14 Nov 2017 08:05:17 +0100 + +libpve-http-server-perl (2.0-6) unstable; urgency=medium + + * pass $format to rest_handler() + + -- Proxmox Support Team Thu, 10 Aug 2017 12:05:42 +0200 + +libpve-http-server-perl (2.0-5) unstable; urgency=medium + + * add json/mp3/oga/svg MIME types for the new novnc + + -- Proxmox Support Team Fri, 02 Jun 2017 12:49:02 +0200 + +libpve-http-server-perl (2.0-4) unstable; urgency=medium + + * assume all parameters are utf8 encoded + + -- Proxmox Support Team Tue, 02 May 2017 11:55:21 +0200 + +libpve-http-server-perl (2.0-3) unstable; urgency=medium + + * avoid locale specific time stamps + + -- Proxmox Support Team Mon, 24 Apr 2017 07:43:29 +0200 + +libpve-http-server-perl (2.0-2) unstable; urgency=medium + + * fix #1332: allow ECDHE with all supported curves + + -- Proxmox Support Team Mon, 03 Apr 2017 15:11:38 +0200 + +libpve-http-server-perl (2.0-1) unstable; urgency=medium + + * bump version for debian stretch + + -- Proxmox Support Team Fri, 10 Mar 2017 08:50:55 +0100 + +libpve-http-server-perl (1.0-4) unstable; urgency=medium + + * add debian triggers file + + -- Proxmox Support Team Sat, 21 Jan 2017 16:36:47 +0100 + +libpve-http-server-perl (1.0-3) unstable; urgency=medium + + * console-demo.pl: add a more complex demo + + * call Net::SSLeay::ERR_clear_error after all handlers + + * avoid warnings when clients disconnects early + + -- Proxmox Support Team Sat, 21 Jan 2017 16:19:20 +0100 + +libpve-http-server-perl (1.0-2) unstable; urgency=medium + + * simple-demo.pl: simple demo server for testing + + * extract_auth_cookie: always call uri_unescape($ticket) + + * use canonical flag for json format + + * remove base_handler_class from required arguments + + * remove all references to rpcenv + + * include jquery and bootstrap + + * new helper add_dirs + + * add new hook function to generate CSRF token + + * add generic formatter framework + + -- Proxmox Support Team Mon, 16 Jan 2017 18:39:21 +0100 + +libpve-http-server-perl (1.0-1) unstable; urgency=medium + + * first try + + -- Proxmox Support Team Fri, 13 Jan 2017 12:47:07 +0100 + diff --git a/debian/control b/debian/control new file mode 100644 index 0000000..0d0161e --- /dev/null +++ b/debian/control @@ -0,0 +1,31 @@ +Source: libpve-http-server-perl +Section: perl +Priority: optional +Maintainer: Proxmox Support Team +Build-Depends: debhelper-compat (= 13), perl, +Standards-Version: 4.6.2 +Homepage: https://www.proxmox.com + +Package: libpve-http-server-perl +Architecture: all +Depends: libanyevent-http-perl, + libanyevent-perl (>= 7.140-3), + libcrypt-ssleay-perl, + libhtml-parser-perl, + libhttp-date-perl, + libhttp-message-perl, + libio-socket-ssl-perl, + libjs-bootstrap, + libjs-jquery, + libjson-perl, + libnet-ip-perl, + libpve-common-perl (>= 8.0.2), + liburi-perl, + ${misc:Depends}, + ${perl:Depends}, +Breaks: libpve-storage-perl (<< 8.2.5), + pmg-api (<< 8.1.4), + pve-manager (<< 8.2.7), +Description: Proxmox Asynchrounous HTTP Server Implementation + This package is used as base to implement the REST API in all perl based + Proxmox projects. diff --git a/debian/copyright b/debian/copyright new file mode 100644 index 0000000..844503c --- /dev/null +++ b/debian/copyright @@ -0,0 +1,16 @@ +Copyright (C) 2010-2021 Proxmox Server Solutions GmbH + +This software is written by Proxmox Server Solutions GmbH + +This program is free software: you can redistribute it and/or modify +it under the terms of the GNU Affero General Public License as published by +the Free Software Foundation, either version 3 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Affero General Public License for more details. + +You should have received a copy of the GNU Affero General Public License +along with this program. If not, see . diff --git a/debian/docs b/debian/docs new file mode 100644 index 0000000..8696672 --- /dev/null +++ b/debian/docs @@ -0,0 +1 @@ +debian/SOURCE diff --git a/debian/rules b/debian/rules new file mode 100755 index 0000000..2a6e77d --- /dev/null +++ b/debian/rules @@ -0,0 +1,9 @@ +#!/usr/bin/make -f +# See debhelper(7) (uncomment to enable) +# output every command that modifies files on the build system. +#DH_VERBOSE = 1 + + +%: + dh $@ + diff --git a/debian/source/format b/debian/source/format new file mode 100644 index 0000000..89ae9db --- /dev/null +++ b/debian/source/format @@ -0,0 +1 @@ +3.0 (native) diff --git a/debian/triggers b/debian/triggers new file mode 100644 index 0000000..59dd688 --- /dev/null +++ b/debian/triggers @@ -0,0 +1 @@ +activate-noawait pve-api-updates diff --git a/pve-http-server.spec b/pve-http-server.spec new file mode 100644 index 0000000..b255270 --- /dev/null +++ b/pve-http-server.spec @@ -0,0 +1,95 @@ +%define _unpackaged_files_terminate_build 1 + +Name: pve-http-server +Summary: Proxmox Asynchrounous HTTP Server Implementation +Version: 5.1.2 +Release: alt2 +License: AGPL-3.0+ +Group: Development/Perl +Url: https://www.proxmox.com +Vcs: git://git.proxmox.com/git/pve-http-server.git +Source: %name-%version.tar + +ExclusiveArch: x86_64 aarch64 + +Provides: perl-%name = %EVR +# from debian/control +Provides: libpve-http-server-perl = %EVR +Conflicts: pve-storage < 8.2.5 +Conflicts: pmg-api < 8.1.4 +Conflicts: pve-manager < 8.2.7 + +Requires: fonts-font-awesome javascript-jquery javascript-bootstrap + +BuildRequires: perl(AnyEvent/HTTP.pm) perl(AnyEvent/Handle.pm) perl(AnyEvent/IO.pm) perl(AnyEvent/Socket.pm) perl(AnyEvent/TLS.pm) perl(AnyEvent/Util.pm) +BuildRequires: perl(Compress/Zlib.pm) +BuildRequires: perl(Digest/MD5.pm) perl(Digest/SHA.pm) perl(Encode.pm) +BuildRequires: perl(Net/SSLeay.pm) +BuildRequires: perl(Time/HiRes.pm) +BuildRequires: perl(HTTP/Date.pm) perl(HTTP/Headers.pm) perl(HTTP/Request.pm) perl(HTTP/Response.pm) perl(HTTP/Status.pm) perl(HTML/Entities.pm) +BuildRequires: perl(JSON.pm) +BuildRequires: perl(Net/IP.pm) +BuildRequires: perl(URI/Escape.pm) perl(URI.pm) +BuildRequires: perl(PVE/INotify.pm) perl(PVE/SafeSyslog.pm) perl(PVE/Tools.pm) perl(PVE/JSONSchema.pm) + +%description +%summary. +This package is used as base to implement the REST API in all perl based + +%prep +%setup + +%install +%makeinstall_std -C src + +%files +%doc debian/copyright +%perl_vendor_privlib/PVE/* + +%changelog +* Thu Dec 05 2024 Alexey Shabalin 5.1.2-alt2 +- Revert "fix UTF-8 presentation" + +* Thu Nov 28 2024 Alexey Shabalin 5.1.2-alt1 +- unbootstrap +- fix UTF-8 presentation + +* Sun Oct 20 2024 Alexey Shabalin 5.1.2-alt0.1 +- 5.1.2 +- bootstrap, build without conflicts + +* Thu Aug 29 2024 Andrew A. Vasilyev 5.1.0-alt1 +- 5.1.0 + +* Fri Mar 29 2024 Andrew A. Vasilyev 5.0.6-alt1 +- 5.0.6 + +* Wed Feb 28 2024 Andrew A. Vasilyev 5.0.5-alt1 +- 5.0.5 + +* Thu May 25 2023 Andrew A. Vasilyev 4.2.3-alt1 +- 4.2-3 +- add copyright file + +* Mon Mar 20 2023 Andrew A. Vasilyev 4.2.1-alt1 +- 4.2-1 + +* Sat Mar 11 2023 Andrew A. Vasilyev 4.1.6-alt1 +- 4.1-6 + +* Mon Nov 14 2022 Alexey Shabalin 4.1.5-alt1 +- 4.1-5 + +* Fri Oct 07 2022 Andrew A. Vasilyev 4.1.4-alt2 +- fix CPU eating loop + +* Mon Oct 03 2022 Alexey Shabalin 4.1.4-alt1 +- 4.1-4 + +* Thu Jul 07 2022 Andrew A. Vasilyev 4.1.3-alt1 +- 4.1-3 + +* Thu Feb 17 2022 Alexey Shabalin 4.1.1-alt1 +- 4.1-1 +- build as separate package + diff --git a/src/Makefile b/src/Makefile new file mode 100644 index 0000000..9e1a8f7 --- /dev/null +++ b/src/Makefile @@ -0,0 +1,23 @@ +DESTDIR= +PERL5DIR=${DESTDIR}/usr/share/perl5 +DOCDIR=${DESTDIR}/usr/share/doc/${PACKAGE} + +all: + +install: PVE + install -d -m 755 ${PERL5DIR}/PVE/APIServer + install -m 0644 PVE/APIServer/AnyEvent.pm ${PERL5DIR}/PVE/APIServer + install -m 0644 PVE/APIServer/Formatter.pm ${PERL5DIR}/PVE/APIServer + install -m 0644 PVE/APIServer/Utils.pm ${PERL5DIR}/PVE/APIServer + install -d -m 755 ${PERL5DIR}/PVE/APIServer/Formatter + install -m 0644 PVE/APIServer/Formatter/Standard.pm ${PERL5DIR}/PVE/APIServer/Formatter + install -m 0644 PVE/APIServer/Formatter/Bootstrap.pm ${PERL5DIR}/PVE/APIServer/Formatter + install -m 0644 PVE/APIServer/Formatter/HTML.pm ${PERL5DIR}/PVE/APIServer/Formatter + +.PHONY: clean distclean +distclean: clean + rm -f examples/simple-demo.pem + +clean: + rm -rf examples/simple-demo.lck + find . -name '*~' -exec rm {} ';' diff --git a/src/PVE/APIServer/AnyEvent.pm b/src/PVE/APIServer/AnyEvent.pm new file mode 100644 index 0000000..1a5904f --- /dev/null +++ b/src/PVE/APIServer/AnyEvent.pm @@ -0,0 +1,2206 @@ +package PVE::APIServer::AnyEvent; + +# Note 1: interactions with Crypt::OpenSSL::RSA +# +# Some handlers (auth_handler) use Crypt::OpenSSL::RSA, which seems to +# set the openssl error variable. We need to clear that here, else +# AnyEvent::TLS aborts the connection. +# Net::SSLeay::ERR_clear_error(); + +use strict; +use warnings; + +use AnyEvent::HTTP; +use AnyEvent::Handle; +use AnyEvent::Socket; +# use AnyEvent::Strict; # only use this for debugging +use AnyEvent::TLS; +use AnyEvent::Util qw(guard fh_nonblocking WSAEWOULDBLOCK WSAEINPROGRESS); + +use Compress::Zlib; +use Digest::MD5; +use Digest::SHA; +use Encode; +use Fcntl (); +use Fcntl; +use File::Find; +use File::stat qw(); +use IO::File; +use MIME::Base64; +use Net::SSLeay; +use POSIX qw(strftime EINTR EAGAIN); +use Socket qw(IPPROTO_TCP TCP_NODELAY SOMAXCONN); +use Time::HiRes qw(usleep ualarm gettimeofday tv_interval); + +#use Data::Dumper; # FIXME: remove, just use: print to_json([$var], {pretty => 1}) ."\n"; +use HTTP::Date; +use HTTP::Headers; +use HTTP::Request; +use HTTP::Response; +use HTTP::Status qw(:constants); +use JSON; +use Net::IP; +use URI::Escape; +use URI; + +use PVE::INotify; +use PVE::SafeSyslog; +use PVE::Tools qw(trim); + +use PVE::APIServer::Formatter; +use PVE::APIServer::Utils; + +my $limit_max_headers = 64; +my $limit_max_header_size = 8*1024; +my $limit_max_post = 64*1024; + +my $known_methods = { + GET => 1, + POST => 1, + PUT => 1, + DELETE => 1, +}; + +my $split_abs_uri = sub { + my ($abs_uri, $base_uri) = @_; + + my ($format, $rel_uri) = $abs_uri =~ m/^\Q$base_uri\E\/+([a-z][a-z0-9]+)(\/.*)?$/; + $rel_uri = '/' if !$rel_uri; + + return wantarray ? ($rel_uri, $format) : $rel_uri; +}; + +sub dprint { + my ($self, $message) = @_; + + return if !$self->{debug}; + + my ($pkg, $pkgfile, $line, $sub) = caller(1); + $sub =~ s/^(?:.+::)+//; + print "worker[$$]: $pkg +$line: $sub: $message\n"; +} + +sub log_request { + my ($self, $reqstate) = @_; + + my $loginfo = $reqstate->{log}; + + # like apache2 common log format + # LogFormat "%h %l %u %t \"%r\" %>s %b \"%{Referer}i\" \"%{User-agent}i\"" + + return if $loginfo->{written}; # avoid duplicate logs + $loginfo->{written} = 1; + + my $peerip = $reqstate->{peer_host} || '-'; + my $userid = $loginfo->{userid} || '-'; + my $content_length = defined($loginfo->{content_length}) ? $loginfo->{content_length} : '-'; + my $code = $loginfo->{code} || 500; + my $requestline = $loginfo->{requestline} || '-'; + my $timestr = strftime("%d/%m/%Y:%H:%M:%S %z", localtime()); + + my $msg = "$peerip - $userid [$timestr] \"$requestline\" $code $content_length\n"; + + $self->write_log($msg); +} + +sub log_aborted_request { + my ($self, $reqstate, $error) = @_; + + my $r = $reqstate->{request}; + return if !$r; # no active request + + if ($error) { + syslog("err", "problem with client $reqstate->{peer_host}; $error"); + } + + $self->log_request($reqstate); +} + +sub cleanup_reqstate { + my ($reqstate, $deletetmpfile) = @_; + + delete $reqstate->{log}; + delete $reqstate->{request}; + delete $reqstate->{proto}; + delete $reqstate->{accept_gzip}; + delete $reqstate->{accept_deflate}; + delete $reqstate->{starttime}; + + if ($reqstate->{tmpfilename}) { + unlink $reqstate->{tmpfilename} if $deletetmpfile; + delete $reqstate->{tmpfilename}; + } +} + +sub client_do_disconnect { + my ($self, $reqstate) = @_; + + cleanup_reqstate($reqstate, 1); + + my $shutdown_hdl = sub { + my $hdl = shift; + + shutdown($hdl->{fh}, 1); + # clear all handlers + $hdl->on_drain(undef); + $hdl->on_read(undef); + $hdl->on_eof(undef); + }; + + if (my $proxyhdl = delete $reqstate->{proxyhdl}) { + &$shutdown_hdl($proxyhdl) + if !$proxyhdl->{block_disconnect}; + } + + my $hdl = delete $reqstate->{hdl}; + + if (!$hdl) { + syslog('err', "detected empty handle"); + return; + } + + $self->dprint("close connection $hdl"); + + &$shutdown_hdl($hdl); + + warn "connection count <= 0!\n" if $self->{conn_count} <= 0; + + $self->{conn_count}--; + + $self->dprint("CLOSE FH" . $hdl->{fh}->fileno() . " CONN$self->{conn_count}"); +} + +sub finish_response { + my ($self, $reqstate) = @_; + + cleanup_reqstate($reqstate, 0); + + my $hdl = $reqstate->{hdl}; + return if !$hdl; # already disconnected + + if (!$self->{end_loop} && $reqstate->{keep_alive} > 0) { + # print "KEEPALIVE $reqstate->{keep_alive}\n" if $self->{debug}; + $hdl->on_read(sub { + eval { $self->push_request_header($reqstate); }; + warn $@ if $@; + }); + } else { + $hdl->on_drain (sub { + eval { + $self->client_do_disconnect($reqstate); + }; + warn $@ if $@; + }); + } +} + +sub response_stream { + my ($self, $reqstate, $stream_fh) = @_; + + # disable timeout, we don't know how big the data is + $reqstate->{hdl}->timeout(0); + + my $buf_size = 4*1024*1024; + + my $on_read; + $on_read = sub { + my ($hdl) = @_; + my $reqhdl = $reqstate->{hdl}; + return if !$reqhdl; + + my $wbuf_len = length($reqhdl->{wbuf}); + my $rbuf_len = length($hdl->{rbuf}); + # TODO: Take into account $reqhdl->{wbuf_max} ? Right now + # that's unbounded, so just assume $buf_size + my $to_read = $buf_size - $wbuf_len; + $to_read = $rbuf_len if $rbuf_len < $to_read; + if ($to_read > 0) { + my $data = substr($hdl->{rbuf}, 0, $to_read, ''); + $reqhdl->push_write($data); + $rbuf_len -= $to_read; + } elsif ($hdl->{_eof}) { + # workaround: AnyEvent gives us a fake EPIPE if we don't consume + # any data when called at EOF, so unregister ourselves - data is + # flushed by on_eof anyway + # see: https://sources.debian.org/src/libanyevent-perl/7.170-2/lib/AnyEvent/Handle.pm/#L1329 + $hdl->on_read(); + return; + } + + # apply backpressure so we don't accept any more data into + # buffer if the client isn't downloading fast enough + # note: read_size can double upon read, and we also need to + # account for one more read after start_read, so *4 + if ($rbuf_len + $hdl->{read_size}*4 > $buf_size) { + # stop reading until write buffer is empty + $hdl->on_read(); + my $prev_on_drain = $reqhdl->{on_drain}; + $reqhdl->on_drain(sub { + my ($wrhdl) = @_; + # on_drain called because write buffer is empty, continue reading + $hdl->on_read($on_read); + if ($prev_on_drain) { + $wrhdl->on_drain($prev_on_drain); + $prev_on_drain->($wrhdl); + } + }); + } + }; + + $reqstate->{proxyhdl} = AnyEvent::Handle->new( + fh => $stream_fh, + rbuf_max => $buf_size, + timeout => 0, + on_read => $on_read, + on_eof => sub { + my ($hdl) = @_; + eval { + if (my $reqhdl = $reqstate->{hdl}) { + $self->log_aborted_request($reqstate); + # write out any remaining data + $reqhdl->push_write($hdl->{rbuf}) if length($hdl->{rbuf}) > 0; + $hdl->{rbuf} = ""; + $reqhdl->push_shutdown(); + $self->finish_response($reqstate); + } + }; + if (my $err = $@) { syslog('err', "$err"); } + $on_read = undef; + }, + on_error => sub { + my ($hdl, $fatal, $message) = @_; + eval { + $self->log_aborted_request($reqstate, $message); + $self->client_do_disconnect($reqstate); + }; + if (my $err = $@) { syslog('err', "$err"); } + $on_read = undef; + }, + ); +} + +sub response { + my ($self, $reqstate, $resp, $mtime, $nocomp, $delay, $stream_fh) = @_; + + #print "$$: send response: " . Dumper($resp); + + # activate timeout + $reqstate->{hdl}->timeout_reset(); + $reqstate->{hdl}->timeout($self->{timeout}); + + $nocomp = 1 if !$self->{compression}; + $nocomp = 1 if !$reqstate->{accept_gzip} && !$reqstate->{accept_deflate}; + + my $code = $resp->code; + my $msg = $resp->message || HTTP::Status::status_message($code); + my $content = $resp->content; + + # multiline mode only checks \n for $, so explicitly check for any \n or \r afterwards + ($msg) = $msg =~ m/^(.*)$/m; + if ($msg =~ /[\r\n]/) { + $code = 400; # bad request from user + $msg = HTTP::Status::status_message($code); + $content = ''; + } + + if ($code =~ /^(1\d\d|[23]04)$/) { + # make sure informational, no content and not modified response send no content + $content = ""; + } + + $reqstate->{keep_alive} = 0 if ($code >= 400) || $self->{end_loop}; + + $reqstate->{log}->{code} = $code; + + my $proto = $reqstate->{proto} ? $reqstate->{proto}->{str} : 'HTTP/1.0'; + my $res = "$proto $code $msg\015\012"; + + my $ctime = time(); + my $date = HTTP::Date::time2str($ctime); + $resp->header('Date' => $date); + if ($mtime) { + $resp->header('Last-Modified' => HTTP::Date::time2str($mtime)); + } else { + $resp->header('Expires' => $date); + $resp->header('Cache-Control' => "max-age=0"); + $resp->header("Pragma", "no-cache"); + } + + $resp->header('Server' => "pve-api-daemon/3.0"); + + my $content_length; + if ($content && !$stream_fh) { + + $content_length = length($content); + + if (!$nocomp && ($content_length > 1024)) { + if ($reqstate->{accept_gzip}) { + my $comp = Compress::Zlib::memGzip($content); + $resp->header('Content-Encoding', 'gzip'); + $content = $comp; + } elsif ($reqstate->{accept_deflate}) { + my $comp = Compress::Zlib::compress($content); + $resp->header('Content-Encoding', 'deflate'); + $content = $comp; + } + } + $content_length = length($content); + $resp->header("Content-Length" => $content_length); + $reqstate->{log}->{content_length} = $content_length; + + } else { + $resp->remove_header("Content-Length"); + } + + if ($reqstate->{keep_alive} > 0) { + $resp->push_header('Connection' => 'Keep-Alive'); + } else { + $resp->header('Connection' => 'close'); + } + + $res .= $resp->headers_as_string("\015\012"); + #print "SEND(without content) $res\n" if $self->{debug}; + + $res .= "\015\012"; + $res .= $content if $content && !$stream_fh; + + $self->log_request($reqstate, $reqstate->{request}); + + if ($stream_fh) { + # write headers and preamble... + $reqstate->{hdl}->push_write($res); + # ...then stream data via an AnyEvent::Handle + $self->response_stream($reqstate, $stream_fh); + } elsif ($delay && $delay > 0) { + my $w; $w = AnyEvent->timer(after => $delay, cb => sub { + undef $w; # delete reference + return if !$reqstate->{hdl}; # already disconnected + $reqstate->{hdl}->push_write($res); + $self->finish_response($reqstate); + }); + } else { + $reqstate->{hdl}->push_write($res); + $self->finish_response($reqstate); + } +} + +sub error { + my ($self, $reqstate, $code, $msg, $hdr, $content) = @_; + + eval { + my $resp = HTTP::Response->new($code, $msg, $hdr, $content); + $self->response($reqstate, $resp); + }; + warn $@ if $@; +} + +my $file_extension_info = { + css => { ct => 'text/css' }, + html => { ct => 'text/html' }, + js => { ct => 'application/javascript' }, + json => { ct => 'application/json' }, + map => { ct => 'application/json' }, + png => { ct => 'image/png' , nocomp => 1 }, + ico => { ct => 'image/x-icon', nocomp => 1}, + gif => { ct => 'image/gif', nocomp => 1}, + svg => { ct => 'image/svg+xml' }, + jar => { ct => 'application/java-archive', nocomp => 1}, + woff => { ct => 'application/font-woff', nocomp => 1}, + woff2 => { ct => 'application/font-woff2', nocomp => 1}, + ttf => { ct => 'application/font-snft', nocomp => 1}, + pdf => { ct => 'application/pdf', nocomp => 1}, + epub => { ct => 'application/epub+zip', nocomp => 1}, + mp3 => { ct => 'audio/mpeg', nocomp => 1}, + oga => { ct => 'audio/ogg', nocomp => 1}, + tgz => { ct => 'application/x-compressed-tar', nocomp => 1}, +}; + +sub send_file_start { + my ($self, $reqstate, $download) = @_; + + eval { + # print "SEND FILE $filename\n"; + # Note: aio_load() this is not really async unless we use IO::AIO! + eval { + + my $r = $reqstate->{request}; + + my $fh; + my $nocomp; + my $mime; + + die "invalid download information passed: '$download'\n" + if ref($download) ne 'HASH'; + + $mime = $download->{'content-type'}; + my $encoding = $download->{'content-encoding'}; + my $disposition = $download->{'content-disposition'}; + + if ($download->{path} && $download->{stream} && + $reqstate->{request}->header('PVEDisableProxy')) + { + # avoid double stream from a file, let the proxy handle it + die "internal error: file proxy streaming only available for pvedaemon\n" + if !$self->{trusted_env}; + my $header = HTTP::Headers->new( + pvestreamfile => $download->{path}, + Content_Type => $mime, + ); + $header->header('Content-Encoding' => $encoding) if defined($encoding); + $header->header('Content-Disposition' => $disposition) if defined($disposition); + # we need some data so Content-Length gets set correctly and + # the proxy doesn't wait for more data - place a canary + my $resp = HTTP::Response->new(200, "OK", $header, "error canary"); + $self->response($reqstate, $resp); + return; + } + + if (!($fh = $download->{fh})) { + my $path = $download->{path}; + die "internal error: {download} returned but neither fh not path given\n" + if !$path; + sysopen($fh, "$path", O_NONBLOCK | O_RDONLY) + or die "open stream path '$path' for reading failed: $!\n"; + } + + if ($download->{stream}) { + my $header = HTTP::Headers->new(Content_Type => $mime); + $header->header('Content-Encoding' => $encoding) if defined($encoding); + $header->header('Content-Disposition' => $disposition) if defined($disposition); + my $resp = HTTP::Response->new(200, "OK", $header); + $self->response($reqstate, $resp, undef, 1, 0, $fh); + return; + } elsif (!$mime) { + my $filename = $download->{path}; + my ($ext) = $filename =~ m/\.([^.]*)$/; + my $ext_info = $file_extension_info->{$ext}; + + die "unable to detect content type" if !$ext_info; + $mime = $ext_info->{ct}; + $nocomp = $ext_info->{nocomp}; + } + + my $stat = File::stat::stat($fh) || + die "$!\n"; + + my $mtime = $stat->mtime; + + if (my $ifmod = $r->header('if-modified-since')) { + my $iftime = HTTP::Date::str2time($ifmod); + if ($mtime <= $iftime) { + my $resp = HTTP::Response->new(304, "NOT MODIFIED"); + $self->response($reqstate, $resp, $mtime); + return; + } + } + + my $data; + my $len = sysread($fh, $data, $stat->size); + die "got short file\n" if !defined($len) || $len != $stat->size; + + my $header = HTTP::Headers->new(Content_Type => $mime); + my $resp = HTTP::Response->new(200, "OK", $header, $data); + $self->response($reqstate, $resp, $mtime, $nocomp); + }; + if (my $err = $@) { + $self->error($reqstate, 501, $err); + } + }; + + warn $@ if $@; +} + +sub websocket_proxy { + my ($self, $reqstate, $wsaccept, $wsproto, $param) = @_; + + eval { + my $remhost; + my $remport; + + my $max_payload_size = 128*1024; + + if ($param->{port}) { + $remhost = 'localhost'; + $remport = $param->{port}; + } elsif ($param->{socket}) { + $remhost = 'unix/'; + $remport = $param->{socket}; + } else { + die "websocket_proxy: missing port or socket\n"; + } + + my $encode = sub { + my ($data, $opcode) = @_; + + my $string; + my $payload; + + $string = $opcode ? $opcode : "\x82"; # binary frame + $payload = $$data; + + my $payload_len = length($payload); + if ($payload_len <= 125) { + $string .= pack 'C', $payload_len; + } elsif ($payload_len <= 0xffff) { + $string .= pack 'C', 126; + $string .= pack 'n', $payload_len; + } else { + $string .= pack 'C', 127; + $string .= pack 'Q>', $payload_len; + } + $string .= $payload; + return $string; + }; + + tcp_connect $remhost, $remport, sub { + my ($fh) = @_ + or die "connect to '$remhost:$remport' failed: $!"; + + $self->dprint("CONNECTed to '$remhost:$remport'"); + + $reqstate->{proxyhdl} = AnyEvent::Handle->new( + fh => $fh, + rbuf_max => $max_payload_size, + wbuf_max => $max_payload_size*5, + timeout => 5, + on_eof => sub { + my ($hdl) = @_; + eval { + $self->log_aborted_request($reqstate); + $self->client_do_disconnect($reqstate); + }; + if (my $err = $@) { syslog('err', $err); } + }, + on_error => sub { + my ($hdl, $fatal, $message) = @_; + eval { + $self->log_aborted_request($reqstate, $message); + $self->client_do_disconnect($reqstate); + }; + if (my $err = $@) { syslog('err', "$err"); } + }); + + my $proxyhdlreader = sub { + my ($hdl) = @_; + + my $len = length($hdl->{rbuf}); + my $data = substr($hdl->{rbuf}, 0, $len > $max_payload_size ? $max_payload_size : $len, ''); + + my $string = $encode->(\$data); + + $reqstate->{hdl}->push_write($string) if $reqstate->{hdl}; + }; + + my $hdlreader = sub { + my ($hdl) = @_; + + while (my $len = length($hdl->{rbuf})) { + return if $len < 2; + + my $hdr = unpack('C', substr($hdl->{rbuf}, 0, 1)); + my $opcode = $hdr & 0b00001111; + my $fin = $hdr & 0b10000000; + + die "received fragmented websocket frame\n" if !$fin; + + my $rsv = $hdr & 0b01110000; + die "received websocket frame with RSV flags\n" if $rsv; + + my $payload_len = unpack 'C', substr($hdl->{rbuf}, 1, 1); + + my $masked = $payload_len & 0b10000000; + die "received unmasked websocket frame from client\n" if !$masked; + + my $offset = 2; + $payload_len = $payload_len & 0b01111111; + if ($payload_len == 126) { + return if $len < 4; + $payload_len = unpack('n', substr($hdl->{rbuf}, $offset, 2)); + $offset += 2; + } elsif ($payload_len == 127) { + return if $len < 10; + $payload_len = unpack('Q>', substr($hdl->{rbuf}, $offset, 8)); + $offset += 8; + } + + die "received too large websocket frame (len = $payload_len)\n" + if ($payload_len > $max_payload_size) || ($payload_len < 0); + + return if $len < ($offset + 4 + $payload_len); + + my $data = substr($hdl->{rbuf}, 0, $offset + 4 + $payload_len, ''); # now consume data + + my $mask = substr($data, $offset, 4); + $offset += 4; + + my $payload = substr($data, $offset, $payload_len); + + # NULL-mask might be used over TLS, skip to increase performance + if ($mask ne pack('N', 0)) { + # repeat 4 byte mask to payload length + up to 4 byte + $mask = $mask x (int($payload_len / 4) + 1); + # truncate mask to payload length + substr($mask, $payload_len) = ""; + # (un-)apply mask + $payload ^= $mask; + } + + if ($opcode == 1 || $opcode == 2) { + $reqstate->{proxyhdl}->push_write($payload) if $reqstate->{proxyhdl}; + } elsif ($opcode == 8) { + my $statuscode = unpack ("n", $payload); + $self->dprint("websocket received close. status code: '$statuscode'"); + if (my $proxyhdl = $reqstate->{proxyhdl}) { + $proxyhdl->{block_disconnect} = 1 if length $proxyhdl->{wbuf}; + + $proxyhdl->push_shutdown(); + } + $hdl->push_shutdown(); + } elsif ($opcode == 9) { + # ping received, schedule pong + $reqstate->{hdl}->push_write($encode->(\$payload, "\x8A")) if $reqstate->{hdl}; + } elsif ($opcode == 0xA) { + # pong received, continue + } else { + die "received unhandled websocket opcode $opcode\n"; + } + } + }; + + my $proto = $reqstate->{proto} ? $reqstate->{proto}->{str} : 'HTTP/1.1'; + + $reqstate->{proxyhdl}->timeout(0); + $reqstate->{proxyhdl}->on_read($proxyhdlreader); + $reqstate->{hdl}->on_read($hdlreader); + + # todo: use stop_read/start_read if write buffer grows to much + + # FIXME: remove protocol in PVE/PMG 8.x + # + # for backwards, compatibility, we have to reply with the websocket + # subprotocol from the request + my $res = "$proto 101 Switching Protocols\015\012" . + "Upgrade: websocket\015\012" . + "Connection: upgrade\015\012" . + "Sec-WebSocket-Accept: $wsaccept\015\012" . + ($wsproto ne "" ? "Sec-WebSocket-Protocol: $wsproto\015\012" : "") . + "\015\012"; + + $self->dprint($res); + + $reqstate->{hdl}->push_write($res); + + # log early + $reqstate->{log}->{code} = 101; + $self->log_request($reqstate); + }; + + }; + if (my $err = $@) { + warn $err; + $self->log_aborted_request($reqstate, $err); + $self->client_do_disconnect($reqstate); + } +} + +sub proxy_request { + my ($self, $reqstate, $clientip, $host, $node, $method, $uri, $auth, $params) = @_; + + eval { + my $target; + + # By default, AnyEvent::HTTP reuses connections for the idempotent + # request methods GET/HEAD/PUT/DELETE. But not all of our PUT requests + # are idempotent, hence, reuse connections for GET requests only, as + # these should in fact be idempotent. + my $persistent = $method eq 'GET'; + + # stringify URI object and verify it starts with a slash + $uri = "$uri"; + if ($uri !~ m@^/@) { + $self->error($reqstate, 400, "invalid proxy uri"); + return; + } + + my $may_stream_file; + if ($host eq 'localhost') { + $target = "http://$host:85$uri"; + # connection reuse for localhost is not worth (connection setup is about 0.2ms) + $persistent = 0; + $may_stream_file = 1; + } elsif (Net::IP::ip_is_ipv6($host)) { + $target = "https://[$host]:8006$uri"; + } else { + $target = "https://$host:8006$uri"; + } + + my $headers = { + PVEDisableProxy => 'true', + PVEClientIP => $clientip, + }; + + $headers->{'cookie'} = PVE::APIServer::Formatter::create_auth_cookie($auth->{ticket}, $self->{cookie_name}) + if $auth->{ticket}; + $headers->{'Authorization'} = PVE::APIServer::Formatter::create_auth_header($auth->{api_token}, $self->{apitoken_name}) + if $auth->{api_token}; + $headers->{'CSRFPreventionToken'} = $auth->{token} + if $auth->{token}; + if ($self->{compression}) { + if ($reqstate->{accept_deflate} && $reqstate->{accept_gzip}) { + $headers->{'Accept-Encoding'} = 'gzip, deflate'; + } elsif ($reqstate->{accept_gzip}) { + $headers->{'Accept-Encoding'} = 'gzip'; + } elsif ($reqstate->{accept_deflate}) { + $headers->{'Accept-Encoding'} = 'deflate'; + } + } + + if (defined(my $host = $reqstate->{request}->header('Host'))) { + $headers->{Host} = $host; + } + + my $content; + + if ($method eq 'POST' || $method eq 'PUT') { + my $request_ct = $reqstate->{request}->header('Content-Type'); + if (defined($request_ct) && $request_ct =~ 'application/json') { + $headers->{'Content-Type'} = 'application/json'; + $content = encode_json($params); + } else { + $headers->{'Content-Type'} = 'application/x-www-form-urlencoded'; + # use URI object to format application/x-www-form-urlencoded content. + my $url = URI->new('http:'); + $url->query_form(%$params); + $content = $url->query; + } + if (defined($content)) { + $headers->{'Content-Length'} = length($content); + } + } + + my $tls = { + # TLS 1.x only, with certificate pinning + method => 'any', + sslv2 => 0, + sslv3 => 0, + verify => 1, + ca_path => '/usr/lib/ssl/certs', # to avoid loading the combined CA cert file + verify_cb => sub { + my (undef, undef, undef, $depth, undef, undef, $cert) = @_; + # we don't care about intermediate or root certificates + return 1 if $depth != 0; + # check server certificate against cache of pinned FPs + return $self->check_cert_fingerprint($cert); + }, + }; + + # load and cache cert fingerprint if first time we proxy to this node + $self->initialize_cert_cache($node); + + my $w; $w = http_request( + $method => $target, + headers => $headers, + timeout => 30, + proxy => undef, # avoid use of $ENV{HTTP_PROXY} + persistent => $persistent, + # if connection reuse is enabled ($persistent is 1), allow one retry, to avoid returning + # HTTP 599 Too many redirections if the server happens to close the connection + recurse => $persistent ? 1 : 0, + # when reusing a connection, send keep-alive headers + keepalive => 1, + body => $content, + tls_ctx => AnyEvent::TLS->new(%{$tls}), + sub { + my ($body, $hdr) = @_; + + undef $w; + + if (!$reqstate->{hdl}) { + warn "proxy detected vanished client connection\n"; + return; + } + + eval { + my $code = delete $hdr->{Status}; + my $msg = delete $hdr->{Reason}; + my $stream = delete $hdr->{pvestreamfile}; + delete $hdr->{URL}; + delete $hdr->{HTTPVersion}; + my $header = HTTP::Headers->new(%$hdr); + if (my $location = $header->header('Location')) { + $location =~ s|^http://localhost:85||; + $header->header(Location => $location); + } + if ($stream) { + if (!$may_stream_file) { + $self->error($reqstate, 403, 'streaming denied'); + return; + } + sysopen(my $fh, "$stream", O_NONBLOCK | O_RDONLY) + or die "open stream path '$stream' for forwarding failed: $!\n"; + my $resp = HTTP::Response->new($code, $msg, $header, undef); + $self->response($reqstate, $resp, undef, 1, 0, $fh); + } else { + my $resp = HTTP::Response->new($code, $msg, $header, $body); + # Note: disable compression, because body is already compressed + $self->response($reqstate, $resp, undef, 1); + } + }; + warn $@ if $@; + }); + }; + warn $@ if $@; +} + +# return arrays as \0 separated strings (like CGI.pm) +# assume data is UTF8 encoded +sub decode_urlencoded { + my ($data) = @_; + + my $res = {}; + + return $res if !$data; + + foreach my $kv (split(/[\&\;]/, $data)) { + my ($k, $v) = split(/=/, $kv); + $k =~s/\+/ /g; + $k =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr(hex($1))/eg; + + if (defined($v)) { + $v =~s/\+/ /g; + $v =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr(hex($1))/eg; + + $v = Encode::decode('utf8', $v); + + if (defined(my $old = $res->{$k})) { + if (ref($old) eq 'ARRAY') { + push @$old, $v; + $v = $old; + } else { + $v = [$old, $v]; + } + } + } + + $res->{$k} = $v; + } + return $res; +} + +sub extract_params { + my ($r, $method) = @_; + + my $params = {}; + + if ($method eq 'PUT' || $method eq 'POST') { + my $ct; + if (my $ctype = $r->header('Content-Type')) { + $ct = parse_content_type($ctype); + } + if (defined($ct) && $ct eq 'application/json') { + $params = decode_json($r->content); + } else { + $params = decode_urlencoded($r->content); + } + } + + my $query_params = decode_urlencoded($r->url->query()); + + foreach my $k (keys %{$query_params}) { + $params->{$k} = $query_params->{$k}; + } + + return $params; +} + +sub handle_api2_request { + my ($self, $reqstate, $auth, $method, $path, $upload_state) = @_; + + eval { + my $r = $reqstate->{request}; + + my ($rel_uri, $format) = &$split_abs_uri($path, $self->{base_uri}); + + my $formatter = PVE::APIServer::Formatter::get_formatter($format, $method, $rel_uri); + + if (!defined($formatter)) { + $self->error($reqstate, HTTP_NOT_IMPLEMENTED, "no formatter for uri $rel_uri, $format"); + return; + } + + #print Dumper($upload_state) if $upload_state; + + my $params; + + if ($upload_state) { + $params = $upload_state->{params}; + } else { + $params = extract_params($r, $method); + } + + delete $params->{_dc} if $params; # remove disable cache parameter + + my $clientip = $reqstate->{peer_host}; + + my $res = $self->rest_handler($clientip, $method, $rel_uri, $auth, $params, $format); + + # HACK: see Note 1 + Net::SSLeay::ERR_clear_error(); + + AnyEvent->now_update(); # in case somebody called sleep() + + my $upgrade = $r->header('upgrade'); + $upgrade = lc($upgrade) if $upgrade; + + if (my $host = $res->{proxy}) { + + if ($self->{trusted_env}) { + $self->error($reqstate, HTTP_INTERNAL_SERVER_ERROR, "proxy not allowed"); + return; + } + + if ($host ne 'localhost' && $r->header('PVEDisableProxy')) { + $self->error($reqstate, HTTP_INTERNAL_SERVER_ERROR, "proxy loop detected"); + return; + } + + $res->{proxy_params}->{tmpfilename} = $reqstate->{tmpfilename} if $upload_state; + + $self->proxy_request( + $reqstate, $clientip, $host, $res->{proxynode}, $method, $r->uri, $auth, $res->{proxy_params}); + return; + + } elsif ($upgrade && ($method eq 'GET') && ($path =~ m|websocket$|)) { + die "unable to upgrade to protocol '$upgrade'\n" if !$upgrade || ($upgrade ne 'websocket'); + my $wsver = $r->header('sec-websocket-version'); + die "unsupported websocket-version '$wsver'\n" if !$wsver || ($wsver ne '13'); + my $wsproto = $r->header('sec-websocket-protocol') // ""; + my $wskey = $r->header('sec-websocket-key'); + die "missing websocket-key\n" if !$wskey; + # Note: Digest::SHA::sha1_base64 has wrong padding + my $wsaccept = Digest::SHA::sha1_base64("${wskey}258EAFA5-E914-47DA-95CA-C5AB0DC85B11") . "="; + if ($res->{status} == HTTP_OK) { + $self->websocket_proxy($reqstate, $wsaccept, $wsproto, $res->{data}); + return; + } + } + + my $delay = 0; + if ($res->{status} == HTTP_UNAUTHORIZED) { + # always delay unauthorized calls by 3 seconds + $delay = 3 - tv_interval($reqstate->{starttime}); + $delay = 0 if $delay < 0; + } + + my $download; + $download = $res->{data}->{download} + if defined($res->{data}) && ref($res->{data}) eq 'HASH'; + if (defined($download)) { + # TODO: remove ->{download} with PVE 9.0 + if ($res->{info}->{download_allowed} || $res->{info}->{download}) { + send_file_start($self, $reqstate, $download); + return; + } else { + warn "Download attempted for non-marked API endpoint '$path'\n"; + } + } + + my ($raw, $ct, $nocomp) = $formatter->($res, $res->{data}, $params, $path, + $auth, $self->{formatter_config}); + + my $resp; + if (ref($raw) && (ref($raw) eq 'HTTP::Response')) { + $resp = $raw; + } else { + $resp = HTTP::Response->new($res->{status}, $res->{message}); + $resp->header("Content-Type" => $ct); + $resp->content($raw); + } + $self->response($reqstate, $resp, undef, $nocomp, $delay); + }; + if (my $err = $@) { + $self->error($reqstate, 501, $err); + } +} + +sub handle_spice_proxy_request { + my ($self, $reqstate, $connect_str, $vmid, $node, $spiceport) = @_; + + eval { + + my ($minport, $maxport) = PVE::Tools::spice_port_range(); + if ($spiceport < $minport || $spiceport > $maxport) { + die "SPICE Port $spiceport is not in allowed range ($minport, $maxport)\n"; + } + + my $clientip = $reqstate->{peer_host}; + my $r = $reqstate->{request}; + + my $remip; + + if ($node ne 'localhost' && PVE::INotify::nodename() !~ m/^$node$/i) { + $remip = $self->remote_node_ip($node); + $self->dprint("REMOTE CONNECT $vmid, $remip, $connect_str"); + } else { + $self->dprint("CONNECT $vmid, $node, $spiceport"); + } + + if ($remip && $r->header('PVEDisableProxy')) { + $self->error($reqstate, HTTP_INTERNAL_SERVER_ERROR, "proxy loop detected"); + return; + } + + $reqstate->{hdl}->timeout(0); + $reqstate->{hdl}->wbuf_max(64*10*1024); + + my $remhost = $remip ? $remip : "localhost"; + my $remport = $remip ? 3128 : $spiceport; + + tcp_connect $remhost, $remport, sub { + my ($fh) = @_ + or die "connect to '$remhost:$remport' failed: $!"; + + $self->dprint("CONNECTed to '$remhost:$remport'"); + $reqstate->{proxyhdl} = AnyEvent::Handle->new( + fh => $fh, + rbuf_max => 64*1024, + wbuf_max => 64*10*1024, + timeout => 5, + on_eof => sub { + my ($hdl) = @_; + eval { + $self->log_aborted_request($reqstate); + $self->client_do_disconnect($reqstate); + }; + if (my $err = $@) { syslog('err', $err); } + }, + on_error => sub { + my ($hdl, $fatal, $message) = @_; + eval { + $self->log_aborted_request($reqstate, $message); + $self->client_do_disconnect($reqstate); + }; + if (my $err = $@) { syslog('err', "$err"); } + }); + + + my $proxyhdlreader = sub { + my ($hdl) = @_; + + my $len = length($hdl->{rbuf}); + my $data = substr($hdl->{rbuf}, 0, $len, ''); + + #print "READ1 $len\n"; + $reqstate->{hdl}->push_write($data) if $reqstate->{hdl}; + }; + + my $hdlreader = sub { + my ($hdl) = @_; + + my $len = length($hdl->{rbuf}); + my $data = substr($hdl->{rbuf}, 0, $len, ''); + + #print "READ0 $len\n"; + $reqstate->{proxyhdl}->push_write($data) if $reqstate->{proxyhdl}; + }; + + my $proto = $reqstate->{proto} ? $reqstate->{proto}->{str} : 'HTTP/1.0'; + + my $startproxy = sub { + $reqstate->{proxyhdl}->timeout(0); + $reqstate->{proxyhdl}->on_read($proxyhdlreader); + $reqstate->{hdl}->on_read($hdlreader); + + # todo: use stop_read/start_read if write buffer grows to much + + # a response must be followed by an empty line + my $res = "$proto 200 OK\015\012\015\012"; + $reqstate->{hdl}->push_write($res); + + # log early + $reqstate->{log}->{code} = 200; + $self->log_request($reqstate); + }; + + if ($remip) { + my $header = "CONNECT ${connect_str} $proto\015\012" . + "Host: ${connect_str}\015\012" . + "Proxy-Connection: keep-alive\015\012" . + "User-Agent: spiceproxy\015\012" . + "PVEDisableProxy: true\015\012" . + "PVEClientIP: $clientip\015\012" . + "\015\012"; + + $reqstate->{proxyhdl}->push_write($header); + $reqstate->{proxyhdl}->push_read(line => sub { + my ($hdl, $line) = @_; + + if ($line =~ m!^$proto 200 OK$!) { + # read the empty line after the 200 OK + $reqstate->{proxyhdl}->unshift_read(line => sub{ + &$startproxy(); + }); + } else { + $reqstate->{hdl}->push_write($line); + $self->client_do_disconnect($reqstate); + } + }); + } else { + &$startproxy(); + } + + }; + }; + if (my $err = $@) { + warn $err; + $self->log_aborted_request($reqstate, $err); + $self->client_do_disconnect($reqstate); + } +} + +sub handle_request { + my ($self, $reqstate, $auth, $method, $path) = @_; + + my $base_uri = $self->{base_uri}; + + eval { + my $r = $reqstate->{request}; + + # disable timeout on handle (we already have all data we need) + # we re-enable timeout in response() + $reqstate->{hdl}->timeout(0); + + if ($path =~ m/^\Q$base_uri\E/) { + $self->handle_api2_request($reqstate, $auth, $method, $path); + return; + } + + if ($self->{pages} && ($method eq 'GET') && (my $handler = $self->{pages}->{$path})) { + if (ref($handler) eq 'CODE') { + my $params = decode_urlencoded($r->url->query()); + my ($resp, $userid) = &$handler($self, $reqstate->{request}, $params); + # HACK: see Note 1 + Net::SSLeay::ERR_clear_error(); + $self->response($reqstate, $resp); + } elsif (ref($handler) eq 'HASH') { + if (my $filename = $handler->{file}) { + my $fh = IO::File->new($filename) || + die "unable to open file '$filename' - $!\n"; + send_file_start($self, $reqstate, { path => $filename }); + } else { + die "internal error - no handler"; + } + } else { + die "internal error - no handler"; + } + return; + } + + if ($self->{dirs} && ($method eq 'GET')) { + # we only allow simple names + if ($path =~ m!^(/\S+/)([a-zA-Z0-9\-\_\.]+)$!) { + my ($subdir, $file) = ($1, $2); + if (my $dir = $self->{dirs}->{$subdir}) { + my $filename = "$dir$file"; + my $fh = IO::File->new($filename) || + die "unable to open file '$filename' - $!\n"; + send_file_start($self, $reqstate, { path => $filename }); + return; + } + } + } + + die "no such file '$path'\n"; + }; + if (my $err = $@) { + $self->error($reqstate, 501, $err); + } +} + +my sub assert_form_disposition { + die "wrong Content-Disposition '$_[0]' in multipart, expected 'form-data'\n" if $_[0] ne 'form-data'; +} + +sub file_upload_multipart { + my ($self, $reqstate, $auth, $method, $path, $rstate) = @_; + + eval { + my $boundary = $rstate->{boundary}; + my $hdl = $reqstate->{hdl}; + my $startlen = length($hdl->{rbuf}); + + my $newline_re = qr/\015?\012/; + my $delim_re = qr/--\Q$boundary\E${newline_re}/; + my $close_delim_re = qr/--\Q$boundary\E--/; + + # Phase 0 - preserve boundary, but remove everything before + if ($rstate->{phase} == 0 && $hdl->{rbuf} =~ s/^.*?($delim_re)/$1/s) { + $rstate->{read} += $startlen - length($hdl->{rbuf}); + $rstate->{phase} = 1; + } + + my $remove_until_data = sub { + my ($hdl) = @_; + # remove any remaining multipart "headers" like Content-Type + $hdl->{rbuf} =~ s/^.*?${newline_re}{2}//s; + }; + + my $extract_form_disposition = sub { + my ($name) = @_; + if ($hdl->{rbuf} =~ s/^${delim_re}.*?Content-Disposition: (.*?); name="$name"(.*?${delim_re})/$2/s) { + assert_form_disposition($1); + $remove_until_data->($hdl); + $hdl->{rbuf} =~ s/^(.*?)(${delim_re})/$2/s; + $rstate->{params}->{$name} = trim($1); + } + }; + + if ($rstate->{phase} == 1) { # Phase 1 - parse payload without file data + $extract_form_disposition->('content'); + $extract_form_disposition->('checksum-algorithm'); + $extract_form_disposition->('checksum'); + + if ($hdl->{rbuf} =~ s/^${delim_re}Content-Disposition: (.*?); name="(.*?)"; filename="([^"]+)"//s) { + assert_form_disposition($1); + die "wrong field name '$2' for file upload, expected 'filename'" if $2 ne "filename"; + $rstate->{phase} = 2; + $rstate->{params}->{filename} = trim($3); + $remove_until_data->($hdl); # any remaining multipart "headers" like Content-Type + } + } + + if ($rstate->{phase} == 2) { # Phase 2 - dump content into file + my ($data, $write_length); + if ($hdl->{rbuf} =~ s/^(.*?)${newline_re}?+${close_delim_re}.*$//s) { + $data = $1; + $write_length = length($data); + $rstate->{phase} = 100; + } else { + $write_length = length($hdl->{rbuf}) - $rstate->{boundlen}; + $data = substr($hdl->{rbuf}, 0, $write_length, '') if $write_length > 0; + } + + if ($write_length > 0) { + syswrite($rstate->{outfh}, $data) == $write_length or die "write to temporary file failed - $!\n"; + $rstate->{bytes} += $write_length; + } + } + + if ($rstate->{phase} == 100) { # Phase 100 - transfer finished + my $elapsed = tv_interval($rstate->{starttime}); + syslog('info', "multipart upload complete (size: %dB time: %.3fs rate: %.2fMiB/s filename: %s)", + $rstate->{bytes}, $elapsed, $rstate->{bytes} / ($elapsed * 1024 * 1024), + $rstate->{params}->{filename} + ); + $self->handle_api2_request($reqstate, $auth, $method, $path, $rstate); + } + + $rstate->{read} += $startlen - length($hdl->{rbuf}); + + if ($rstate->{read} + length($hdl->{rbuf}) >= $rstate->{size} && $rstate->{phase} != 100) { + die "upload failed"; + } + }; + if (my $err = $@) { + syslog('err', $err); + $self->error($reqstate, 501, $err); + } +} + +sub parse_content_type { + my ($ctype) = @_; + + my ($ct, @params) = split(/\s*[;,]\s*/o, $ctype); + + foreach my $v (@params) { + if ($v =~ m/^\s*boundary\s*=\s*(\S+?)\s*$/o) { + return wantarray ? ($ct, $1) : $ct; + } + } + + return wantarray ? ($ct) : $ct; +} + +my $tmpfile_seq_no = 0; + +sub get_upload_filename { + # choose unpredictable tmpfile name + + $tmpfile_seq_no++; + return "/var/tmp/pveupload-" . Digest::MD5::md5_hex($tmpfile_seq_no . time() . $$); +} + +sub unshift_read_header { + my ($self, $reqstate, $state) = @_; + + $state = { size => 0, count => 0 } if !$state; + + $reqstate->{hdl}->unshift_read(line => sub { + my ($hdl, $line) = @_; + + eval { + # print "$$: got header: $line\n" if $self->{debug}; + + die "too many http header lines (> $limit_max_headers)\n" if ++$state->{count} >= $limit_max_headers; + die "http header too large\n" if ($state->{size} += length($line)) >= $limit_max_header_size; + + my $r = $reqstate->{request}; + if ($line eq '') { + + $r->push_header($state->{key}, $state->{val}) + if $state->{key}; + + return if !$self->process_header($reqstate); + return if !$self->ensure_tls_connection($reqstate); + + $self->authenticate_and_handle_request($reqstate); + + } elsif ($line =~ /^([^:\s]+)\s*:\s*(.*)/) { + $r->push_header($state->{key}, $state->{val}) if $state->{key}; + ($state->{key}, $state->{val}) = ($1, $2); + $self->unshift_read_header($reqstate, $state); + } elsif ($line =~ /^\s+(.*)/) { + $state->{val} .= " $1"; + $self->unshift_read_header($reqstate, $state); + } else { + $self->error($reqstate, 506, "unable to parse request header"); + } + }; + warn $@ if $@; + }); +}; + +# sends an (error) response and returns 0 in case of errors +sub process_header { + my ($self, $reqstate) = @_; + + my $request = $reqstate->{request}; + + my $path = uri_unescape($request->uri->path()); + my $method = $request->method(); + + if (!$known_methods->{$method}) { + my $resp = HTTP::Response->new(HTTP_NOT_IMPLEMENTED, "method '$method' not available"); + $self->response($reqstate, $resp); + return 0; + } + + my $conn = $request->header('Connection'); + my $accept_enc = $request->header('Accept-Encoding'); + $reqstate->{accept_gzip} = ($accept_enc && $accept_enc =~ m/gzip/) ? 1 : 0; + $reqstate->{accept_deflate} = ($accept_enc && $accept_enc =~ m/deflate/) ? 1 : 0; + + if ($conn) { + $reqstate->{keep_alive} = 0 if $conn =~ m/close/oi; + } else { + if ($reqstate->{proto}->{ver} < 1001) { + $reqstate->{keep_alive} = 0; + } + } + + my $te = $request->header('Transfer-Encoding'); + if ($te && lc($te) eq 'chunked') { + # Handle chunked transfer encoding + $self->error($reqstate, 501, "chunked transfer encoding not supported"); + return 0; + } elsif ($te) { + $self->error($reqstate, 501, "Unknown transfer encoding '$te'"); + return 0; + } + + my $pveclientip = $request->header('PVEClientIP'); + + # fixme: how can we make PVEClientIP header trusted? + if ($self->{trusted_env} && $pveclientip) { + $reqstate->{peer_host} = $pveclientip; + } else { + $request->header('PVEClientIP', $reqstate->{peer_host}); + } + + if (my $rpcenv = $self->{rpcenv}) { + $rpcenv->set_request_host($request->header('Host')); + } + + return 1; +} + +# sends an (redirect) response, disconnects the client and returns 0 if +# connection is not TLS-protected +sub ensure_tls_connection { + my ($self, $reqstate) = @_; + + # Skip if server doesn't use TLS + if (!$self->{tls_ctx}) { + return 1; + } + + # TLS session exists, so the handshake has succeeded + if ($reqstate->{hdl}->{tls}) { + return 1; + } + + my $request = $reqstate->{request}; + my $method = $request->method(); + + my $h_host = $reqstate->{request}->header('Host'); + + die "Header field 'Host' not found in request\n" + if !$h_host; + + my $secure_host = "https://" . ($h_host =~ s/^http(s)?:\/\///r); + + my $header = HTTP::Headers->new('Location' => $secure_host . $request->uri()); + + if ($method eq 'GET' || $method eq 'HEAD') { + $self->error($reqstate, 301, 'Moved Permanently', $header); + } else { + $self->error($reqstate, 308, 'Permanent Redirect', $header); + } + + # disconnect the client so they may immediately connect again via HTTPS + $self->client_do_disconnect($reqstate); + + return 0; +} + +sub authenticate_and_handle_request { + my ($self, $reqstate) = @_; + + my $request = $reqstate->{request}; + my $method = $request->method(); + + my $path = uri_unescape($request->uri->path()); + my $base_uri = $self->{base_uri}; + + my $auth = {}; + + if ($self->{spiceproxy}) { + my $connect_str = $request->header('Host'); + my ($vmid, $node, $port) = $self->verify_spice_connect_url($connect_str); + + if (!(defined($vmid) && $node && $port)) { + $self->error($reqstate, HTTP_UNAUTHORIZED, "invalid ticket"); + return; + } + + $self->handle_spice_proxy_request($reqstate, $connect_str, $vmid, $node, $port); + return; + + } elsif ($path =~ m/^\Q$base_uri\E/) { + my $token = $request->header('CSRFPreventionToken'); + my $cookie = $request->header('Cookie'); + my $auth_header = $request->header('Authorization'); + + # prefer actual cookie + my $ticket = PVE::APIServer::Formatter::extract_auth_value( + $cookie, + $self->{cookie_name} + ); + + # fallback to cookie in 'Authorization' header + if (!$ticket) { + $ticket = PVE::APIServer::Formatter::extract_auth_value( + $auth_header, + $self->{cookie_name} + ); + } + + # finally, fallback to API token if no ticket has been provided so far + my $api_token; + if (!$ticket) { + $api_token = PVE::APIServer::Formatter::extract_auth_value( + $auth_header, + $self->{apitoken_name} + ); + } + + my ($rel_uri, $format) = &$split_abs_uri($path, $self->{base_uri}); + if (!$format) { + $self->error($reqstate, HTTP_NOT_IMPLEMENTED, "no such uri"); + return; + } + + eval { + $auth = $self->auth_handler( + $method, + $rel_uri, + $ticket, + $token, + $api_token, + $reqstate->{peer_host} + ); + }; + if (my $err = $@) { + # HACK: see Note 1 + Net::SSLeay::ERR_clear_error(); + # always delay unauthorized calls by 3 seconds + my $delay = 3; + + if (ref($err) eq "PVE::Exception") { + + $err->{code} ||= HTTP_INTERNAL_SERVER_ERROR, + my $resp = HTTP::Response->new($err->{code}, $err->{msg}); + $self->response($reqstate, $resp, undef, 0, $delay); + + } elsif (my $formatter = PVE::APIServer::Formatter::get_login_formatter($format)) { + my ($raw, $ct, $nocomp) = + $formatter->($path, $auth, $self->{formatter_config}); + + my $resp; + if (ref($raw) && (ref($raw) eq 'HTTP::Response')) { + $resp = $raw; + + } else { + $resp = HTTP::Response->new(HTTP_UNAUTHORIZED, "Login Required"); + $resp->header("Content-Type" => $ct); + $resp->content($raw); + } + + $self->response($reqstate, $resp, undef, $nocomp, $delay); + + } else { + my $resp = HTTP::Response->new(HTTP_UNAUTHORIZED, $err); + $self->response($reqstate, $resp, undef, 0, $delay); + } + + return; + } + } + + $reqstate->{log}->{userid} = $auth->{userid}; + my $len = $request->header('Content-Length'); + + if ($len) { + + if (!($method eq 'PUT' || $method eq 'POST')) { + $self->error($reqstate, 501, "Unexpected content for method '$method'"); + return; + } + + my $ctype = $request->header('Content-Type'); + my ($ct, $boundary) = $ctype ? parse_content_type($ctype) : (); + + if ($auth->{isUpload} && !$self->{trusted_env}) { + die "upload 'Content-Type '$ctype' not implemented\n" + if !($boundary && $ct && ($ct eq 'multipart/form-data')); + + die "upload without content length header not supported" if !$len; + + die "upload without content length header not supported" if !$len; + + $self->dprint("start upload $path $ct $boundary"); + + my $tmpfilename = get_upload_filename(); + my $outfh = IO::File->new($tmpfilename, O_RDWR|O_CREAT|O_EXCL, 0600) || + die "unable to create temporary upload file '$tmpfilename'"; + + $reqstate->{keep_alive} = 0; + + my $boundlen = length($boundary) + 8; # \015?\012--$boundary--\015?\012 + + my $state = { + size => $len, + boundary => $boundary, + boundlen => $boundlen, + maxheader => 2048 + $boundlen, # should be large enough + params => decode_urlencoded($request->url->query()), + phase => 0, + read => 0, + post_size => 0, + starttime => [gettimeofday], + outfh => $outfh, + }; + + die "'tmpfilename' query parameter is not allowed for file uploads\n" + if exists $state->{params}->{tmpfilename}; + + $reqstate->{tmpfilename} = $tmpfilename; + $reqstate->{hdl}->on_read(sub { + $self->file_upload_multipart($reqstate, $auth, $method, $path, $state); + }); + + return; + } + + if ($len > $limit_max_post) { + $self->error($reqstate, 501, "for data too large"); + return; + } + + if (!$ct || $ct eq 'application/x-www-form-urlencoded' || $ct eq 'application/json') { + $reqstate->{hdl}->unshift_read(chunk => $len, sub { + my ($hdl, $data) = @_; + $request->content($data); + $self->handle_request($reqstate, $auth, $method, $path); + }); + + } else { + $self->error($reqstate, 506, "upload 'Content-Type '$ctype' not implemented"); + } + + } else { + $self->handle_request($reqstate, $auth, $method, $path); + } +} + +sub push_request_header { + my ($self, $reqstate) = @_; + + eval { + $reqstate->{hdl}->push_read(line => sub { + my ($hdl, $line) = @_; + + eval { + # print "got request header: $line\n" if $self->{debug}; + + $reqstate->{keep_alive}--; + + if ($line =~ /(\S+)\040(\S+)\040HTTP\/(\d+)\.(\d+)/o) { + my ($method, $url, $maj, $min) = ($1, $2, $3, $4); + + if ($maj != 1) { + $self->error($reqstate, 506, "http protocol version $maj.$min not supported"); + return; + } + if ($url =~ m|^[^/]*@|) { + # if an '@' comes before the first slash proxy forwarding might consider + # the frist part of the url to be part of an authority... + $self->error($reqstate, 400, "invalid url"); + return; + } + + $self->{request_count}++; # only count valid request headers + if ($self->{request_count} >= $self->{max_requests}) { + $self->{end_loop} = 1; + } + $reqstate->{log} = { requestline => $line }; + $reqstate->{proto}->{str} = "HTTP/$maj.$min"; + $reqstate->{proto}->{maj} = $maj; + $reqstate->{proto}->{min} = $min; + $reqstate->{proto}->{ver} = $maj*1000+$min; + $reqstate->{request} = HTTP::Request->new($method, $url); + $reqstate->{starttime} = [gettimeofday]; + + $self->unshift_read_header($reqstate); + } elsif ($line eq '') { + # ignore empty lines before requests (browser bugs?) + $self->push_request_header($reqstate); + } else { + $self->error($reqstate, 400, 'bad request'); + } + }; + warn $@ if $@; + }); + }; + warn $@ if $@; +} + +sub accept { + my ($self) = @_; + + my $clientfh; + + return if $self->{end_loop}; + + # we need to m make sure that only one process calls accept + while (!flock($self->{lockfh}, Fcntl::LOCK_EX())) { + next if $! == EINTR; + die "could not get lock on file '$self->{lockfile}' - $!\n"; + } + + my $again = 0; + my $errmsg; + eval { + while (!$self->{end_loop} && + !defined($clientfh = $self->{socket}->accept()) && + ($! == EINTR)) {}; + + if ($self->{end_loop}) { + $again = 0; + } else { + $again = ($! == EAGAIN || $! == WSAEWOULDBLOCK); + if (!defined($clientfh)) { + $errmsg = "failed to accept connection: $!\n"; + } + } + }; + warn $@ if $@; + + flock($self->{lockfh}, Fcntl::LOCK_UN()); + + if (!defined($clientfh)) { + return if $again; + die $errmsg if $errmsg; + } + + fh_nonblocking $clientfh, 1; + + return $clientfh; +} + +sub wait_end_loop { + my ($self) = @_; + + $self->{end_loop} = 1; + + undef $self->{socket_watch}; + + $0 = "$0 (shutdown)" if $0 !~ m/\(shutdown\)$/; + + if ($self->{conn_count} <= 0) { + $self->{end_cond}->send(1); + return; + } + + # fork and exit, so that parent starts a new worker + if (fork()) { + exit(0); + } + + # else we need to wait until all open connections gets closed + my $w; $w = AnyEvent->timer (after => 1, interval => 1, cb => sub { + eval { + # todo: test for active connections instead (we can abort idle connections) + if ($self->{conn_count} <= 0) { + undef $w; + $self->{end_cond}->send(1); + } + }; + warn $@ if $@; + }); +} + + +sub check_host_access { + my ($self, $clientip) = @_; + + $clientip = PVE::APIServer::Utils::normalize_v4_in_v6($clientip); + my $cip = Net::IP->new($clientip); + + if (!$cip) { + $self->dprint("client IP not parsable: $@"); + return 0; + } + + my $match_allow = 0; + my $match_deny = 0; + + if ($self->{allow_from}) { + foreach my $t (@{$self->{allow_from}}) { + if ($t->overlaps($cip)) { + $match_allow = 1; + $self->dprint("client IP allowed: ". $t->print()); + last; + } + } + } + + if ($self->{deny_from}) { + foreach my $t (@{$self->{deny_from}}) { + if ($t->overlaps($cip)) { + $self->dprint("client IP denied: ". $t->print()); + $match_deny = 1; + last; + } + } + } + + if ($match_allow == $match_deny) { + # match both allow and deny, or no match + return $self->{policy} && $self->{policy} eq 'allow' ? 1 : 0; + } + + return $match_allow; +} + +sub accept_connections { + my ($self) = @_; + + my ($clientfh, $handle_creation); + eval { + + while ($clientfh = $self->accept()) { + + my $reqstate = { keep_alive => $self->{keep_alive} }; + + # stop keep-alive when there are many open connections + if ($self->{conn_count} + 1 >= $self->{max_conn_soft_limit}) { + $reqstate->{keep_alive} = 0; + } + + if (my $sin = getpeername($clientfh)) { + my ($pfamily, $pport, $phost) = PVE::Tools::unpack_sockaddr_in46($sin); + ($reqstate->{peer_port}, $reqstate->{peer_host}) = ($pport, Socket::inet_ntop($pfamily, $phost)); + } else { + $self->dprint("getpeername failed: $!"); + close($clientfh); + next; + } + + if (!$self->{trusted_env} && !$self->check_host_access($reqstate->{peer_host})) { + $self->dprint("ABORT request from $reqstate->{peer_host} - access denied"); + $reqstate->{log}->{code} = 403; + $self->log_request($reqstate); + close($clientfh); + next; + } + + # Increment conn_count before creating new handle, since creation + # triggers callbacks, which can potentialy decrement (e.g. + # on_error) conn_count before AnyEvent::Handle->new() returns. + $handle_creation = 1; + $self->{conn_count}++; + $reqstate->{hdl} = AnyEvent::Handle->new( + fh => $clientfh, + rbuf_max => 64*1024, + timeout => $self->{timeout}, + linger => 0, # avoid problems with ssh - really needed ? + on_eof => sub { + my ($hdl) = @_; + eval { + $self->log_aborted_request($reqstate); + $self->client_do_disconnect($reqstate); + }; + if (my $err = $@) { syslog('err', $err); } + }, + on_error => sub { + my ($hdl, $fatal, $message) = @_; + eval { + $self->log_aborted_request($reqstate, $message); + $self->client_do_disconnect($reqstate); + }; + if (my $err = $@) { syslog('err', "$err"); } + }, + ); + $handle_creation = 0; + + $self->dprint("ACCEPT FH" . $clientfh->fileno() . " CONN$self->{conn_count}"); + + if ($self->{tls_ctx}) { + $self->dprint("Setting TLS to autostart"); + $reqstate->{hdl}->unshift_read(tls_autostart => $self->{tls_ctx}, "accept"); + } + + $self->push_request_header($reqstate); + } + }; + + if (my $err = $@) { + syslog('err', $err); + $self->dprint("connection accept error: $err"); + close($clientfh); + if ($handle_creation) { + if ($self->{conn_count} <= 0) { + warn "connection count <= 0 not decrementing!\n"; + } else { + $self->{conn_count}--; + } + } + $self->{end_loop} = 1; + } + + $self->wait_end_loop() if $self->{end_loop}; +} + +# Note: We can't open log file in non-blocking mode and use AnyEvent::Handle, +# because we write from multiple processes, and that would arbitrarily mix output +# of all processes. +sub open_access_log { + my ($self, $filename) = @_; + + my $old_mask = umask(0137);; + my $logfh = IO::File->new($filename, ">>") || + die "unable to open log file '$filename' - $!\n"; + umask($old_mask); + + $logfh->autoflush(1); + + $self->{logfh} = $logfh; +} + +sub write_log { + my ($self, $data) = @_; + + return if !defined($self->{logfh}) || !$data; + + my $res = $self->{logfh}->print($data); + + if (!$res) { + delete $self->{logfh}; + syslog('err', "error writing access log"); + $self->{end_loop} = 1; # terminate asap + } +} + +sub atfork_handler { + my ($self) = @_; + + eval { + # something else do to ? + close($self->{socket}); + }; + warn $@ if $@; +} + +sub run { + my ($self) = @_; + + $self->{end_cond}->recv; +} + +sub new { + my ($this, %args) = @_; + + my $class = ref($this) || $this; + + foreach my $req (qw(socket lockfh lockfile)) { + die "misssing required argument '$req'" if !defined($args{$req}); + } + + my $self = bless { %args }, $class; + + $self->{cookie_name} //= 'PVEAuthCookie'; + $self->{apitoken_name} //= 'PVEAPIToken'; + $self->{base_uri} //= "/api2"; + $self->{dirs} //= {}; + $self->{title} //= 'API Inspector'; + $self->{compression} //= 1; + + # formatter_config: we pass some configuration values to the Formatter + $self->{formatter_config} = {}; + foreach my $p (qw(apitoken_name cookie_name base_uri title)) { + $self->{formatter_config}->{$p} = $self->{$p}; + } + $self->{formatter_config}->{csrfgen_func} = + $self->can('generate_csrf_prevention_token'); + + # add default dirs which includes jquery and bootstrap + my $jsbase = '/usr/share/javascript'; + add_dirs($self->{dirs}, '/js/' => "$jsbase/"); + # libjs-bootstrap uses symlinks for this, which we do not want to allow.. + my $glyphicons = '/usr/share/javascript/bootstrap/fonts/'; + add_dirs($self->{dirs}, '/js/bootstrap/fonts/' => "$glyphicons"); + + # init inotify + PVE::INotify::inotify_init(); + + fh_nonblocking($self->{socket}, 1); + + $self->{end_loop} = 0; + $self->{conn_count} = 0; + $self->{request_count} = 0; + $self->{timeout} = 5 if !$self->{timeout}; + $self->{keep_alive} = 0 if !defined($self->{keep_alive}); + $self->{max_conn} = 800 if !$self->{max_conn}; + $self->{max_requests} = 8000 if !$self->{max_requests}; + + $self->{policy} = 'allow' if !$self->{policy}; + + $self->{end_cond} = AnyEvent->condvar; + + if ($self->{ssl}) { + my $ssl_defaults = { + # Note: older versions are considered insecure, for example + # search for "Poodle"-Attack + method => 'any', + sslv2 => 0, + sslv3 => 0, + cipher_list => 'ECDHE-ECDSA-AES256-GCM-SHA384:ECDHE-RSA-AES256-GCM-SHA384:ECDHE-ECDSA-CHACHA20-POLY1305:ECDHE-RSA-CHACHA20-POLY1305:ECDHE-ECDSA-AES128-GCM-SHA256:ECDHE-RSA-AES128-GCM-SHA256:ECDHE-ECDSA-AES256-SHA384:ECDHE-RSA-AES256-SHA384:ECDHE-ECDSA-AES128-SHA256:ECDHE-RSA-AES128-SHA256', + honor_cipher_order => 1, + }; + + # workaround until anyevent supports TLS 1.3 ciphersuites directly + my $ciphersuites = delete $self->{ssl}->{ciphersuites}; + + foreach my $k (keys %$ssl_defaults) { + $self->{ssl}->{$k} //= $ssl_defaults->{$k}; + } + + if (!defined($self->{ssl}->{dh_file})) { + $self->{ssl}->{dh} = 'skip2048'; + } + + my $tls_ctx_flags = 0; + $tls_ctx_flags |= &Net::SSLeay::OP_NO_COMPRESSION; + $tls_ctx_flags |= &Net::SSLeay::OP_SINGLE_ECDH_USE; + $tls_ctx_flags |= &Net::SSLeay::OP_SINGLE_DH_USE; + $tls_ctx_flags |= &Net::SSLeay::OP_NO_RENEGOTIATION; + if (delete $self->{ssl}->{honor_cipher_order}) { + $tls_ctx_flags |= &Net::SSLeay::OP_CIPHER_SERVER_PREFERENCE; + } + # workaround until anyevent supports disabling TLS 1.3 directly + if (exists($self->{ssl}->{tlsv1_3}) && !$self->{ssl}->{tlsv1_3}) { + $tls_ctx_flags |= &Net::SSLeay::OP_NO_TLSv1_3; + } + + + $self->{tls_ctx} = AnyEvent::TLS->new(%{$self->{ssl}}); + Net::SSLeay::CTX_set_options($self->{tls_ctx}->{ctx}, $tls_ctx_flags); + if (defined($ciphersuites)) { + warn "Failed to set TLS 1.3 ciphersuites '$ciphersuites'\n" + if !Net::SSLeay::CTX_set_ciphersuites($self->{tls_ctx}->{ctx}, $ciphersuites); + } + + my $opts = Net::SSLeay::CTX_get_options($self->{tls_ctx}->{ctx}); + my $min_version = Net::SSLeay::TLS1_1_VERSION(); + my $max_version = Net::SSLeay::TLS1_3_VERSION(); + if ($opts & &Net::SSLeay::OP_NO_TLSv1_1) { + $min_version = Net::SSLeay::TLS1_2_VERSION(); + } + if ($opts & &Net::SSLeay::OP_NO_TLSv1_2) { + $min_version = Net::SSLeay::TLS1_3_VERSION(); + } + if ($opts & &Net::SSLeay::OP_NO_TLSv1_3) { + die "misconfigured TLS settings - cannot disable all supported TLS versions!\n" + if $min_version && $min_version == Net::SSLeay::TLS1_3_VERSION(); + $max_version = Net::SSLeay::TLS1_2_VERSION(); + } + Net::SSLeay::CTX_set_min_proto_version($self->{tls_ctx}->{ctx}, $min_version) if $min_version; + Net::SSLeay::CTX_set_max_proto_version($self->{tls_ctx}->{ctx}, $max_version); + } + + if ($self->{spiceproxy}) { + $known_methods = { CONNECT => 1 }; + } + + $self->open_access_log($self->{logfile}) if $self->{logfile}; + + $self->{max_conn_soft_limit} = $self->{max_conn} > 100 ? $self->{max_conn} - 20 : $self->{max_conn}; + + $self->{socket_watch} = AnyEvent->io(fh => $self->{socket}, poll => 'r', cb => sub { + eval { + if ($self->{conn_count} >= $self->{max_conn}) { + my $w; $w = AnyEvent->timer (after => 1, interval => 1, cb => sub { + if ($self->{conn_count} < $self->{max_conn}) { + undef $w; + $self->accept_connections(); + } + }); + } else { + $self->accept_connections(); + } + }; + warn $@ if $@; + }); + + $self->{term_watch} = AnyEvent->signal(signal => "TERM", cb => sub { + undef $self->{term_watch}; + $self->wait_end_loop(); + }); + + $self->{quit_watch} = AnyEvent->signal(signal => "QUIT", cb => sub { + undef $self->{quit_watch}; + $self->wait_end_loop(); + }); + + $self->{inotify_poll} = AnyEvent->timer(after => 5, interval => 5, cb => sub { + PVE::INotify::poll(); # read inotify events + }); + + return $self; +} + +# static helper to add directory including all subdirs +# This can be used to setup $self->{dirs} +sub add_dirs { + my ($result_hash, $alias, $subdir) = @_; + + $result_hash->{$alias} = $subdir; + + my $wanted = sub { + my $dir = $File::Find::dir; + if ($dir =~m!^$subdir(.*)$!) { + my $name = "$alias$1/"; + $result_hash->{$name} = "$dir/"; + } + }; + + find({wanted => $wanted, follow => 0, no_chdir => 1}, $subdir); +} + +# abstract functions - subclass should overwrite/implement them + +sub verify_spice_connect_url { + my ($self, $connect_str) = @_; + + die "implement me"; + + #return ($vmid, $node, $port); +} + +# formatters can call this when the generate a new page +sub generate_csrf_prevention_token { + my ($username) = @_; + + return undef; # do nothing by default +} + +sub auth_handler { + my ($self, $method, $rel_uri, $ticket, $token, $api_token, $peer_host) = @_; + + die "implement me"; + + # return { + # ticket => $ticket, + # token => $token, + # userid => $username, + # age => $age, + # isUpload => $isUpload, + # api_token => $api_token, + #}; +} + +sub rest_handler { + my ($self, $clientip, $method, $rel_uri, $auth, $params, $format) = @_; + + # please do not raise exceptions here (always return a result). + + return { + status => HTTP_NOT_IMPLEMENTED, + message => "Method '$method $rel_uri' not implemented", + }; + + # this should return the following properties, which + # are then passed to the Formatter + + # status: HTTP status code + # message: Error message + # errors: more detailed error hash (per parameter) + # info: reference to JSON schema definition - useful to format output + # data: result data + + # total: additional info passed to output + # changes: additional info passed to output + + # if you want to proxy the request to another node return this + # { proxy => $remip, proxynode => $node, proxy_params => $params }; + + # to pass the request to the local priviledged daemon use: + # { proxy => 'localhost' , proxy_params => $params }; + + # to download aspecific file use: + # { download => "/path/to/file" }; +} + +sub check_cert_fingerprint { + my ($self, $cert) = @_; + + die "implement me"; + } + +sub initialize_cert_cache { + my ($self, $node) = @_; + + die "implement me"; +} + +sub remote_node_ip { + my ($self, $node) = @_; + + die "implement me"; + + # return $remip; +} + + +1; diff --git a/src/PVE/APIServer/Formatter.pm b/src/PVE/APIServer/Formatter.pm new file mode 100644 index 0000000..a8550a6 --- /dev/null +++ b/src/PVE/APIServer/Formatter.pm @@ -0,0 +1,107 @@ +package PVE::APIServer::Formatter; + +use strict; +use warnings; + +use URI::Escape; + +# generic formatter support +# PVE::APIServer::Formatter::* classes should register themselves here + +my $formatter_hash = {}; +my $page_formatter_hash = {}; + +sub register_formatter { + my ($format, $code) = @_; + + die "formatter '$format' already defined" + if defined($formatter_hash->{$format}); + + $formatter_hash->{$format} = $code; +} + +sub register_page_formatter { + my (%config) = @_; + + my $format = $config{format} || + die "missing format"; + + my $path = $config{path} || + die "missing path"; + + my $method = $config{method} || + die "missing method"; + + my $code = $config{code} || + die "missing formatter code"; + + die "duplicate page formatter for '$method: $path'" + if defined($page_formatter_hash->{$format}->{$method}->{$path}); + + $page_formatter_hash->{$format}->{$method}->{$path} = $code; +} + +sub get_formatter { + my ($format, $method, $path) = @_; + + return undef if !defined($format); + + if (defined($method) && defined($path)) { + my $code = $page_formatter_hash->{$format}->{$method}->{$path}; + return $code if defined($code); + } + + return $formatter_hash->{$format}; +} + +my $login_formatter_hash = {}; + +sub register_login_formatter { + my ($format, $code) = @_; + + die "login formatter '$format' already defined" + if defined($login_formatter_hash->{$format}); + + $login_formatter_hash->{$format} = $code; +} + +sub get_login_formatter { + my ($format) = @_; + + return undef if !defined($format); + + return $login_formatter_hash->{$format}; +} + +# some helper functions + +sub extract_auth_value { + my ($header, $key) = @_; + + return undef if !$header; + + my $value = ($header =~ /(?:^|\s)\Q$key\E(?:=| )([^;]*)/)[0]; + + $value = uri_unescape($value) if $value; + + return $value; +} + +sub create_auth_cookie { + my ($ticket, $cookie_name) = @_; + + my $encticket = uri_escape($ticket); + + return "${cookie_name}=$encticket; path=/; secure; SameSite=Lax;"; +} + +sub create_auth_header { + my ($value, $key) = @_; + + return undef if !$key; + + my $encoded = uri_escape($value); + return "${key} ${encoded}"; +} + +1; diff --git a/src/PVE/APIServer/Formatter/Bootstrap.pm b/src/PVE/APIServer/Formatter/Bootstrap.pm new file mode 100644 index 0000000..6be0049 --- /dev/null +++ b/src/PVE/APIServer/Formatter/Bootstrap.pm @@ -0,0 +1,237 @@ +package PVE::APIServer::Formatter::Bootstrap; + +use strict; +use warnings; + +use HTML::Entities; +use JSON; +use URI::Escape; + +# FIXME: remove console code?? + +# Helpers to generate simple html pages using Bootstrap markup. + +my $jssrc = <<_EOJS; +PVE.open_vm_console = function(node, vmid) { + console.log("open vm " + vmid + " on node " + node); + + var downloadWithName = function(uri, name) { + var link = jQuery('#pve_console_anchor'); + link.attr("href", uri); + + // Note: we need to tell android the correct file name extension + // but we do not set 'download' tag for other environments, because + // It can have strange side effects (additional user prompt on firefox) + var andriod = navigator.userAgent.match(/Android/i) ? true : false; + if (andriod) { + link.attr("download", name); + } + + if (document.createEvent) { + var evt = document.createEvent("MouseEvents"); + evt.initMouseEvent('click', true, true, window, 1, 0, 0, 0, 0, false, false, false, false, 0, null); + link.get(0).dispatchEvent(evt); + } else { + link.get(0).fireEvent('onclick'); + } + }; + + jQuery.ajax("/api2/json/console", { + data: { vmid: vmid, node: node }, + headers: { CSRFPreventionToken: PVE.CSRFPreventionToken }, + dataType: 'json', + type: 'POST', + error: function(jqXHR, textStatus, errorThrown) { + // fixme: howto view JS errors ? + console.log("ERROR " + textStatus + ": " + errorThrown); + }, + success: function(data) { + var raw = "[virt-viewer]\\n"; + jQuery.each(data.data, function(k, v) { + raw += k + "=" + v + "\\n"; + }); + var url = 'data:application/x-virt-viewer;charset=UTF-8,' + + encodeURIComponent(raw); + + downloadWithName(url, "pve-spice.vv"); + } + }); +}; +_EOJS + +sub new { + my ($class, $res, $url, $auth, $config) = @_; + + my $self = bless { + url => $url, + title => $config->{title}, + cookie_name => $config->{cookie_name}, + apitoken_name => $config->{apitoken_name}, + js => '', + }, $class; + + if (my $username = $auth->{userid}) { + $self->{csrftoken} = $config->{csrfgen_func}->($username); + } + + return $self; +} + +sub body { + my ($self, $html) = @_; + + my $jssetup = "PVE = {};\n\n"; # create namespace + + if ($self->{csrftoken}) { + $jssetup .= "PVE.CSRFPreventionToken = '$self->{csrftoken}';\n"; + } + + $jssetup .= "PVE.delete_auth_cookie = function() {\n"; + + if ($self->{cookie_name}) { + $jssetup .= " document.cookie = \"$self->{cookie_name}=; expires=Thu, 01 Jan 1970 00:00:01 GMT; path=/; secure; SameSite=Lax;\";\n"; + }; + $jssetup .= "};\n"; + + return <<_EOD; + + + + + + + $self->{title} + + + + + + + + + + + + + + + + + $html + + + +_EOD +} + +my $comp_id_counter = 0; + +sub el { + my ($self, %param) = @_; + + $param{tag} = 'div' if !$param{tag}; + + my $id; + + my $html = "<$param{tag}"; + + if (wantarray) { + $comp_id_counter++; + $id = "pveid$comp_id_counter"; + $html .= " id=$id"; + } + + my $skip = { + tag => 1, + cn => 1, + html => 1, + text => 1, + }; + + my $boolattr = { + required => 1, + autofocus => 1, + }; + + my $noescape = { + placeholder => 1, + }; + + foreach my $attr (keys %param) { + next if $skip->{$attr}; + my $v = $noescape->{$attr} ? $param{$attr} : uri_escape_utf8($param{$attr}, "^\/\ A-Za-z0-9\-\._~"); + next if !defined($v); + if ($boolattr->{$attr}) { + $html .= " $attr" if $v; + } else { + $html .= " $attr=\"$v\""; + } + } + + $html .= ">"; + + + if (my $cn = $param{cn}) { + if(ref($cn) eq 'ARRAY'){ + foreach my $rec (@$cn) { + $html .= $self->el(%$rec); + } + } else { + $html .= $self->el(%$cn); + } + } elsif ($param{html}) { + $html .= $param{html}; + } elsif ($param{text}) { + $html .= encode_entities($param{text}); + } + + $html .= ""; + + return wantarray ? ($html, $id) : $html; +} + +sub alert { + my ($self, %param) = @_; + + return $self->el(class => "alert alert-danger", %param); +} + +sub add_js { + my ($self, $js) = @_; + + $self->{js} .= $js . "\n"; +} + +my $format_event_callback = sub { + my ($info) = @_; + + my $pstr = encode_json($info->{param}); + return "function(e){$info->{fn}.apply(e, $pstr);}"; +}; + +sub button { + my ($self, %param) = @_; + + $param{tag} = 'button'; + $param{class} = "btn btn-default btn-xs"; + + if (my $click = delete $param{click}) { + my ($html, $id) = $self->el(%param); + my $cb = &$format_event_callback($click); + $self->add_js("jQuery('#$id').on('click', $cb);"); + return $html; + } else { + return $self->el(%param); + } +} + +1; diff --git a/src/PVE/APIServer/Formatter/HTML.pm b/src/PVE/APIServer/Formatter/HTML.pm new file mode 100644 index 0000000..80617ca --- /dev/null +++ b/src/PVE/APIServer/Formatter/HTML.pm @@ -0,0 +1,296 @@ +package PVE::APIServer::Formatter::HTML; + +use strict; +use warnings; + +use PVE::APIServer::Formatter; +use HTTP::Status; +use JSON; +use HTML::Entities; +use PVE::JSONSchema; +use PVE::APIServer::Formatter::Bootstrap; +use PVE::APIServer::Formatter::Standard; + +my $portal_format = 'html'; +my $portal_ct = 'text/html;charset=UTF-8'; + +my $get_portal_base_url = sub { + my ($config) = @_; + return "$config->{base_uri}/$portal_format"; +}; + +my $get_portal_login_url = sub { + my ($config) = @_; + return "$config->{base_uri}/$portal_format/access/ticket"; +}; + +sub render_page { + my ($doc, $html, $config) = @_; + + my $items = []; + + push @$items, { + tag => 'li', + cn => { + tag => 'a', + href => $get_portal_login_url->($config), + onClick => "PVE.delete_auth_cookie();", + text => "Logout", + }}; + + my $base_url = $get_portal_base_url->($config); + + my $nav = $doc->el( + class => "navbar navbar-inverse navbar-fixed-top", + role => "navigation", cn => { + class => "container", cn => [ + { + class => "navbar-header", cn => [ + { + tag => 'button', + type => 'button', + class => "navbar-toggle", + 'data-toggle' => "collapse", + 'data-target' => ".navbar-collapse", + cn => [ + { tag => 'span', class => 'sr-only', text => "Toggle navigation" }, + { tag => 'span', class => 'icon-bar' }, + { tag => 'span', class => 'icon-bar' }, + { tag => 'span', class => 'icon-bar' }, + ], + }, + { + tag => 'a', + class => "navbar-brand", + href => $base_url, + text => $config->{title}, + }, + ], + }, + { + class => "collapse navbar-collapse", + cn => { + tag => 'ul', + class => "nav navbar-nav", + cn => $items, + }, + }, + ], + }); + + $items = []; + my @pcomp = split('/', $doc->{url}); + shift @pcomp; # empty + shift @pcomp; # api2 + shift @pcomp; # $format + + my $href = $base_url; + push @$items, { tag => 'li', cn => { + tag => 'a', + href => $href, + text => 'Home'}}; + + foreach my $comp (@pcomp) { + $href .= "/".encode_entities($comp); + push @$items, { tag => 'li', cn => { + tag => 'a', + href => $href, + text => $comp}}; + } + + my $breadcrumbs = $doc->el(tag => 'ol', class => 'breadcrumb container', cn => $items); + + return $doc->body($nav . $breadcrumbs . $html); +} + +my $login_form = sub { + my ($config, $doc, $param, $errmsg) = @_; + + $param = {} if !$param; + + my $username = $param->{username} || ''; + my $password = $param->{password} || ''; + + my $items = [ + { + tag => 'label', + text => "Please sign in", + }, + { + tag => 'input', + type => 'text', + class => 'form-control', + name => 'username', + value => $username, + placeholder => "Enter user name", + required => 1, + autofocus => 1, + }, + { + tag => 'input', + type => 'password', + class => 'form-control', + name => 'password', + value => $password, + placeholder => 'Password', + required => 1, + }, + ]; + + my $html = ''; + + $html .= $doc->alert(text => $errmsg) if ($errmsg); + + $html .= $doc->el( + class => 'container', + cn => { + tag => 'form', + role => 'form', + method => 'POST', + action => $get_portal_login_url->($config), + cn => [ + { + class => 'form-group', + cn => $items, + }, + { + tag => 'button', + type => 'submit', + class => 'btn btn-lg btn-primary btn-block', + text => "Sign in", + }, + ], + }); + + return $html; +}; + +PVE::APIServer::Formatter::register_login_formatter($portal_format, sub { + my ($path, $auth, $config) = @_; + + my $headers = HTTP::Headers->new(Location => $get_portal_login_url->($config)); + return HTTP::Response->new(301, "Moved", $headers); +}); + +PVE::APIServer::Formatter::register_formatter($portal_format, sub { + my ($res, $data, $param, $path, $auth, $config) = @_; + + # fixme: clumsy! + PVE::APIServer::Formatter::Standard::prepare_response_data($portal_format, $res); + $data = $res->{data}; + + my $html = ''; + my $doc = PVE::APIServer::Formatter::Bootstrap->new($res, $path, $auth, $config); + + if (!HTTP::Status::is_success($res->{status})) { + $html .= $doc->alert(text => "Error $res->{status}: $res->{message}"); + } + + my $lnk; + + if (my $info = $res->{info}) { + $html .= $doc->el(tag => 'h3', text => 'Description'); + $html .= $doc->el(tag => 'p', text => $info->{description}); + + $lnk = PVE::JSONSchema::method_get_child_link($info); + } + + if ($lnk && $data && $data->{data} && HTTP::Status::is_success($res->{status})) { + + my $href = $lnk->{href}; + if ($href =~ m/^\{(\S+)\}$/) { + + my $items = []; + + my $prop = $1; + $path =~ s/\/+$//; # remove trailing slash + + foreach my $elem (sort {$a->{$prop} cmp $b->{$prop}} @{$data->{data}}) { + next if !ref($elem); + + if (defined(my $value = $elem->{$prop})) { + my $tv = to_json($elem, {pretty => 1, allow_nonref => 1, canonical => 1}); + + push @$items, { + tag => 'a', + class => 'list-group-item', + href => "$path/".encode_entities($value), + cn => [ + { + tag => 'h4', + class => 'list-group-item-heading', + text => $value, + }, + { + tag => 'pre', + class => 'list-group-item', + text => $tv, + }, + ], + }; + } + } + + $html .= $doc->el(class => 'list-group', cn => $items); + + } else { + + my $json = to_json($data, {allow_nonref => 1, pretty => 1, canonical => 1}); + $html .= $doc->el(tag => 'pre', text => $json); + } + + } else { + + my $json = to_json($data, {allow_nonref => 1, pretty => 1, canonical => 1}); + $html .= $doc->el(tag => 'pre', text => $json); + } + + $html = $doc->el(class => 'container', html => $html); + + my $raw = render_page($doc, $html, $config); + return ($raw, $portal_ct); +}); + +PVE::APIServer::Formatter::register_page_formatter( + 'format' => $portal_format, + method => 'GET', + path => "/access/ticket", + code => sub { + my ($res, $data, $param, $path, $auth, $config) = @_; + + my $doc = PVE::APIServer::Formatter::Bootstrap->new($res, $path, $auth, $config); + + my $html = $login_form->($config, $doc); + + my $raw = render_page($doc, $html, $config); + return ($raw, $portal_ct); + }); + +PVE::APIServer::Formatter::register_page_formatter( + 'format' => $portal_format, + method => 'POST', + path => "/access/ticket", + code => sub { + my ($res, $data, $param, $path, $auth, $config) = @_; + + if (HTTP::Status::is_success($res->{status})) { + my $cookie = PVE::APIServer::Formatter::create_auth_cookie( + $data->{ticket}, $config->{cookie_name}); + + my $headers = HTTP::Headers->new(Location => $get_portal_base_url->($config), + 'Set-Cookie' => $cookie); + return HTTP::Response->new(301, "Moved", $headers); + } + + # Note: HTTP server redirects to 'GET /access/ticket', so below + # output is not really visible. + + my $doc = PVE::APIServer::Formatter::Bootstrap->new($res, $path, $auth, $config); + + my $html = $login_form->($config, $doc); + + my $raw = render_page($doc, $html, $config); + return ($raw, $portal_ct); + }); + +1; diff --git a/src/PVE/APIServer/Formatter/Standard.pm b/src/PVE/APIServer/Formatter/Standard.pm new file mode 100644 index 0000000..c4def16 --- /dev/null +++ b/src/PVE/APIServer/Formatter/Standard.pm @@ -0,0 +1,141 @@ +package PVE::APIServer::Formatter::Standard; + +use strict; +use warnings; + +use PVE::APIServer::Formatter; +use HTTP::Status; +use JSON; +use HTML::Entities; +use PVE::JSONSchema; + +# register result formatters + +sub prepare_response_data { + my ($format, $res) = @_; + + my $success = 1; + my $new = { + data => $res->{data}, + }; + if (scalar(keys %{$res->{errors}})) { + $success = 0; + $new->{errors} = $res->{errors}; + } + + if ($format eq 'extjs' || $format eq 'htmljs') { + # HACK: extjs wants 'success' property instead of useful HTTP status codes + if (HTTP::Status::is_error($res->{status})) { + $success = 0; + $new->{message} = $res->{message} || status_message($res->{status}); + $new->{status} = $res->{status} || 200; + $res->{message} = undef; + $res->{status} = 200; + } + $new->{success} = $success; + } + + if ($success && $res->{total}) { + $new->{total} = $res->{total}; + } + + if ($success && $res->{changes}) { + $new->{changes} = $res->{changes}; + } + + $res->{data} = $new; +} + +PVE::APIServer::Formatter::register_formatter('json', sub { + my ($res, $data, $param, $path, $auth, $config) = @_; + + my $nocomp = 0; + + my $ct = 'application/json;charset=UTF-8'; + + prepare_response_data('json', $res); + + my $raw = to_json($res->{data}, {utf8 => 1, allow_nonref => 1}); + + return ($raw, $ct, $nocomp); +}); + + +PVE::APIServer::Formatter::register_formatter('extjs', sub { + my ($res, $data, $param, $path, $auth, $config) = @_; + + my $nocomp = 0; + + my $ct = 'application/json;charset=UTF-8'; + + prepare_response_data('extjs', $res); + + my $raw = to_json($res->{data}, {utf8 => 1, allow_nonref => 1}); + + return ($raw, $ct, $nocomp); +}); + +PVE::APIServer::Formatter::register_formatter('htmljs', sub { + my ($res, $data, $param, $path, $auth, $config) = @_; + + my $nocomp = 0; + + # we use this for extjs file upload forms + + my $ct = 'text/html;charset=UTF-8'; + + prepare_response_data('htmljs', $res); + + my $raw = encode_entities(to_json($res->{data}, {allow_nonref => 1})); + + return ($raw, $ct, $nocomp); +}); + + +PVE::APIServer::Formatter::register_formatter('spiceconfig', sub { + my ($res, $data, $param, $path, $auth, $config) = @_; + + my $nocomp = 0; + + my $ct = 'application/x-virt-viewer;charset=UTF-8'; + + prepare_response_data('spiceconfig', $res); + + $data = $res->{data}; + + my $raw; + + if ($data && ref($data) && ref($data->{data})) { + $raw = "[virt-viewer]\n"; + while (my ($key, $value) = each %{$data->{data}}) { + $raw .= "$key=$value\n" if defined($value); + } + } + + return ($raw, $ct, $nocomp); +}); + +PVE::APIServer::Formatter::register_formatter('png', sub { + my ($res, $data, $param, $path, $auth, $config) = @_; + + my $nocomp = 1; + + my $ct = 'image/png'; + + prepare_response_data('png', $res); + + $data = $res->{data}; + + # fixme: better to revove that whole png thing ? + + my $filename; + my $raw = ''; + + if ($data && ref($data) && ref($data->{data}) && + $data->{data}->{filename} && defined($data->{data}->{image})) { + $filename = $data->{data}->{filename}; + $raw = $data->{data}->{image}; + } + + return ($raw, $ct, $nocomp); +}); diff --git a/src/PVE/APIServer/Utils.pm b/src/PVE/APIServer/Utils.pm new file mode 100644 index 0000000..5728d97 --- /dev/null +++ b/src/PVE/APIServer/Utils.pm @@ -0,0 +1,90 @@ +package PVE::APIServer::Utils; + +use strict; +use warnings; + +use Net::IP; + +# all settings are used for pveproxy and pmgproxy +# the ALLOW/DENY/POLICY is also used by spiceproxy +sub read_proxy_config { + my ($proxy_name) = @_; + + my $conffile = "/etc/default/$proxy_name"; + + # Note: evaluate with bash + my $shcmd = ". $conffile;\n"; + $shcmd .= 'echo \"LISTEN_IP:\$LISTEN_IP\";'; + $shcmd .= 'echo \"ALLOW_FROM:\$ALLOW_FROM\";'; + $shcmd .= 'echo \"DENY_FROM:\$DENY_FROM\";'; + $shcmd .= 'echo \"POLICY:\$POLICY\";'; + $shcmd .= 'echo \"CIPHERS:\$CIPHERS\";'; + $shcmd .= 'echo \"CIPHERSUITES:\$CIPHERSUITES\";'; + $shcmd .= 'echo \"DHPARAMS:\$DHPARAMS\";'; + $shcmd .= 'echo \"TLS_KEY_FILE:\$TLS_KEY_FILE\";'; + $shcmd .= 'echo \"HONOR_CIPHER_ORDER:\$HONOR_CIPHER_ORDER\";'; + $shcmd .= 'echo \"COMPRESSION:\$COMPRESSION\";'; + $shcmd .= 'echo \"DISABLE_TLS_1_2:\$DISABLE_TLS_1_2\";'; + $shcmd .= 'echo \"DISABLE_TLS_1_3:\$DISABLE_TLS_1_3\";'; + + my $data = -f $conffile ? `bash -c "$shcmd"` : ''; + + my $res = {}; + + my $boolean_options = [ + 'HONOR_CIPHER_ORDER', + 'COMPRESSION', + 'DISABLE_TLS_1_2', + 'DISABLE_TLS_1_3', + ]; + + while ($data =~ s/^(.*)\n//) { + my ($key, $value) = split(/:/, $1, 2); + next if !defined($value) || $value eq ''; + if ($key eq 'ALLOW_FROM' || $key eq 'DENY_FROM') { + my $ips = []; + foreach my $ip (split(/,/, $value)) { + if ($ip eq 'all') { + push @$ips, Net::IP->new('0/0') || die Net::IP::Error() . "\n"; + push @$ips, Net::IP->new('::/0') || die Net::IP::Error() . "\n"; + next; + } + push @$ips, Net::IP->new(normalize_v4_in_v6($ip)) || die Net::IP::Error() . "\n"; + } + $res->{$key} = $ips; + } elsif ($key eq 'LISTEN_IP') { + $res->{$key} = $value; + } elsif ($key eq 'POLICY') { + die "unknown policy '$value'\n" if $value !~ m/^(allow|deny)$/; + $res->{$key} = $value; + } elsif ($key eq 'CIPHERS') { + $res->{$key} = $value; + } elsif ($key eq 'CIPHERSUITES') { + $res->{$key} = $value; + } elsif ($key eq 'DHPARAMS') { + $res->{$key} = $value; + } elsif ($key eq 'TLS_KEY_FILE') { + $res->{$key} = $value; + } elsif (grep { $key eq $_ } @$boolean_options) { + die "unknown value '$value' - use 0 or 1\n" if $value !~ m/^(0|1)$/; + $res->{$key} = $value; + } else { + # silently skip everythin else? + } + } + + return $res; +} + +sub normalize_v4_in_v6 { + my ($ip_text) = @_; + + my $ip = Net::IP->new($ip_text) || die Net::IP::Error() . "\n"; + my $v4_mapped_v6_prefix = Net::IP->new('::ffff:0:0/96'); + if ($v4_mapped_v6_prefix->overlaps($ip)) { + return Net::IP::ip_get_embedded_ipv4($ip_text); + } + return $ip_text; +} + +1; diff --git a/src/examples/console-demo.pl b/src/examples/console-demo.pl new file mode 100755 index 0000000..b47d2f3 --- /dev/null +++ b/src/examples/console-demo.pl @@ -0,0 +1,552 @@ +#!/usr/bin/perl + +# This demo requires some other packages: novnc-pve and +# pve-manager (for PVE::NoVncIndex) + + +# First, we need some helpers to create authentication Tickets + +package Ticket; + +use strict; +use warnings; +use Net::SSLeay; + +use PVE::Ticket; + +use Crypt::OpenSSL::RSA; + +my $min_ticket_lifetime = -60*5; # allow 5 minutes time drift +my $max_ticket_lifetime = 60*60*2; # 2 hours + +my $rsa = Crypt::OpenSSL::RSA->generate_key(2048); + +sub create_ticket { + my ($username) = @_; + + return PVE::Ticket::assemble_rsa_ticket($rsa, 'DEMO', $username); +} + +sub verify_ticket { + my ($ticket, $noerr) = @_; + + return PVE::Ticket::verify_rsa_ticket( + $rsa, 'DEMO', $ticket, undef, + $min_ticket_lifetime, $max_ticket_lifetime, $noerr); +} + +# VNC tickets +# - they do not contain the username in plain text +# - they are restricted to a specific resource path (example: '/vms/100') +sub assemble_vnc_ticket { + my ($username, $path) = @_; + + my $secret_data = "$username:$path"; + + return PVE::Ticket::assemble_rsa_ticket( + $rsa, 'DEMOVNC', undef, $secret_data); +} + +sub verify_vnc_ticket { + my ($ticket, $username, $path, $noerr) = @_; + + my $secret_data = "$username:$path"; + + return PVE::Ticket::verify_rsa_ticket( + $rsa, 'DEMOVNC', $ticket, $secret_data, -20, 40, $noerr); +} + +# We stack several PVE::RESTHandler classes to create +# the API for the novnc-pve console. + +package NodeInfoAPI; + +use strict; +use warnings; + +use PVE::RESTHandler; +use PVE::JSONSchema qw(get_standard_option); +use PVE::RESTEnvironment; +use PVE::SafeSyslog; + +use base qw(PVE::RESTHandler); + +__PACKAGE__->register_method ({ + name => 'index', + path => '', + method => 'GET', + permissions => { user => 'all' }, + description => "Node index.", + parameters => { + additionalProperties => 0, + properties => { + node => get_standard_option('pve-node'), + }, + }, + returns => { + type => 'array', + items => { + type => "object", + properties => {}, + }, + links => [ { rel => 'child', href => "{name}" } ], + }, + code => sub { + my ($param) = @_; + + my $result = [ + { name => 'vncshell' }, + ]; + + return $result; + }}); + +__PACKAGE__->register_method ({ + name => 'vncshell', + path => 'vncshell', + method => 'POST', + description => "Creates a VNC Shell proxy.", + parameters => { + additionalProperties => 0, + properties => { + node => get_standard_option('pve-node'), + websocket => { + optional => 1, + type => 'boolean', + description => "use websocket instead of standard vnc.", + default => 1, + }, + }, + }, + returns => { + additionalProperties => 0, + properties => { + user => { type => 'string' }, + ticket => { type => 'string' }, + port => { type => 'integer' }, + upid => { type => 'string' }, + }, + }, + code => sub { + my ($param) = @_; + + my $node = $param->{node}; + + # we only implement the websocket based VNC here + my $websocket = $param->{websocket} // 1; + die "standard VNC not implemented" if !$websocket; + + my $authpath = "/nodes/$node"; + + my $restenv = PVE::RESTEnvironment->get(); + my $user = $restenv->get_user(); + + my $ticket = Ticket::assemble_vnc_ticket($user, $authpath); + + my $family = PVE::Tools::get_host_address_family($node); + my $port = PVE::Tools::next_vnc_port($family); + + my $cmd = ['/usr/bin/vncterm', '-rfbport', $port, + '-timeout', 10, '-notls', '-listen', 'localhost', + '-c', '/usr/bin/top']; + + my $realcmd = sub { + my $upid = shift; + + syslog ('info', "starting vnc proxy $upid\n"); + + my $cmdstr = join (' ', @$cmd); + syslog ('info', "launch command: $cmdstr"); + + eval { + foreach my $k (keys %ENV) { + next if $k eq 'PATH' || $k eq 'TERM' || $k eq 'USER' || $k eq 'HOME'; + delete $ENV{$k}; + } + $ENV{PWD} = '/'; + + $ENV{PVE_VNC_TICKET} = $ticket; # pass ticket to vncterm + + PVE::Tools::run_command($cmd, errmsg => "vncterm failed"); + }; + if (my $err = $@) { + syslog('err', $err); + } + + return; + }; + + my $upid = $restenv->fork_worker('vncshell', "", $user, $realcmd); + + PVE::Tools::wait_for_vnc_port($port); + + return { + user => $user, + ticket => $ticket, + port => $port, + upid => $upid, + }; + }}); + +__PACKAGE__->register_method({ + name => 'vncwebsocket', + path => 'vncwebsocket', + method => 'GET', + description => "Opens a weksocket for VNC traffic.", + parameters => { + additionalProperties => 0, + properties => { + node => get_standard_option('pve-node'), + vncticket => { + description => "Ticket from previous call to vncproxy.", + type => 'string', + maxLength => 512, + }, + port => { + description => "Port number returned by previous vncproxy call.", + type => 'integer', + minimum => 5900, + maximum => 5999, + }, + }, + }, + returns => { + type => "object", + properties => { + port => { type => 'string' }, + }, + }, + code => sub { + my ($param) = @_; + + my $authpath = "/nodes/$param->{node}"; + + my $restenv = PVE::RESTEnvironment->get(); + my $user = $restenv->get_user(); + + Ticket::verify_vnc_ticket($param->{vncticket}, $user, $authpath); + + my $port = $param->{port}; + + return { port => $port }; + }}); + + +package NodeAPI; + +use strict; +use warnings; + +use PVE::RESTHandler; +use PVE::JSONSchema qw(get_standard_option); + +use base qw(PVE::RESTHandler); + +__PACKAGE__->register_method ({ + subclass => "NodeInfoAPI", + path => '{node}', +}); + +__PACKAGE__->register_method ({ + name => 'index', + path => '', + method => 'GET', + permissions => { user => 'all' }, + description => "Cluster node index.", + parameters => { + additionalProperties => 0, + properties => {}, + }, + returns => { + type => 'array', + items => { + type => "object", + properties => {}, + }, + links => [ { rel => 'child', href => "{node}" } ], + }, + code => sub { + my ($param) = @_; + + my $res = [ + { node => 'elsa' }, + ]; + + return $res; + }}); + + +package YourAPI; + +use strict; +use warnings; + +use PVE::RESTHandler; +use PVE::JSONSchema; + +use base qw(PVE::RESTHandler); + +__PACKAGE__->register_method ({ + subclass => "NodeAPI", + path => 'nodes', +}); + +__PACKAGE__->register_method ({ + name => 'index', + path => '', + method => 'GET', + permissions => { user => 'all' }, + description => "Directory index.", + parameters => { + additionalProperties => 0, + properties => {}, + }, + returns => { + type => 'array', + items => { + type => "object", + properties => { + subdir => { type => 'string' }, + }, + }, + links => [ { rel => 'child', href => "{subdir}" } ], + }, + code => sub { + my ($resp, $param) = @_; + + my $res = [ { subdir => 'nodes' } ]; + + return $res; + }}); + + +# This is the REST/HTTPS Server +package DemoServer; + +use strict; +use warnings; +use HTTP::Status qw(:constants); +use URI::Escape; + +use PVE::APIServer::AnyEvent; +use PVE::Exception qw(raise_param_exc); +use PVE::RESTEnvironment; + +use base('PVE::APIServer::AnyEvent'); + +sub new { + my ($this, %args) = @_; + + my $class = ref($this) || $this; + + my $self = $class->SUPER::new(%args); + + PVE::RESTEnvironment->init('pub'); + + return $self; +} + +sub auth_handler { + my ($self, $method, $rel_uri, $ticket, $token, $peer_host) = @_; + + my $restenv = PVE::RESTEnvironment::get(); + $restenv->set_user(undef); + + # explicitly allow some calls without authentication + if ($rel_uri eq '/access/ticket' && + ($method eq 'POST' || $method eq 'GET')) { + return; # allow call to create ticket + } + + my $userid = Ticket::verify_ticket($ticket); + $restenv->set_user($userid); + + return { + ticket => $ticket, + userid => $userid, + }; +} + +sub rest_handler { + my ($self, $clientip, $method, $rel_uri, $auth, $params) = @_; + + my $resp = { + status => HTTP_NOT_IMPLEMENTED, + message => "Method '$method $rel_uri' not implemented", + }; + + if ($rel_uri eq '/access/ticket') { + if ($method eq 'POST') { + if ($params->{username} && $params->{username} eq 'demo' && + $params->{password} && $params->{password} eq 'demo') { + return { + status => HTTP_OK, + data => { + ticket => Ticket::create_ticket($params->{username}), + }, + }; + } + return $resp; + } elsif ($method eq 'GET') { + # this is allowed to display the login form + return { status => HTTP_OK, data => {} }; + } else { + return $resp; + } + } + + my ($handler, $info); + + eval { + my $uri_param = {}; + ($handler, $info) = YourAPI->find_handler($method, $rel_uri, $uri_param); + return if !$handler || !$info; + + foreach my $p (keys %{$params}) { + if (defined($uri_param->{$p})) { + raise_param_exc({$p => "duplicate parameter (already defined in URI)"}); + } + $uri_param->{$p} = $params->{$p}; + } + + $resp = { + data => $handler->handle($info, $uri_param), + info => $info, # useful to format output + status => HTTP_OK, + }; + }; + if (my $err = $@) { + $resp = { info => $info }; + if (ref($err) eq "PVE::Exception") { + $resp->{status} = $err->{code} || HTTP_INTERNAL_SERVER_ERROR; + $resp->{errors} = $err->{errors} if $err->{errors}; + $resp->{message} = $err->{msg}; + } else { + $resp->{status} = HTTP_INTERNAL_SERVER_ERROR; + $resp->{message} = $err; + } + } + + return $resp; +} + + +# The main package creates the socket and runs the server +package main; + +use strict; +use warnings; + +use Socket qw(IPPROTO_TCP TCP_NODELAY SOMAXCONN); +use IO::Socket::IP; +use HTTP::Headers; +use HTTP::Response; +use Data::Dumper; + +use PVE::Tools qw(run_command); +use PVE::INotify; +use PVE::APIServer::Formatter::Standard; +use PVE::APIServer::Formatter::HTML; +use PVE::NoVncIndex; + +my $nodename = PVE::INotify::nodename(); +my $port = 9999; + +my $cert_file = "simple-demo.pem"; + +if (! -f $cert_file) { + print "generating demo server certificate\n"; + my $cmd = ['openssl', 'req', '-batch', '-x509', '-newkey', 'rsa:4096', + '-nodes', '-keyout', $cert_file, '-out', $cert_file, + '-subj', "/CN=$nodename/", + '-days', '3650']; + run_command($cmd); +} + +my $socket = IO::Socket::IP->new( + LocalAddr => $nodename, + LocalPort => $port, + Listen => SOMAXCONN, + Proto => 'tcp', + GetAddrInfoFlags => 0, + ReuseAddr => 1) || + die "unable to create socket - $@\n"; + +# we often observe delays when using Nagle algorithm, +# so we disable that to maximize performance +setsockopt($socket, IPPROTO_TCP, TCP_NODELAY, 1); + +my $accept_lock_fn = "simple-demo.lck"; +my $lockfh = IO::File->new(">>${accept_lock_fn}") || + die "unable to open lock file '${accept_lock_fn}' - $!\n"; + +my $dirs = {}; +PVE::APIServer::AnyEvent::add_dirs( + $dirs, '/novnc/' => '/usr/share/novnc-pve/'); + +my $server = DemoServer->new( + debug => 1, + socket => $socket, + lockfile => $accept_lock_fn, + lockfh => $lockfh, + title => 'Simple Demo API', + cookie_name => 'DEMO', + logfh => \*STDOUT, + tls_ctx => { verify => 0, cert_file => $cert_file }, + dirs => $dirs, + pages => { + '/' => sub { get_index($nodename, @_) }, + }, +); + +# NOTE: Requests to non-API pages are not authenticated +# so you must be very careful here + +my $root_page = <<__EOD__; + + + + + + + Simple Demo Server + + +

Simple Demo Server ($nodename)

+ +

You can browse the API here. Please sign + in with usrename demo and passwort demo.

+ +

Server console is here: Console + + + +__EOD__ + +sub get_index { + my ($nodename, $server, $r, $args) = @_; + + my $token = ''; + + my ($ticket, $userid); + if (my $cookie = $r->header('Cookie')) { + #$ticket = PVE::APIServer::Formatter::extract_auth_cookie($cookie, $server->{cookie_name}); +# $userid = Ticket::verify_ticket($ticket, 1); + } + + my $page = $root_page; + + if (defined($args->{console}) && $args->{novnc}) { + $page = PVE::NoVncIndex::get_index('en', $userid, $token, + $args->{console}, $nodename); + } + + my $headers = HTTP::Headers->new(Content_Type => "text/html; charset=utf-8"); + my $resp = HTTP::Response->new(200, "OK", $headers, $page); + + return $resp; +} + +print "demo server listens at: https://$nodename:$port/\n"; + +$server->run(); diff --git a/src/examples/simple-demo.pl b/src/examples/simple-demo.pl new file mode 100755 index 0000000..886c636 --- /dev/null +++ b/src/examples/simple-demo.pl @@ -0,0 +1,195 @@ +#!/usr/bin/perl + +package DemoServer; + +use strict; +use warnings; +use HTTP::Status qw(:constants); +use URI::Escape; + +use PVE::APIServer::AnyEvent; +use PVE::Exception qw(raise_param_exc); + +use base('PVE::APIServer::AnyEvent'); + +use Digest::MD5; + +my $secret = Digest::MD5::md5_base64($$ . time()); + +sub create_ticket { + my ($username) = @_; + + my $salt = sprintf("%08x", time()); + my $data = "$username:$salt"; + my $sig = Digest::MD5::md5_base64("$data:$secret"); + return "$username:$salt:$sig"; +} + +sub verify_ticket { + my ($ticket) = @_; + + die "no ticket" if !defined($ticket); + my ($userid, $salt, $rest) = split(/:/, $ticket, 3); + + die "invalid ticket" if !defined($salt) || !defined($rest); + + die "invalid unsername" if $userid ne 'demo'; + + my $sig = Digest::MD5::md5_base64("$userid:$salt:$secret"); + + die "invalid ticket" if $rest ne $sig; + + return $userid; +} + +sub auth_handler { + my ($self, $method, $rel_uri, $ticket, $token, $peer_host) = @_; + + # explicitly allow some calls without authentication + if ($rel_uri eq '/access/ticket' && + ($method eq 'POST' || $method eq 'GET')) { + return; # allow call to create ticket + } + + my $userid = verify_ticket($ticket); + + return { + ticket => $ticket, + userid => $userid, + }; +} + +sub rest_handler { + my ($self, $clientip, $method, $rel_uri, $auth, $params) = @_; + + my $resp = { + status => HTTP_NOT_IMPLEMENTED, + message => "Method '$method $rel_uri' not implemented", + }; + if ($rel_uri eq '/access/ticket') { + if ($method eq 'POST') { + if ($params->{username} && $params->{username} eq 'demo' && + $params->{password} && $params->{password} eq 'demo') { + return { + status => HTTP_OK, + data => { + ticket => create_ticket($params->{username}), + }, + }; + } + return $resp; + } elsif ($method eq 'GET') { + # this is allowed to display the login form + return { status => HTTP_OK, data => {} }; + } else { + return $resp; + } + } + + $resp = { + data => { + method => $method, + clientip => $clientip, + rel_uri => $rel_uri, + auth => $auth, + params => $params, + }, + info => { description => "You called API method '$method $rel_uri'" }, + status => HTTP_OK, + }; + + return $resp; +} + + +package main; + +use strict; +use warnings; + +use Socket qw(IPPROTO_TCP TCP_NODELAY SOMAXCONN); +use IO::Socket::IP; +use HTTP::Headers; +use HTTP::Response; + +use PVE::Tools qw(run_command); +use PVE::INotify; +use PVE::APIServer::Formatter::Standard; +use PVE::APIServer::Formatter::HTML; + +my $nodename = PVE::INotify::nodename(); +my $port = 9999; + +my $cert_file = "simple-demo.pem"; + +if (! -f $cert_file) { + print "generating demo server certificate\n"; + my $cmd = ['openssl', 'req', '-batch', '-x509', '-newkey', 'rsa:4096', + '-nodes', '-keyout', $cert_file, '-out', $cert_file, + '-subj', "/CN=$nodename/", + '-days', '3650']; + run_command($cmd); +} + +my $socket = IO::Socket::IP->new( + LocalAddr => $nodename, + LocalPort => $port, + Listen => SOMAXCONN, + Proto => 'tcp', + GetAddrInfoFlags => 0, + ReuseAddr => 1) || + die "unable to create socket - $@\n"; + +# we often observe delays when using Nagle algorithm, +# so we disable that to maximize performance +setsockopt($socket, IPPROTO_TCP, TCP_NODELAY, 1); + +my $accept_lock_fn = "simple-demo.lck"; +my $lockfh = IO::File->new(">>${accept_lock_fn}") || + die "unable to open lock file '${accept_lock_fn}' - $!\n"; + +my $server = DemoServer->new( + socket => $socket, + lockfile => $accept_lock_fn, + lockfh => $lockfh, + title => 'Simple Demo API', + logfh => \*STDOUT, + tls_ctx => { verify => 0, cert_file => $cert_file }, + pages => { + '/' => sub { get_index($nodename, @_) }, + }, +); + +# NOTE: Requests to non-API pages are not authenticated +# so you must be very careful here + +my $root_page = <<__EOD__; + + + + + + + Simple Demo Server + + +

Simple Demo Server ($nodename)

+ + You can browse the API here. Please sign + in with usrename demo and passwort demo. + + + +__EOD__ + +sub get_index { + my ($nodename, $server, $r, $args) = @_; + + my $headers = HTTP::Headers->new(Content_Type => "text/html; charset=utf-8"); + my $resp = HTTP::Response->new(200, "OK", $headers, $root_page); + +} + +print "demo server listens at: https://$nodename:$port/\n"; + +$server->run();