├── .gitignore ├── Makefile ├── debian ├── changelog ├── control ├── copyright ├── docs ├── rules ├── source │ └── format └── triggers └── src ├── Makefile ├── PVE └── APIServer │ ├── AnyEvent.pm │ ├── Formatter.pm │ ├── Formatter │ ├── Bootstrap.pm │ ├── HTML.pm │ └── Standard.pm │ └── Utils.pm └── examples ├── console-demo.pl └── simple-demo.pl /.gitignore: -------------------------------------------------------------------------------- 1 | build/ 2 | *.deb 3 | *.buildinfo 4 | *.changes 5 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | include /usr/share/dpkg/pkg-info.mk 2 | 3 | PACKAGE=libpve-http-server-perl 4 | 5 | GITVERSION:=$(shell git rev-parse HEAD) 6 | BUILDDIR ?= $(PACKAGE)-$(DEB_VERSION) 7 | 8 | DSC=$(PACKAGE)_$(DEB_VERSION).dsc 9 | DEB=$(PACKAGE)_$(DEB_VERSION)_all.deb 10 | 11 | all: 12 | 13 | $(BUILDDIR): src debian 14 | rm -rf $@ $@.tmp 15 | cp -a src $@.tmp 16 | cp -a debian $@.tmp/ 17 | echo "git clone git://git.proxmox.com/git/pve-http-server\\ngit checkout $(GITVERSION)" > $@.tmp/debian/SOURCE 18 | mv $@.tmp $@ 19 | 20 | .PHONY: deb 21 | deb: $(DEB) 22 | $(DEB): $(BUILDDIR) 23 | cd $(BUILDDIR); dpkg-buildpackage -b -us -uc 24 | lintian $(DEB) 25 | 26 | .PHONY: dsc 27 | dsc: $(DSC) 28 | $(DSC): $(BUILDDIR) 29 | cd $(BUILDDIR); dpkg-buildpackage -S -us -uc 30 | lintian $(DSC) 31 | 32 | sbuild: $(DSC) 33 | sbuild $(DSC) 34 | 35 | .PHONY: upload 36 | upload: UPLOAD_DIST ?= $(DEB_DISTRIBUTION) 37 | upload: $(DEB) 38 | tar cf - $(DEB) | ssh -X repoman@repo.proxmox.com -- upload --product pve,pmg --dist $(UPLOAD_DIST) 39 | 40 | .PHONY: clean distclean 41 | distclean: clean 42 | $(MAKE) -C src $@ 43 | 44 | clean: 45 | $(MAKE) -C src $@ 46 | rm -rf $(PACKAGE)-*/ *.deb *.dsc *.tar.* *.changes *.build *.buildinfo examples/simple-demo.lck 47 | 48 | .PHONY: dinstall 49 | dinstall: $(DEB) 50 | dpkg -i $(DEB) 51 | -------------------------------------------------------------------------------- /debian/changelog: -------------------------------------------------------------------------------- 1 | libpve-http-server-perl (5.2.2) bookworm; urgency=medium 2 | 3 | * handle issues with clients where they actively disconnect while we also 4 | actively try to close the connection, so that both happens in parallel. 5 | This fixes a regression with the last update that mostly affected setups 6 | with a reverse proxy like HAProxy in front of the Provmox VE API daemon, 7 | where the race to close the connection was amplified due to the almost 8 | non-existent latency between those two components and seemingly also by 9 | how aggresive HAProxy closes connections. 10 | 11 | -- Proxmox Support Team Tue, 08 Apr 2025 16:44:09 +0200 12 | 13 | libpve-http-server-perl (5.2.1) bookworm; urgency=medium 14 | 15 | * fix #6230: increase allowed post size from 64 KiB to 512 KiB to 16 | accommodate large resource mappings or any other configuration where 17 | entries can grow very big. 18 | 19 | * fix unexpected EOF for client when closing TLS session. 20 | 21 | -- Proxmox Support Team Mon, 07 Apr 2025 21:44:15 +0200 22 | 23 | libpve-http-server-perl (5.2.0) bookworm; urgency=medium 24 | 25 | * fix external linking when cookie was acquired via HTML formatter due to 26 | overly strict SameSite attribute. 27 | 28 | * fix #5699: add support to define a HTTP header from which the real IP of a 29 | connection should be parsed from. This can be useful for setups with a 30 | reverse proxy in front of the API server. 31 | On top of that add support for optionally configuring an allow-list of IP 32 | networks that the real source IP must match one to allow the connection to 33 | be handled. 34 | 35 | * Always stringify error for responses to the 'extjs' formatter explicitly 36 | to avoid the call to to_json fail when trying to serialize a blessed 37 | object, like a PVE::APIClient::Exception. 38 | 39 | * fix #6503: return error messages from the API also for the json formatter. 40 | 41 | * fix #4816: do not try to disconnect twice if client sends no data, 42 | avoiding a false-positive error in the system log. 43 | 44 | * add error message directly into the HTTP body if it's empty, making it 45 | easier for HTTP clients that do not have access to the HTTP headers to 46 | extract said error message. 47 | 48 | * use the '500 Internal Server Error' HTTP error response were appropriate 49 | instead of '501 Not Implemented'. 50 | 51 | -- Proxmox Support Team Tue, 28 Jan 2025 16:08:54 +0100 52 | 53 | libpve-http-server-perl (5.1.2) bookworm; urgency=medium 54 | 55 | * fix #5391: proxy request: avoid "HTTP 599 Too many redirections" error 56 | that could occur due to long-running requests and bad timing during 57 | connection reuse. Disable connection reuse for all but GET requests that 58 | are proxied between different nodes, and allow one retry in this case. 59 | 60 | This can add a tiny bit of overhead if many PUT requests that are proxied 61 | to other nodes are issued with only a small delay between each other. 62 | However, such a high-frequency PUT request pattern is considered an edge 63 | case, and benchmarks show that the slowdown is about 2ms on average, which 64 | is often negligible compared to the actual time required to process the 65 | request. 66 | 67 | -- Proxmox Support Team Fri, 04 Oct 2024 14:02:39 +0200 68 | 69 | libpve-http-server-perl (5.1.1) bookworm; urgency=medium 70 | 71 | * handler: only allow downloads for annotated endpoints and remove support 72 | for directly returned download info 73 | 74 | -- Proxmox Support Team Mon, 23 Sep 2024 11:07:22 +0200 75 | 76 | libpve-http-server-perl (5.1.0) bookworm; urgency=medium 77 | 78 | * http: support the deflate compression content encoding 79 | 80 | -- Proxmox Support Team Mon, 22 Apr 2024 13:14:26 +0200 81 | 82 | libpve-http-server-perl (5.0.6) bookworm; urgency=medium 83 | 84 | * access control: avoid "uninitialized value" warning if using IP 85 | ranges 86 | 87 | -- Proxmox Support Team Tue, 26 Mar 2024 09:16:48 +0100 88 | 89 | libpve-http-server-perl (5.0.5) bookworm; urgency=medium 90 | 91 | * fix #4859: properly configure TLSv1.3 only mode 92 | 93 | -- Proxmox Support Team Fri, 03 Nov 2023 12:06:31 +0100 94 | 95 | libpve-http-server-perl (5.0.4) bookworm; urgency=medium 96 | 97 | * fix #4802: reduce CA lookups while proxying with OpenSSL as packaged in 98 | Debian 12 Bookworm. 99 | 100 | * avoid AnyEvent::AIO to fix CPU spinning if the pure-perl implementation 101 | libanyevent-aio-perl is installed, for example on development machines 102 | when trying to use the perl language server. 103 | 104 | -- Proxmox Support Team Mon, 03 Jul 2023 09:38:56 +0200 105 | 106 | libpve-http-server-perl (5.0.3) bookworm; urgency=medium 107 | 108 | * proxy request: handle missing content-type header 109 | 110 | -- Proxmox Support Team Fri, 09 Jun 2023 18:58:05 +0200 111 | 112 | libpve-http-server-perl (5.0.2) bookworm; urgency=medium 113 | 114 | * formatter/bootstrap: set SameSite attr of auth cookie to 'strict' 115 | 116 | * when proxying requests, preserve json formatting instead of converting to 117 | x-www-form-urlencoded 118 | 119 | * support actual arrays for array parameters, as a replacement for '-list' and 120 | '-alist' formats 121 | 122 | -- Proxmox Support Team Wed, 07 Jun 2023 13:21:19 +0200 123 | 124 | libpve-http-server-perl (5.0.1) bookworm; urgency=medium 125 | 126 | * fix regression in the html (bootstrap) based API debug explorer, which 127 | came in through a more strict pattern checking in a newer version of the 128 | used URL encoding library 129 | 130 | -- Proxmox Support Team Sat, 03 Jun 2023 15:15:47 +0200 131 | 132 | libpve-http-server-perl (5.0.0) bookworm; urgency=medium 133 | 134 | * switch over to native versioning 135 | 136 | * various small code and packaging clean ups 137 | 138 | * re-build for Debian 12 Bookworm based releases 139 | 140 | -- Proxmox Support Team Wed, 17 May 2023 07:26:11 +0200 141 | 142 | libpve-http-server-perl (4.2-3) bullseye; urgency=medium 143 | 144 | * file upload: don't always calculate MD5 for syslog message, rather log the 145 | file name instead, 146 | 147 | * explicitly disallow tmpfilename parameter in query URL 148 | 149 | -- Proxmox Support Team Fri, 14 Apr 2023 16:27:07 +0200 150 | 151 | libpve-http-server-perl (4.2-2) bullseye; urgency=medium 152 | 153 | * multipart upload: properly parse file parts without Content-Type 154 | 155 | -- Proxmox Support Team Tue, 11 Apr 2023 14:44:03 +0200 156 | 157 | libpve-http-server-perl (4.2-1) bullseye; urgency=medium 158 | 159 | * fix #4494: redirect incoming HTTP requests to HTTPS to avoid common 160 | pitfall when opening the Proxmox VE or Proxmox Mail Gateway web-interface 161 | for the first time 162 | 163 | -- Proxmox Support Team Thu, 16 Mar 2023 16:57:59 +0100 164 | 165 | libpve-http-server-perl (4.1-6) bullseye; urgency=medium 166 | 167 | * multipart upload: fix upload of files starting with newlines 168 | 169 | * multipart upload: don't fail on presebce of additional headers 170 | 171 | * multipart upload: loosen trailing-newline requirement from spec, as some 172 | more popular clients (e.g., postman) violate that rule. 173 | 174 | * fix #4344: http-server: fix regression that required the 'Content-Type' to 175 | be always present for multipart headers, while it wasn't used at all. 176 | 177 | -- Proxmox Support Team Mon, 06 Mar 2023 13:39:57 +0100 178 | 179 | libpve-http-server-perl (4.1-5) bullseye; urgency=medium 180 | 181 | * upload: re-allow having white-space in filenames 182 | 183 | -- Proxmox Support Team Mon, 07 Nov 2022 16:43:31 +0100 184 | 185 | libpve-http-server-perl (4.1-4) bullseye; urgency=medium 186 | 187 | * acknowledge content-disposition header 188 | 189 | * request: add missing early return to future proof error check 190 | 191 | -- Proxmox Support Team Thu, 29 Sep 2022 14:37:05 +0200 192 | 193 | libpve-http-server-perl (4.1-3) bullseye; urgency=medium 194 | 195 | * response: forbid linefeeds in response status message 196 | 197 | * proxy request: assert that API url starts with a slash 198 | 199 | * pass through streaming: only allow from privileged local pvedaemon as 200 | safety net 201 | 202 | * requests: assert that there is no @ in the URLs authority 203 | 204 | -- Proxmox Support Team Sat, 02 Jul 2022 09:16:21 +0200 205 | 206 | libpve-http-server-perl (4.1-2) bullseye; urgency=medium 207 | 208 | * tls: log failure to apply TLS 1.3 ciphers 209 | 210 | * html formatter: encode href attributes for API debug viewer 211 | 212 | -- Proxmox Support Team Tue, 17 May 2022 16:40:12 +0200 213 | 214 | libpve-http-server-perl (4.1-1) bullseye; urgency=medium 215 | 216 | * web socket: guard disconnect block check properly 217 | 218 | * avoid warning if request params does not exist 219 | 220 | * fix #3807: don't attempt response on closed handle 221 | 222 | * fix #3790: allow setting TLS 1.3 cipher suites 223 | 224 | * fix #3745: allow overriding TLS key location 225 | 226 | * fix #3789: allow disabling TLS v1.2/v1.3 227 | 228 | -- Proxmox Support Team Thu, 13 Jan 2022 13:32:43 +0100 229 | 230 | libpve-http-server-perl (4.0-4) bullseye; urgency=medium 231 | 232 | * webproxy: handle unflushed write buffer 233 | 234 | * fix #3724: disable TLS renegotiation 235 | 236 | * download-stream: allow the api call to set the content-encoding 237 | 238 | -- Proxmox Support Team Wed, 24 Nov 2021 18:14:53 +0100 239 | 240 | libpve-http-server-perl (4.0-3) bullseye; urgency=medium 241 | 242 | * anyevent: move unlink from http-server to endpoint 243 | 244 | -- Proxmox Support Team Mon, 04 Oct 2021 10:18:12 +0200 245 | 246 | libpve-http-server-perl (4.0-2) pve pmg; urgency=medium 247 | 248 | * AnyEvent/websocket_proxy: remove 'base64' handling 249 | 250 | * AnyEvent/websocket_proxy: drop handling of websocket subprotocols 251 | 252 | -- Proxmox Support Team Tue, 18 May 2021 10:19:00 +0200 253 | 254 | libpve-http-server-perl (4.0-1) bullseye; urgency=medium 255 | 256 | * rebuild for Debian 11 Bullseye based releases 257 | 258 | -- Proxmox Support Team Fri, 14 May 2021 16:37:34 +0200 259 | 260 | libpve-http-server-perl (3.2-2) pve pmg; urgency=medium 261 | 262 | * access control: correctly match v4-mapped-v6 addresses 263 | 264 | * access control: also match any IPv6 in 'ALL' 265 | 266 | -- Proxmox Support Team Fri, 07 May 2021 17:49:34 +0200 267 | 268 | libpve-http-server-perl (3.2-1) pve pmg; urgency=medium 269 | 270 | * allow 'download' to be passed from API handler 271 | 272 | * utils: add LISTEN_IP option in proxy configuration 273 | 274 | * support streaming data form a file handle to a client 275 | 276 | * allow stream download from path and over short-cutted pvedaemon-proxy 277 | 278 | -- Proxmox Support Team Fri, 23 Apr 2021 13:54:04 +0200 279 | 280 | libpve-http-server-perl (3.1-1) pve pmg; urgency=medium 281 | 282 | * accept connection phase: fix connection count leak 283 | 284 | * accept connection phase: immediately close socket on early error 285 | 286 | -- Proxmox Support Team Fri, 11 Dec 2020 08:39:36 +0100 287 | 288 | libpve-http-server-perl (3.0-6) pve pmg; urgency=medium 289 | 290 | * fix #2766: allow application/json as content-type for post/put requests 291 | 292 | * increase maximal accepted header count to 64. Modern browsers and proxy 293 | combinations can exceed the old limit of 30. The maximal accumulated total 294 | header size of 8 KiB stays untouched. 295 | 296 | -- Proxmox Support Team Thu, 02 Jul 2020 09:42:39 +0200 297 | 298 | libpve-http-server-perl (3.0-5) pve pmg; urgency=medium 299 | 300 | * partially fix #2618: use new unified spice port range helper from 301 | pve-common, increases maximum proxy port for spice to 61999 302 | 303 | * Websocket: implement ping/pong from RFC 304 | 305 | * Websocket: performance improvements 306 | 307 | -- Proxmox Support Team Mon, 09 Mar 2020 16:12:45 +0100 308 | 309 | libpve-http-server-perl (3.0-4) pve pmg; urgency=medium 310 | 311 | * allow ticket in 'Authorization' header as fallback 312 | 313 | * api-server: extract, set and handle API token header 314 | 315 | -- Proxmox Support Team Wed, 29 Jan 2020 09:32:04 +0100 316 | 317 | libpve-http-server-perl (3.0-3) pve pmg; urgency=medium 318 | 319 | * send_file_start: allow to pass a open fh and content-type 320 | 321 | -- Proxmox Support Team Fri, 11 Oct 2019 11:25:12 +0200 322 | 323 | libpve-http-server-perl (3.0-2) pve pmg; urgency=medium 324 | 325 | * decode_urlencoded: cope with undefined values 326 | 327 | * anyevent: rpcenv is optional and from our child instance 328 | 329 | -- Proxmox Support Team Thu, 11 Jul 2019 19:30:23 +0200 330 | 331 | libpve-http-server-perl (3.0-1) pve pmg; urgency=medium 332 | 333 | * rebuild for Debian Buster / PVE 6.0 334 | 335 | * update jQuery to 3.4.1 336 | 337 | * update Bootstrap to 3.4.1 338 | 339 | -- Proxmox Support Team Tue, 21 May 2019 21:35:00 +0200 340 | 341 | libpve-http-server-perl (2.0-13) unstable; urgency=medium 342 | 343 | * tls: make dh to openssl 1.1 compatible 344 | 345 | * store Host header in rpc environment 346 | 347 | * forward Host header in proxy_request 348 | 349 | -- Proxmox Support Team Wed, 03 Apr 2019 13:55:44 +0200 350 | 351 | libpve-http-server-perl (2.0-12) unstable; urgency=medium 352 | 353 | * Allow one to specify 'honor_cipher_order' and 'compression' parameters 354 | 355 | * move read_proxy_conf from PVE::API2Tools to new PVE::ApiServer::Utils module 356 | 357 | -- Proxmox Support Team Tue, 26 Feb 2019 07:07:31 +0100 358 | 359 | libpve-http-server-perl (2.0-11) unstable; urgency=medium 360 | 361 | * fix #1935: spice proxy: read empty line after 200 OK 362 | 363 | -- Proxmox Support Team Fri, 28 Sep 2018 10:41:22 +0200 364 | 365 | libpve-http-server-perl (2.0-10) unstable; urgency=medium 366 | 367 | * fix #1869: send correct http response in spice proxy 368 | 369 | * websocket: set $max_payload_size = 128*1024; (131072) 370 | 371 | -- Proxmox Support Team Fri, 17 Aug 2018 08:29:53 +0200 372 | 373 | libpve-http-server-perl (2.0-9) unstable; urgency=medium 374 | 375 | * Fix #1684 WebSocket proxy behind a buffered proxy 376 | 377 | -- Proxmox Support Team Mon, 28 May 2018 10:33:41 +0200 378 | 379 | libpve-http-server-perl (2.0-8) unstable; urgency=medium 380 | 381 | * auth_handler: handle exceptions correctly instead of always returning 401 382 | 383 | * add 'map' filetype to http-server 384 | 385 | * do not send websocket status code to port 386 | 387 | -- Proxmox Support Team Mon, 11 Dec 2017 15:35:34 +0100 388 | 389 | libpve-http-server-perl (2.0-7) unstable; urgency=medium 390 | 391 | * add content type application/x-compressed-tar 392 | 393 | * allow API calls to download file contents 394 | 395 | * build: reformat debian/control 396 | 397 | -- Proxmox Support Team Tue, 14 Nov 2017 08:05:17 +0100 398 | 399 | libpve-http-server-perl (2.0-6) unstable; urgency=medium 400 | 401 | * pass $format to rest_handler() 402 | 403 | -- Proxmox Support Team Thu, 10 Aug 2017 12:05:42 +0200 404 | 405 | libpve-http-server-perl (2.0-5) unstable; urgency=medium 406 | 407 | * add json/mp3/oga/svg MIME types for the new novnc 408 | 409 | -- Proxmox Support Team Fri, 02 Jun 2017 12:49:02 +0200 410 | 411 | libpve-http-server-perl (2.0-4) unstable; urgency=medium 412 | 413 | * assume all parameters are utf8 encoded 414 | 415 | -- Proxmox Support Team Tue, 02 May 2017 11:55:21 +0200 416 | 417 | libpve-http-server-perl (2.0-3) unstable; urgency=medium 418 | 419 | * avoid locale specific time stamps 420 | 421 | -- Proxmox Support Team Mon, 24 Apr 2017 07:43:29 +0200 422 | 423 | libpve-http-server-perl (2.0-2) unstable; urgency=medium 424 | 425 | * fix #1332: allow ECDHE with all supported curves 426 | 427 | -- Proxmox Support Team Mon, 03 Apr 2017 15:11:38 +0200 428 | 429 | libpve-http-server-perl (2.0-1) unstable; urgency=medium 430 | 431 | * bump version for debian stretch 432 | 433 | -- Proxmox Support Team Fri, 10 Mar 2017 08:50:55 +0100 434 | 435 | libpve-http-server-perl (1.0-4) unstable; urgency=medium 436 | 437 | * add debian triggers file 438 | 439 | -- Proxmox Support Team Sat, 21 Jan 2017 16:36:47 +0100 440 | 441 | libpve-http-server-perl (1.0-3) unstable; urgency=medium 442 | 443 | * console-demo.pl: add a more complex demo 444 | 445 | * call Net::SSLeay::ERR_clear_error after all handlers 446 | 447 | * avoid warnings when clients disconnects early 448 | 449 | -- Proxmox Support Team Sat, 21 Jan 2017 16:19:20 +0100 450 | 451 | libpve-http-server-perl (1.0-2) unstable; urgency=medium 452 | 453 | * simple-demo.pl: simple demo server for testing 454 | 455 | * extract_auth_cookie: always call uri_unescape($ticket) 456 | 457 | * use canonical flag for json format 458 | 459 | * remove base_handler_class from required arguments 460 | 461 | * remove all references to rpcenv 462 | 463 | * include jquery and bootstrap 464 | 465 | * new helper add_dirs 466 | 467 | * add new hook function to generate CSRF token 468 | 469 | * add generic formatter framework 470 | 471 | -- Proxmox Support Team Mon, 16 Jan 2017 18:39:21 +0100 472 | 473 | libpve-http-server-perl (1.0-1) unstable; urgency=medium 474 | 475 | * first try 476 | 477 | -- Proxmox Support Team Fri, 13 Jan 2017 12:47:07 +0100 478 | 479 | -------------------------------------------------------------------------------- /debian/control: -------------------------------------------------------------------------------- 1 | Source: libpve-http-server-perl 2 | Section: perl 3 | Priority: optional 4 | Maintainer: Proxmox Support Team 5 | Build-Depends: debhelper-compat (= 13), perl, 6 | Standards-Version: 4.6.2 7 | Homepage: https://www.proxmox.com 8 | 9 | Package: libpve-http-server-perl 10 | Architecture: all 11 | Depends: libanyevent-http-perl, 12 | libanyevent-perl (>= 7.140-3), 13 | libcrypt-ssleay-perl, 14 | libhtml-parser-perl, 15 | libhttp-date-perl, 16 | libhttp-message-perl, 17 | libio-socket-ssl-perl, 18 | libjs-bootstrap, 19 | libjs-jquery, 20 | libjson-perl, 21 | libnet-ip-perl, 22 | libpve-common-perl (>= 8.0.2), 23 | liburi-perl, 24 | ${misc:Depends}, 25 | ${perl:Depends}, 26 | Breaks: libpve-storage-perl (<< 8.2.5), 27 | pmg-api (<< 8.1.4), 28 | pve-manager (<< 8.2.7), 29 | Description: Proxmox Asynchrounous HTTP Server Implementation 30 | This package is used as base to implement the REST API in all perl based 31 | Proxmox projects. 32 | -------------------------------------------------------------------------------- /debian/copyright: -------------------------------------------------------------------------------- 1 | Copyright (C) 2010-2021 Proxmox Server Solutions GmbH 2 | 3 | This software is written by Proxmox Server Solutions GmbH 4 | 5 | This program is free software: you can redistribute it and/or modify 6 | it under the terms of the GNU Affero General Public License as published by 7 | the Free Software Foundation, either version 3 of the License, or 8 | (at your option) any later version. 9 | 10 | This program is distributed in the hope that it will be useful, 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | GNU Affero General Public License for more details. 14 | 15 | You should have received a copy of the GNU Affero General Public License 16 | along with this program. If not, see . 17 | -------------------------------------------------------------------------------- /debian/docs: -------------------------------------------------------------------------------- 1 | debian/SOURCE 2 | -------------------------------------------------------------------------------- /debian/rules: -------------------------------------------------------------------------------- 1 | #!/usr/bin/make -f 2 | # See debhelper(7) (uncomment to enable) 3 | # output every command that modifies files on the build system. 4 | #DH_VERBOSE = 1 5 | 6 | 7 | %: 8 | dh $@ 9 | 10 | -------------------------------------------------------------------------------- /debian/source/format: -------------------------------------------------------------------------------- 1 | 3.0 (native) 2 | -------------------------------------------------------------------------------- /debian/triggers: -------------------------------------------------------------------------------- 1 | activate-noawait pve-api-updates 2 | -------------------------------------------------------------------------------- /src/Makefile: -------------------------------------------------------------------------------- 1 | DESTDIR= 2 | PERL5DIR=${DESTDIR}/usr/share/perl5 3 | DOCDIR=${DESTDIR}/usr/share/doc/${PACKAGE} 4 | 5 | all: 6 | 7 | install: PVE 8 | install -d -m 755 ${PERL5DIR}/PVE/APIServer 9 | install -m 0644 PVE/APIServer/AnyEvent.pm ${PERL5DIR}/PVE/APIServer 10 | install -m 0644 PVE/APIServer/Formatter.pm ${PERL5DIR}/PVE/APIServer 11 | install -m 0644 PVE/APIServer/Utils.pm ${PERL5DIR}/PVE/APIServer 12 | install -d -m 755 ${PERL5DIR}/PVE/APIServer/Formatter 13 | install -m 0644 PVE/APIServer/Formatter/Standard.pm ${PERL5DIR}/PVE/APIServer/Formatter 14 | install -m 0644 PVE/APIServer/Formatter/Bootstrap.pm ${PERL5DIR}/PVE/APIServer/Formatter 15 | install -m 0644 PVE/APIServer/Formatter/HTML.pm ${PERL5DIR}/PVE/APIServer/Formatter 16 | 17 | .PHONY: clean distclean 18 | distclean: clean 19 | rm -f examples/simple-demo.pem 20 | 21 | clean: 22 | rm -rf examples/simple-demo.lck 23 | find . -name '*~' -exec rm {} ';' 24 | -------------------------------------------------------------------------------- /src/PVE/APIServer/AnyEvent.pm: -------------------------------------------------------------------------------- 1 | package PVE::APIServer::AnyEvent; 2 | 3 | # Note 1: interactions with Crypt::OpenSSL::RSA 4 | # 5 | # Some handlers (auth_handler) use Crypt::OpenSSL::RSA, which seems to 6 | # set the openssl error variable. We need to clear that here, else 7 | # AnyEvent::TLS aborts the connection. 8 | # Net::SSLeay::ERR_clear_error(); 9 | 10 | use strict; 11 | use warnings; 12 | 13 | use AnyEvent::HTTP; 14 | use AnyEvent::Handle; 15 | use AnyEvent::Socket; 16 | # use AnyEvent::Strict; # only use this for debugging 17 | use AnyEvent::TLS; 18 | use AnyEvent::Util qw(guard fh_nonblocking WSAEWOULDBLOCK WSAEINPROGRESS); 19 | 20 | use Compress::Zlib; 21 | use Digest::MD5; 22 | use Digest::SHA; 23 | use Encode; 24 | use Fcntl (); 25 | use Fcntl; 26 | use File::Find; 27 | use File::stat qw(); 28 | use IO::File; 29 | use MIME::Base64; 30 | use Net::SSLeay; 31 | use POSIX qw(strftime EINTR EAGAIN); 32 | use Socket qw(IPPROTO_TCP TCP_NODELAY SOMAXCONN); 33 | use Time::HiRes qw(usleep ualarm gettimeofday tv_interval); 34 | 35 | #use Data::Dumper; # FIXME: remove, just use: print to_json([$var], {pretty => 1}) ."\n"; 36 | use HTTP::Date; 37 | use HTTP::Headers; 38 | use HTTP::Request; 39 | use HTTP::Response; 40 | use HTTP::Status qw(:constants); 41 | use JSON; 42 | use Net::IP; 43 | use URI::Escape; 44 | use URI; 45 | 46 | use PVE::INotify; 47 | use PVE::SafeSyslog; 48 | use PVE::Tools qw(trim); 49 | 50 | use PVE::APIServer::Formatter; 51 | use PVE::APIServer::Utils; 52 | 53 | my $limit_max_headers = 64; 54 | my $limit_max_header_size = 8*1024; 55 | my $limit_max_post = 512*1024; 56 | 57 | my $known_methods = { 58 | GET => 1, 59 | POST => 1, 60 | PUT => 1, 61 | DELETE => 1, 62 | }; 63 | 64 | my $split_abs_uri = sub { 65 | my ($abs_uri, $base_uri) = @_; 66 | 67 | my ($format, $rel_uri) = $abs_uri =~ m/^\Q$base_uri\E\/+([a-z][a-z0-9]+)(\/.*)?$/; 68 | $rel_uri = '/' if !$rel_uri; 69 | 70 | return wantarray ? ($rel_uri, $format) : $rel_uri; 71 | }; 72 | 73 | sub dprint { 74 | my ($self, $message) = @_; 75 | 76 | return if !$self->{debug}; 77 | 78 | my ($pkg, $pkgfile, $line, $sub) = caller(1); 79 | $sub =~ s/^(?:.+::)+//; 80 | print "worker[$$]: $pkg +$line: $sub: $message\n"; 81 | } 82 | 83 | sub log_request { 84 | my ($self, $reqstate) = @_; 85 | 86 | my $loginfo = $reqstate->{log}; 87 | 88 | # like apache2 common log format 89 | # LogFormat "%h %l %u %t \"%r\" %>s %b \"%{Referer}i\" \"%{User-agent}i\"" 90 | 91 | return if $loginfo->{written}; # avoid duplicate logs 92 | $loginfo->{written} = 1; 93 | 94 | my $peerip = $reqstate->{peer_host} || '-'; 95 | my $realip = $loginfo->{real_ip} || $peerip; 96 | my $userid = $loginfo->{userid} || '-'; 97 | my $content_length = defined($loginfo->{content_length}) ? $loginfo->{content_length} : '-'; 98 | my $code = $loginfo->{code} || 500; 99 | my $requestline = $loginfo->{requestline} || '-'; 100 | my $timestr = strftime("%d/%m/%Y:%H:%M:%S %z", localtime()); 101 | 102 | my $msg = "$realip - $userid [$timestr] \"$requestline\" $code $content_length\n"; 103 | 104 | $self->write_log($msg); 105 | } 106 | 107 | sub log_aborted_request { 108 | my ($self, $reqstate, $error) = @_; 109 | 110 | my $r = $reqstate->{request}; 111 | return if !$r; # no active request 112 | 113 | if ($error) { 114 | syslog("err", "problem with client $reqstate->{peer_host}; $error"); 115 | } 116 | 117 | $self->log_request($reqstate); 118 | } 119 | 120 | sub cleanup_reqstate { 121 | my ($reqstate, $deletetmpfile) = @_; 122 | 123 | delete $reqstate->{log}; 124 | delete $reqstate->{request}; 125 | delete $reqstate->{proto}; 126 | delete $reqstate->{accept_gzip}; 127 | delete $reqstate->{accept_deflate}; 128 | delete $reqstate->{starttime}; 129 | 130 | if ($reqstate->{tmpfilename}) { 131 | unlink $reqstate->{tmpfilename} if $deletetmpfile; 132 | delete $reqstate->{tmpfilename}; 133 | } 134 | } 135 | 136 | sub client_do_disconnect { 137 | my ($self, $reqstate) = @_; 138 | 139 | # Avoid any re-entrant call. For example, the on_error callback can be called twice for the same 140 | # connection/handle if the timeout is reached before any data has been received. The on_error 141 | # callback might also get invoked as part of the stoptls() call during shutdown below, which is 142 | # another situation where the function would be re-entered without this check. 143 | return if $reqstate->{disconnected}; 144 | $reqstate->{disconnected} = 1; 145 | 146 | cleanup_reqstate($reqstate, 1); 147 | 148 | my $shutdown_hdl = sub { 149 | my $hdl = shift; 150 | 151 | # clear all handlers 152 | $hdl->on_drain(undef); 153 | $hdl->on_read(undef); 154 | $hdl->on_eof(undef); 155 | 156 | $self->dprint("CLOSE FH" . $hdl->{fh}->fileno()); 157 | 158 | $hdl->stoptls(); # can invoke callbacks and destroy the handle 159 | 160 | shutdown($hdl->{fh}, 1) if defined($hdl) && defined($hdl->{fh}); 161 | }; 162 | 163 | if (my $proxyhdl = delete $reqstate->{proxyhdl}) { 164 | &$shutdown_hdl($proxyhdl) 165 | if !$proxyhdl->{block_disconnect}; 166 | } 167 | 168 | my $hdl = delete $reqstate->{hdl}; 169 | 170 | if (!$hdl) { 171 | syslog('err', "detected empty handle"); 172 | return; 173 | } 174 | 175 | $self->dprint("close connection $hdl"); 176 | 177 | &$shutdown_hdl($hdl); 178 | 179 | warn "connection count <= 0!\n" if $self->{conn_count} <= 0; 180 | 181 | $self->{conn_count}--; 182 | 183 | $self->dprint("DISCONNECT CONN$self->{conn_count}"); 184 | } 185 | 186 | sub finish_response { 187 | my ($self, $reqstate) = @_; 188 | 189 | cleanup_reqstate($reqstate, 0); 190 | 191 | my $hdl = $reqstate->{hdl}; 192 | return if !$hdl; # already disconnected 193 | 194 | if (!$self->{end_loop} && $reqstate->{keep_alive} > 0) { 195 | # print "KEEPALIVE $reqstate->{keep_alive}\n" if $self->{debug}; 196 | $hdl->on_read(sub { 197 | eval { $self->push_request_header($reqstate); }; 198 | warn $@ if $@; 199 | }); 200 | } else { 201 | $hdl->on_drain (sub { 202 | eval { 203 | $self->client_do_disconnect($reqstate); 204 | }; 205 | warn $@ if $@; 206 | }); 207 | } 208 | } 209 | 210 | sub response_stream { 211 | my ($self, $reqstate, $stream_fh) = @_; 212 | 213 | # disable timeout, we don't know how big the data is 214 | $reqstate->{hdl}->timeout(0); 215 | 216 | my $buf_size = 4*1024*1024; 217 | 218 | my $on_read; 219 | $on_read = sub { 220 | my ($hdl) = @_; 221 | my $reqhdl = $reqstate->{hdl}; 222 | return if !$reqhdl; 223 | 224 | my $wbuf_len = length($reqhdl->{wbuf}); 225 | my $rbuf_len = length($hdl->{rbuf}); 226 | # TODO: Take into account $reqhdl->{wbuf_max} ? Right now 227 | # that's unbounded, so just assume $buf_size 228 | my $to_read = $buf_size - $wbuf_len; 229 | $to_read = $rbuf_len if $rbuf_len < $to_read; 230 | if ($to_read > 0) { 231 | my $data = substr($hdl->{rbuf}, 0, $to_read, ''); 232 | $reqhdl->push_write($data); 233 | $rbuf_len -= $to_read; 234 | } elsif ($hdl->{_eof}) { 235 | # workaround: AnyEvent gives us a fake EPIPE if we don't consume 236 | # any data when called at EOF, so unregister ourselves - data is 237 | # flushed by on_eof anyway 238 | # see: https://sources.debian.org/src/libanyevent-perl/7.170-2/lib/AnyEvent/Handle.pm/#L1329 239 | $hdl->on_read(); 240 | return; 241 | } 242 | 243 | # apply backpressure so we don't accept any more data into 244 | # buffer if the client isn't downloading fast enough 245 | # note: read_size can double upon read, and we also need to 246 | # account for one more read after start_read, so *4 247 | if ($rbuf_len + $hdl->{read_size}*4 > $buf_size) { 248 | # stop reading until write buffer is empty 249 | $hdl->on_read(); 250 | my $prev_on_drain = $reqhdl->{on_drain}; 251 | $reqhdl->on_drain(sub { 252 | my ($wrhdl) = @_; 253 | # on_drain called because write buffer is empty, continue reading 254 | $hdl->on_read($on_read); 255 | if ($prev_on_drain) { 256 | $wrhdl->on_drain($prev_on_drain); 257 | $prev_on_drain->($wrhdl); 258 | } 259 | }); 260 | } 261 | }; 262 | 263 | $reqstate->{proxyhdl} = AnyEvent::Handle->new( 264 | fh => $stream_fh, 265 | rbuf_max => $buf_size, 266 | timeout => 0, 267 | on_read => $on_read, 268 | on_eof => sub { 269 | my ($hdl) = @_; 270 | eval { 271 | if (my $reqhdl = $reqstate->{hdl}) { 272 | $self->log_aborted_request($reqstate); 273 | # write out any remaining data 274 | $reqhdl->push_write($hdl->{rbuf}) if length($hdl->{rbuf}) > 0; 275 | $hdl->{rbuf} = ""; 276 | $reqhdl->push_shutdown(); 277 | $self->finish_response($reqstate); 278 | } 279 | }; 280 | if (my $err = $@) { syslog('err', "$err"); } 281 | $on_read = undef; 282 | }, 283 | on_error => sub { 284 | my ($hdl, $fatal, $message) = @_; 285 | eval { 286 | $self->log_aborted_request($reqstate, $message); 287 | $self->client_do_disconnect($reqstate); 288 | }; 289 | if (my $err = $@) { syslog('err', "$err"); } 290 | $on_read = undef; 291 | }, 292 | ); 293 | } 294 | 295 | sub response { 296 | my ($self, $reqstate, $resp, $mtime, $nocomp, $delay, $stream_fh) = @_; 297 | 298 | #print "$$: send response: " . Dumper($resp); 299 | 300 | # activate timeout 301 | $reqstate->{hdl}->timeout_reset(); 302 | $reqstate->{hdl}->timeout($self->{timeout}); 303 | 304 | $nocomp = 1 if !$self->{compression}; 305 | $nocomp = 1 if !$reqstate->{accept_gzip} && !$reqstate->{accept_deflate}; 306 | 307 | my $code = $resp->code; 308 | my $msg = $resp->message || HTTP::Status::status_message($code); 309 | my $content = $resp->content; 310 | 311 | # multiline mode only checks \n for $, so explicitly check for any \n or \r afterwards 312 | ($msg) = $msg =~ m/^(.*)$/m; 313 | if ($msg =~ /[\r\n]/) { 314 | $code = 400; # bad request from user 315 | $msg = HTTP::Status::status_message($code); 316 | $content = ''; 317 | } 318 | 319 | if ($code =~ /^(1\d\d|[23]04)$/) { 320 | # make sure informational, no content and not modified response send no content 321 | $content = ""; 322 | } 323 | 324 | $reqstate->{keep_alive} = 0 if ($code >= 400) || $self->{end_loop}; 325 | 326 | $reqstate->{log}->{code} = $code; 327 | 328 | my $proto = $reqstate->{proto} ? $reqstate->{proto}->{str} : 'HTTP/1.0'; 329 | my $res = "$proto $code $msg\015\012"; 330 | 331 | my $ctime = time(); 332 | my $date = HTTP::Date::time2str($ctime); 333 | $resp->header('Date' => $date); 334 | if ($mtime) { 335 | $resp->header('Last-Modified' => HTTP::Date::time2str($mtime)); 336 | } else { 337 | $resp->header('Expires' => $date); 338 | $resp->header('Cache-Control' => "max-age=0"); 339 | $resp->header("Pragma", "no-cache"); 340 | } 341 | 342 | $resp->header('Server' => "pve-api-daemon/3.0"); 343 | 344 | my $content_length; 345 | if ($content && !$stream_fh) { 346 | 347 | $content_length = length($content); 348 | 349 | if (!$nocomp && ($content_length > 1024)) { 350 | if ($reqstate->{accept_gzip}) { 351 | my $comp = Compress::Zlib::memGzip($content); 352 | $resp->header('Content-Encoding', 'gzip'); 353 | $content = $comp; 354 | } elsif ($reqstate->{accept_deflate}) { 355 | my $comp = Compress::Zlib::compress($content); 356 | $resp->header('Content-Encoding', 'deflate'); 357 | $content = $comp; 358 | } 359 | } 360 | $content_length = length($content); 361 | $resp->header("Content-Length" => $content_length); 362 | $reqstate->{log}->{content_length} = $content_length; 363 | 364 | } else { 365 | $resp->remove_header("Content-Length"); 366 | } 367 | 368 | if ($reqstate->{keep_alive} > 0) { 369 | $resp->push_header('Connection' => 'Keep-Alive'); 370 | } else { 371 | $resp->header('Connection' => 'close'); 372 | } 373 | 374 | $res .= $resp->headers_as_string("\015\012"); 375 | #print "SEND(without content) $res\n" if $self->{debug}; 376 | 377 | $res .= "\015\012"; 378 | $res .= $content if $content && !$stream_fh; 379 | 380 | $self->log_request($reqstate, $reqstate->{request}); 381 | 382 | if ($stream_fh) { 383 | # write headers and preamble... 384 | $reqstate->{hdl}->push_write($res); 385 | # ...then stream data via an AnyEvent::Handle 386 | $self->response_stream($reqstate, $stream_fh); 387 | } elsif ($delay && $delay > 0) { 388 | my $w; $w = AnyEvent->timer(after => $delay, cb => sub { 389 | undef $w; # delete reference 390 | return if !$reqstate->{hdl}; # already disconnected 391 | $reqstate->{hdl}->push_write($res); 392 | $self->finish_response($reqstate); 393 | }); 394 | } else { 395 | $reqstate->{hdl}->push_write($res); 396 | $self->finish_response($reqstate); 397 | } 398 | } 399 | 400 | sub error { 401 | my ($self, $reqstate, $code, $msg, $hdr, $content) = @_; 402 | 403 | eval { 404 | $content //= $msg; # write error into body by default 405 | # lack of content type here means either 'application/octet-stream' or the client 406 | # can guess. This is fine since we don't know what content/msg actually contains. 407 | my $resp = HTTP::Response->new($code, $msg, $hdr, $content); 408 | $self->response($reqstate, $resp); 409 | }; 410 | warn $@ if $@; 411 | } 412 | 413 | my $file_extension_info = { 414 | css => { ct => 'text/css' }, 415 | html => { ct => 'text/html' }, 416 | js => { ct => 'application/javascript' }, 417 | json => { ct => 'application/json' }, 418 | map => { ct => 'application/json' }, 419 | png => { ct => 'image/png' , nocomp => 1 }, 420 | ico => { ct => 'image/x-icon', nocomp => 1}, 421 | gif => { ct => 'image/gif', nocomp => 1}, 422 | svg => { ct => 'image/svg+xml' }, 423 | jar => { ct => 'application/java-archive', nocomp => 1}, 424 | woff => { ct => 'application/font-woff', nocomp => 1}, 425 | woff2 => { ct => 'application/font-woff2', nocomp => 1}, 426 | ttf => { ct => 'application/font-snft', nocomp => 1}, 427 | pdf => { ct => 'application/pdf', nocomp => 1}, 428 | epub => { ct => 'application/epub+zip', nocomp => 1}, 429 | mp3 => { ct => 'audio/mpeg', nocomp => 1}, 430 | oga => { ct => 'audio/ogg', nocomp => 1}, 431 | tgz => { ct => 'application/x-compressed-tar', nocomp => 1}, 432 | }; 433 | 434 | sub send_file_start { 435 | my ($self, $reqstate, $download) = @_; 436 | 437 | eval { 438 | # print "SEND FILE $filename\n"; 439 | # Note: aio_load() this is not really async unless we use IO::AIO! 440 | eval { 441 | 442 | my $r = $reqstate->{request}; 443 | 444 | my $fh; 445 | my $nocomp; 446 | my $mime; 447 | 448 | die "invalid download information passed: '$download'\n" 449 | if ref($download) ne 'HASH'; 450 | 451 | $mime = $download->{'content-type'}; 452 | my $encoding = $download->{'content-encoding'}; 453 | my $disposition = $download->{'content-disposition'}; 454 | 455 | if ($download->{path} && $download->{stream} && 456 | $reqstate->{request}->header('PVEDisableProxy')) 457 | { 458 | # avoid double stream from a file, let the proxy handle it 459 | die "internal error: file proxy streaming only available for pvedaemon\n" 460 | if !$self->{trusted_env}; 461 | my $header = HTTP::Headers->new( 462 | pvestreamfile => $download->{path}, 463 | Content_Type => $mime, 464 | ); 465 | $header->header('Content-Encoding' => $encoding) if defined($encoding); 466 | $header->header('Content-Disposition' => $disposition) if defined($disposition); 467 | # we need some data so Content-Length gets set correctly and 468 | # the proxy doesn't wait for more data - place a canary 469 | my $resp = HTTP::Response->new(200, "OK", $header, "error canary"); 470 | $self->response($reqstate, $resp); 471 | return; 472 | } 473 | 474 | if (!($fh = $download->{fh})) { 475 | my $path = $download->{path}; 476 | die "internal error: {download} returned but neither fh not path given\n" 477 | if !$path; 478 | sysopen($fh, "$path", O_NONBLOCK | O_RDONLY) 479 | or die "open stream path '$path' for reading failed: $!\n"; 480 | } 481 | 482 | if ($download->{stream}) { 483 | my $header = HTTP::Headers->new(Content_Type => $mime); 484 | $header->header('Content-Encoding' => $encoding) if defined($encoding); 485 | $header->header('Content-Disposition' => $disposition) if defined($disposition); 486 | my $resp = HTTP::Response->new(200, "OK", $header); 487 | $self->response($reqstate, $resp, undef, 1, 0, $fh); 488 | return; 489 | } elsif (!$mime) { 490 | my $filename = $download->{path}; 491 | my ($ext) = $filename =~ m/\.([^.]*)$/; 492 | my $ext_info = $file_extension_info->{$ext}; 493 | 494 | die "unable to detect content type" if !$ext_info; 495 | $mime = $ext_info->{ct}; 496 | $nocomp = $ext_info->{nocomp}; 497 | } 498 | 499 | my $stat = File::stat::stat($fh) || 500 | die "$!\n"; 501 | 502 | my $mtime = $stat->mtime; 503 | 504 | if (my $ifmod = $r->header('if-modified-since')) { 505 | my $iftime = HTTP::Date::str2time($ifmod); 506 | if ($mtime <= $iftime) { 507 | my $resp = HTTP::Response->new(304, "NOT MODIFIED"); 508 | $self->response($reqstate, $resp, $mtime); 509 | return; 510 | } 511 | } 512 | 513 | my $data; 514 | my $len = sysread($fh, $data, $stat->size); 515 | die "got short file\n" if !defined($len) || $len != $stat->size; 516 | 517 | my $header = HTTP::Headers->new(Content_Type => $mime); 518 | my $resp = HTTP::Response->new(200, "OK", $header, $data); 519 | $self->response($reqstate, $resp, $mtime, $nocomp); 520 | }; 521 | if (my $err = $@) { 522 | $self->error($reqstate, HTTP_INTERNAL_SERVER_ERROR, $err); 523 | } 524 | }; 525 | 526 | warn $@ if $@; 527 | } 528 | 529 | sub websocket_proxy { 530 | my ($self, $reqstate, $wsaccept, $wsproto, $param) = @_; 531 | 532 | eval { 533 | my $remhost; 534 | my $remport; 535 | 536 | my $max_payload_size = 128*1024; 537 | 538 | if ($param->{port}) { 539 | $remhost = 'localhost'; 540 | $remport = $param->{port}; 541 | } elsif ($param->{socket}) { 542 | $remhost = 'unix/'; 543 | $remport = $param->{socket}; 544 | } else { 545 | die "websocket_proxy: missing port or socket\n"; 546 | } 547 | 548 | my $encode = sub { 549 | my ($data, $opcode) = @_; 550 | 551 | my $string; 552 | my $payload; 553 | 554 | $string = $opcode ? $opcode : "\x82"; # binary frame 555 | $payload = $$data; 556 | 557 | my $payload_len = length($payload); 558 | if ($payload_len <= 125) { 559 | $string .= pack 'C', $payload_len; 560 | } elsif ($payload_len <= 0xffff) { 561 | $string .= pack 'C', 126; 562 | $string .= pack 'n', $payload_len; 563 | } else { 564 | $string .= pack 'C', 127; 565 | $string .= pack 'Q>', $payload_len; 566 | } 567 | $string .= $payload; 568 | return $string; 569 | }; 570 | 571 | tcp_connect $remhost, $remport, sub { 572 | my ($fh) = @_ 573 | or die "connect to '$remhost:$remport' failed: $!"; 574 | 575 | $self->dprint("CONNECTed to '$remhost:$remport'"); 576 | 577 | $reqstate->{proxyhdl} = AnyEvent::Handle->new( 578 | fh => $fh, 579 | rbuf_max => $max_payload_size, 580 | wbuf_max => $max_payload_size*5, 581 | timeout => 5, 582 | on_eof => sub { 583 | my ($hdl) = @_; 584 | eval { 585 | $self->log_aborted_request($reqstate); 586 | $self->client_do_disconnect($reqstate); 587 | }; 588 | if (my $err = $@) { syslog('err', $err); } 589 | }, 590 | on_error => sub { 591 | my ($hdl, $fatal, $message) = @_; 592 | eval { 593 | $self->log_aborted_request($reqstate, $message); 594 | $self->client_do_disconnect($reqstate); 595 | }; 596 | if (my $err = $@) { syslog('err', "$err"); } 597 | }); 598 | 599 | my $proxyhdlreader = sub { 600 | my ($hdl) = @_; 601 | 602 | my $len = length($hdl->{rbuf}); 603 | my $data = substr($hdl->{rbuf}, 0, $len > $max_payload_size ? $max_payload_size : $len, ''); 604 | 605 | my $string = $encode->(\$data); 606 | 607 | $reqstate->{hdl}->push_write($string) if $reqstate->{hdl}; 608 | }; 609 | 610 | my $hdlreader = sub { 611 | my ($hdl) = @_; 612 | 613 | while (my $len = length($hdl->{rbuf})) { 614 | return if $len < 2; 615 | 616 | my $hdr = unpack('C', substr($hdl->{rbuf}, 0, 1)); 617 | my $opcode = $hdr & 0b00001111; 618 | my $fin = $hdr & 0b10000000; 619 | 620 | die "received fragmented websocket frame\n" if !$fin; 621 | 622 | my $rsv = $hdr & 0b01110000; 623 | die "received websocket frame with RSV flags\n" if $rsv; 624 | 625 | my $payload_len = unpack 'C', substr($hdl->{rbuf}, 1, 1); 626 | 627 | my $masked = $payload_len & 0b10000000; 628 | die "received unmasked websocket frame from client\n" if !$masked; 629 | 630 | my $offset = 2; 631 | $payload_len = $payload_len & 0b01111111; 632 | if ($payload_len == 126) { 633 | return if $len < 4; 634 | $payload_len = unpack('n', substr($hdl->{rbuf}, $offset, 2)); 635 | $offset += 2; 636 | } elsif ($payload_len == 127) { 637 | return if $len < 10; 638 | $payload_len = unpack('Q>', substr($hdl->{rbuf}, $offset, 8)); 639 | $offset += 8; 640 | } 641 | 642 | die "received too large websocket frame (len = $payload_len)\n" 643 | if ($payload_len > $max_payload_size) || ($payload_len < 0); 644 | 645 | return if $len < ($offset + 4 + $payload_len); 646 | 647 | my $data = substr($hdl->{rbuf}, 0, $offset + 4 + $payload_len, ''); # now consume data 648 | 649 | my $mask = substr($data, $offset, 4); 650 | $offset += 4; 651 | 652 | my $payload = substr($data, $offset, $payload_len); 653 | 654 | # NULL-mask might be used over TLS, skip to increase performance 655 | if ($mask ne pack('N', 0)) { 656 | # repeat 4 byte mask to payload length + up to 4 byte 657 | $mask = $mask x (int($payload_len / 4) + 1); 658 | # truncate mask to payload length 659 | substr($mask, $payload_len) = ""; 660 | # (un-)apply mask 661 | $payload ^= $mask; 662 | } 663 | 664 | if ($opcode == 1 || $opcode == 2) { 665 | $reqstate->{proxyhdl}->push_write($payload) if $reqstate->{proxyhdl}; 666 | } elsif ($opcode == 8) { 667 | my $statuscode = unpack ("n", $payload); 668 | $self->dprint("websocket received close. status code: '$statuscode'"); 669 | if (my $proxyhdl = $reqstate->{proxyhdl}) { 670 | $proxyhdl->{block_disconnect} = 1 if length $proxyhdl->{wbuf}; 671 | 672 | $proxyhdl->push_shutdown(); 673 | } 674 | $hdl->push_shutdown(); 675 | } elsif ($opcode == 9) { 676 | # ping received, schedule pong 677 | $reqstate->{hdl}->push_write($encode->(\$payload, "\x8A")) if $reqstate->{hdl}; 678 | } elsif ($opcode == 0xA) { 679 | # pong received, continue 680 | } else { 681 | die "received unhandled websocket opcode $opcode\n"; 682 | } 683 | } 684 | }; 685 | 686 | my $proto = $reqstate->{proto} ? $reqstate->{proto}->{str} : 'HTTP/1.1'; 687 | 688 | $reqstate->{proxyhdl}->timeout(0); 689 | $reqstate->{proxyhdl}->on_read($proxyhdlreader); 690 | $reqstate->{hdl}->on_read($hdlreader); 691 | 692 | # todo: use stop_read/start_read if write buffer grows to much 693 | 694 | # FIXME: remove protocol in PVE/PMG 8.x 695 | # 696 | # for backwards, compatibility, we have to reply with the websocket 697 | # subprotocol from the request 698 | my $res = "$proto 101 Switching Protocols\015\012" . 699 | "Upgrade: websocket\015\012" . 700 | "Connection: upgrade\015\012" . 701 | "Sec-WebSocket-Accept: $wsaccept\015\012" . 702 | ($wsproto ne "" ? "Sec-WebSocket-Protocol: $wsproto\015\012" : "") . 703 | "\015\012"; 704 | 705 | $self->dprint($res); 706 | 707 | $reqstate->{hdl}->push_write($res); 708 | 709 | # log early 710 | $reqstate->{log}->{code} = 101; 711 | $self->log_request($reqstate); 712 | }; 713 | 714 | }; 715 | if (my $err = $@) { 716 | warn $err; 717 | $self->log_aborted_request($reqstate, $err); 718 | $self->client_do_disconnect($reqstate); 719 | } 720 | } 721 | 722 | sub proxy_request { 723 | my ($self, $reqstate, $clientip, $host, $node, $method, $uri, $auth, $params) = @_; 724 | 725 | eval { 726 | my $target; 727 | 728 | # By default, AnyEvent::HTTP reuses connections for the idempotent 729 | # request methods GET/HEAD/PUT/DELETE. But not all of our PUT requests 730 | # are idempotent, hence, reuse connections for GET requests only, as 731 | # these should in fact be idempotent. 732 | my $persistent = $method eq 'GET'; 733 | 734 | # stringify URI object and verify it starts with a slash 735 | $uri = "$uri"; 736 | if ($uri !~ m@^/@) { 737 | $self->error($reqstate, 400, "invalid proxy uri"); 738 | return; 739 | } 740 | 741 | my $may_stream_file; 742 | if ($host eq 'localhost') { 743 | $target = "http://$host:85$uri"; 744 | # connection reuse for localhost is not worth (connection setup is about 0.2ms) 745 | $persistent = 0; 746 | $may_stream_file = 1; 747 | } elsif (Net::IP::ip_is_ipv6($host)) { 748 | $target = "https://[$host]:8006$uri"; 749 | } else { 750 | $target = "https://$host:8006$uri"; 751 | } 752 | 753 | my $headers = { 754 | PVEDisableProxy => 'true', 755 | PVEClientIP => $clientip, 756 | }; 757 | 758 | $headers->{'cookie'} = PVE::APIServer::Formatter::create_auth_cookie($auth->{ticket}, $self->{cookie_name}) 759 | if $auth->{ticket}; 760 | $headers->{'Authorization'} = PVE::APIServer::Formatter::create_auth_header($auth->{api_token}, $self->{apitoken_name}) 761 | if $auth->{api_token}; 762 | $headers->{'CSRFPreventionToken'} = $auth->{token} 763 | if $auth->{token}; 764 | if ($self->{compression}) { 765 | if ($reqstate->{accept_deflate} && $reqstate->{accept_gzip}) { 766 | $headers->{'Accept-Encoding'} = 'gzip, deflate'; 767 | } elsif ($reqstate->{accept_gzip}) { 768 | $headers->{'Accept-Encoding'} = 'gzip'; 769 | } elsif ($reqstate->{accept_deflate}) { 770 | $headers->{'Accept-Encoding'} = 'deflate'; 771 | } 772 | } 773 | 774 | if (defined(my $host = $reqstate->{request}->header('Host'))) { 775 | $headers->{Host} = $host; 776 | } 777 | 778 | my $content; 779 | 780 | if ($method eq 'POST' || $method eq 'PUT') { 781 | my $request_ct = $reqstate->{request}->header('Content-Type'); 782 | if (defined($request_ct) && $request_ct =~ 'application/json') { 783 | $headers->{'Content-Type'} = 'application/json'; 784 | $content = encode_json($params); 785 | } else { 786 | $headers->{'Content-Type'} = 'application/x-www-form-urlencoded'; 787 | # use URI object to format application/x-www-form-urlencoded content. 788 | my $url = URI->new('http:'); 789 | $url->query_form(%$params); 790 | $content = $url->query; 791 | } 792 | if (defined($content)) { 793 | $headers->{'Content-Length'} = length($content); 794 | } 795 | } 796 | 797 | my $tls = { 798 | # TLS 1.x only, with certificate pinning 799 | method => 'any', 800 | sslv2 => 0, 801 | sslv3 => 0, 802 | verify => 1, 803 | ca_path => '/usr/lib/ssl/certs', # to avoid loading the combined CA cert file 804 | verify_cb => sub { 805 | my (undef, undef, undef, $depth, undef, undef, $cert) = @_; 806 | # we don't care about intermediate or root certificates 807 | return 1 if $depth != 0; 808 | # check server certificate against cache of pinned FPs 809 | return $self->check_cert_fingerprint($cert); 810 | }, 811 | }; 812 | 813 | # load and cache cert fingerprint if first time we proxy to this node 814 | $self->initialize_cert_cache($node); 815 | 816 | my $w; $w = http_request( 817 | $method => $target, 818 | headers => $headers, 819 | timeout => 30, 820 | proxy => undef, # avoid use of $ENV{HTTP_PROXY} 821 | persistent => $persistent, 822 | # if connection reuse is enabled ($persistent is 1), allow one retry, to avoid returning 823 | # HTTP 599 Too many redirections if the server happens to close the connection 824 | recurse => $persistent ? 1 : 0, 825 | # when reusing a connection, send keep-alive headers 826 | keepalive => 1, 827 | body => $content, 828 | tls_ctx => AnyEvent::TLS->new(%{$tls}), 829 | sub { 830 | my ($body, $hdr) = @_; 831 | 832 | undef $w; 833 | 834 | if (!$reqstate->{hdl}) { 835 | warn "proxy detected vanished client connection\n"; 836 | return; 837 | } 838 | 839 | eval { 840 | my $code = delete $hdr->{Status}; 841 | my $msg = delete $hdr->{Reason}; 842 | my $stream = delete $hdr->{pvestreamfile}; 843 | delete $hdr->{URL}; 844 | delete $hdr->{HTTPVersion}; 845 | my $header = HTTP::Headers->new(%$hdr); 846 | if (my $location = $header->header('Location')) { 847 | $location =~ s|^http://localhost:85||; 848 | $header->header(Location => $location); 849 | } 850 | if ($stream) { 851 | if (!$may_stream_file) { 852 | $self->error($reqstate, 403, 'streaming denied'); 853 | return; 854 | } 855 | sysopen(my $fh, "$stream", O_NONBLOCK | O_RDONLY) 856 | or die "open stream path '$stream' for forwarding failed: $!\n"; 857 | my $resp = HTTP::Response->new($code, $msg, $header, undef); 858 | $self->response($reqstate, $resp, undef, 1, 0, $fh); 859 | } else { 860 | my $resp = HTTP::Response->new($code, $msg, $header, $body); 861 | # Note: disable compression, because body is already compressed 862 | $self->response($reqstate, $resp, undef, 1); 863 | } 864 | }; 865 | warn $@ if $@; 866 | }); 867 | }; 868 | warn $@ if $@; 869 | } 870 | 871 | # return arrays as \0 separated strings (like CGI.pm) 872 | # assume data is UTF8 encoded 873 | sub decode_urlencoded { 874 | my ($data) = @_; 875 | 876 | my $res = {}; 877 | 878 | return $res if !$data; 879 | 880 | foreach my $kv (split(/[\&\;]/, $data)) { 881 | my ($k, $v) = split(/=/, $kv); 882 | $k =~s/\+/ /g; 883 | $k =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr(hex($1))/eg; 884 | 885 | if (defined($v)) { 886 | $v =~s/\+/ /g; 887 | $v =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr(hex($1))/eg; 888 | 889 | $v = Encode::decode('utf8', $v); 890 | 891 | if (defined(my $old = $res->{$k})) { 892 | if (ref($old) eq 'ARRAY') { 893 | push @$old, $v; 894 | $v = $old; 895 | } else { 896 | $v = [$old, $v]; 897 | } 898 | } 899 | } 900 | 901 | $res->{$k} = $v; 902 | } 903 | return $res; 904 | } 905 | 906 | sub extract_params { 907 | my ($r, $method) = @_; 908 | 909 | my $params = {}; 910 | 911 | if ($method eq 'PUT' || $method eq 'POST') { 912 | my $ct; 913 | if (my $ctype = $r->header('Content-Type')) { 914 | $ct = parse_content_type($ctype); 915 | } 916 | if (defined($ct) && $ct eq 'application/json') { 917 | $params = decode_json($r->content); 918 | } else { 919 | $params = decode_urlencoded($r->content); 920 | } 921 | } 922 | 923 | my $query_params = decode_urlencoded($r->url->query()); 924 | 925 | foreach my $k (keys %{$query_params}) { 926 | $params->{$k} = $query_params->{$k}; 927 | } 928 | 929 | return $params; 930 | } 931 | 932 | sub handle_api2_request { 933 | my ($self, $reqstate, $auth, $method, $path, $upload_state) = @_; 934 | 935 | eval { 936 | my $r = $reqstate->{request}; 937 | 938 | my ($rel_uri, $format) = &$split_abs_uri($path, $self->{base_uri}); 939 | 940 | my $formatter = PVE::APIServer::Formatter::get_formatter($format, $method, $rel_uri); 941 | 942 | if (!defined($formatter)) { 943 | $self->error($reqstate, HTTP_NOT_IMPLEMENTED, "no formatter for uri $rel_uri, $format"); 944 | return; 945 | } 946 | 947 | #print Dumper($upload_state) if $upload_state; 948 | 949 | my $params; 950 | 951 | if ($upload_state) { 952 | $params = $upload_state->{params}; 953 | } else { 954 | $params = extract_params($r, $method); 955 | } 956 | 957 | delete $params->{_dc} if $params; # remove disable cache parameter 958 | 959 | my $clientip = $reqstate->{peer_host}; 960 | 961 | my $res = $self->rest_handler($clientip, $method, $rel_uri, $auth, $params, $format); 962 | 963 | # HACK: see Note 1 964 | Net::SSLeay::ERR_clear_error(); 965 | 966 | AnyEvent->now_update(); # in case somebody called sleep() 967 | 968 | my $upgrade = $r->header('upgrade'); 969 | $upgrade = lc($upgrade) if $upgrade; 970 | 971 | if (my $host = $res->{proxy}) { 972 | 973 | if ($self->{trusted_env}) { 974 | $self->error($reqstate, HTTP_INTERNAL_SERVER_ERROR, "proxy not allowed"); 975 | return; 976 | } 977 | 978 | if ($host ne 'localhost' && $r->header('PVEDisableProxy')) { 979 | $self->error($reqstate, HTTP_INTERNAL_SERVER_ERROR, "proxy loop detected"); 980 | return; 981 | } 982 | 983 | $res->{proxy_params}->{tmpfilename} = $reqstate->{tmpfilename} if $upload_state; 984 | 985 | $self->proxy_request( 986 | $reqstate, $clientip, $host, $res->{proxynode}, $method, $r->uri, $auth, $res->{proxy_params}); 987 | return; 988 | 989 | } elsif ($upgrade && ($method eq 'GET') && ($path =~ m|websocket$|)) { 990 | die "unable to upgrade to protocol '$upgrade'\n" if !$upgrade || ($upgrade ne 'websocket'); 991 | my $wsver = $r->header('sec-websocket-version'); 992 | die "unsupported websocket-version '$wsver'\n" if !$wsver || ($wsver ne '13'); 993 | my $wsproto = $r->header('sec-websocket-protocol') // ""; 994 | my $wskey = $r->header('sec-websocket-key'); 995 | die "missing websocket-key\n" if !$wskey; 996 | # Note: Digest::SHA::sha1_base64 has wrong padding 997 | my $wsaccept = Digest::SHA::sha1_base64("${wskey}258EAFA5-E914-47DA-95CA-C5AB0DC85B11") . "="; 998 | if ($res->{status} == HTTP_OK) { 999 | $self->websocket_proxy($reqstate, $wsaccept, $wsproto, $res->{data}); 1000 | return; 1001 | } 1002 | } 1003 | 1004 | my $delay = 0; 1005 | if ($res->{status} == HTTP_UNAUTHORIZED) { 1006 | # always delay unauthorized calls by 3 seconds 1007 | $delay = 3 - tv_interval($reqstate->{starttime}); 1008 | $delay = 0 if $delay < 0; 1009 | } 1010 | 1011 | my $download; 1012 | $download = $res->{data}->{download} 1013 | if defined($res->{data}) && ref($res->{data}) eq 'HASH'; 1014 | if (defined($download)) { 1015 | # TODO: remove ->{download} with PVE 9.0 1016 | if ($res->{info}->{download_allowed} || $res->{info}->{download}) { 1017 | send_file_start($self, $reqstate, $download); 1018 | return; 1019 | } else { 1020 | warn "Download attempted for non-marked API endpoint '$path'\n"; 1021 | } 1022 | } 1023 | 1024 | my ($raw, $ct, $nocomp) = $formatter->($res, $res->{data}, $params, $path, 1025 | $auth, $self->{formatter_config}); 1026 | 1027 | my $resp; 1028 | if (ref($raw) && (ref($raw) eq 'HTTP::Response')) { 1029 | $resp = $raw; 1030 | } else { 1031 | $resp = HTTP::Response->new($res->{status}, $res->{message}); 1032 | $resp->header("Content-Type" => $ct); 1033 | $resp->content($raw); 1034 | } 1035 | $self->response($reqstate, $resp, undef, $nocomp, $delay); 1036 | }; 1037 | if (my $err = $@) { 1038 | $self->error($reqstate, HTTP_INTERNAL_SERVER_ERROR, $err); 1039 | } 1040 | } 1041 | 1042 | sub handle_spice_proxy_request { 1043 | my ($self, $reqstate, $connect_str, $vmid, $node, $spiceport) = @_; 1044 | 1045 | eval { 1046 | 1047 | my ($minport, $maxport) = PVE::Tools::spice_port_range(); 1048 | if ($spiceport < $minport || $spiceport > $maxport) { 1049 | die "SPICE Port $spiceport is not in allowed range ($minport, $maxport)\n"; 1050 | } 1051 | 1052 | my $clientip = $reqstate->{peer_host}; 1053 | my $r = $reqstate->{request}; 1054 | 1055 | my $remip; 1056 | 1057 | if ($node ne 'localhost' && PVE::INotify::nodename() !~ m/^$node$/i) { 1058 | $remip = $self->remote_node_ip($node); 1059 | $self->dprint("REMOTE CONNECT $vmid, $remip, $connect_str"); 1060 | } else { 1061 | $self->dprint("CONNECT $vmid, $node, $spiceport"); 1062 | } 1063 | 1064 | if ($remip && $r->header('PVEDisableProxy')) { 1065 | $self->error($reqstate, HTTP_INTERNAL_SERVER_ERROR, "proxy loop detected"); 1066 | return; 1067 | } 1068 | 1069 | $reqstate->{hdl}->timeout(0); 1070 | $reqstate->{hdl}->wbuf_max(64*10*1024); 1071 | 1072 | my $remhost = $remip ? $remip : "localhost"; 1073 | my $remport = $remip ? 3128 : $spiceport; 1074 | 1075 | tcp_connect $remhost, $remport, sub { 1076 | my ($fh) = @_ 1077 | or die "connect to '$remhost:$remport' failed: $!"; 1078 | 1079 | $self->dprint("CONNECTed to '$remhost:$remport'"); 1080 | $reqstate->{proxyhdl} = AnyEvent::Handle->new( 1081 | fh => $fh, 1082 | rbuf_max => 64*1024, 1083 | wbuf_max => 64*10*1024, 1084 | timeout => 5, 1085 | on_eof => sub { 1086 | my ($hdl) = @_; 1087 | eval { 1088 | $self->log_aborted_request($reqstate); 1089 | $self->client_do_disconnect($reqstate); 1090 | }; 1091 | if (my $err = $@) { syslog('err', $err); } 1092 | }, 1093 | on_error => sub { 1094 | my ($hdl, $fatal, $message) = @_; 1095 | eval { 1096 | $self->log_aborted_request($reqstate, $message); 1097 | $self->client_do_disconnect($reqstate); 1098 | }; 1099 | if (my $err = $@) { syslog('err', "$err"); } 1100 | }); 1101 | 1102 | 1103 | my $proxyhdlreader = sub { 1104 | my ($hdl) = @_; 1105 | 1106 | my $len = length($hdl->{rbuf}); 1107 | my $data = substr($hdl->{rbuf}, 0, $len, ''); 1108 | 1109 | #print "READ1 $len\n"; 1110 | $reqstate->{hdl}->push_write($data) if $reqstate->{hdl}; 1111 | }; 1112 | 1113 | my $hdlreader = sub { 1114 | my ($hdl) = @_; 1115 | 1116 | my $len = length($hdl->{rbuf}); 1117 | my $data = substr($hdl->{rbuf}, 0, $len, ''); 1118 | 1119 | #print "READ0 $len\n"; 1120 | $reqstate->{proxyhdl}->push_write($data) if $reqstate->{proxyhdl}; 1121 | }; 1122 | 1123 | my $proto = $reqstate->{proto} ? $reqstate->{proto}->{str} : 'HTTP/1.0'; 1124 | 1125 | my $startproxy = sub { 1126 | $reqstate->{proxyhdl}->timeout(0); 1127 | $reqstate->{proxyhdl}->on_read($proxyhdlreader); 1128 | $reqstate->{hdl}->on_read($hdlreader); 1129 | 1130 | # todo: use stop_read/start_read if write buffer grows to much 1131 | 1132 | # a response must be followed by an empty line 1133 | my $res = "$proto 200 OK\015\012\015\012"; 1134 | $reqstate->{hdl}->push_write($res); 1135 | 1136 | # log early 1137 | $reqstate->{log}->{code} = 200; 1138 | $self->log_request($reqstate); 1139 | }; 1140 | 1141 | if ($remip) { 1142 | my $header = "CONNECT ${connect_str} $proto\015\012" . 1143 | "Host: ${connect_str}\015\012" . 1144 | "Proxy-Connection: keep-alive\015\012" . 1145 | "User-Agent: spiceproxy\015\012" . 1146 | "PVEDisableProxy: true\015\012" . 1147 | "PVEClientIP: $clientip\015\012" . 1148 | "\015\012"; 1149 | 1150 | $reqstate->{proxyhdl}->push_write($header); 1151 | $reqstate->{proxyhdl}->push_read(line => sub { 1152 | my ($hdl, $line) = @_; 1153 | 1154 | if ($line =~ m!^$proto 200 OK$!) { 1155 | # read the empty line after the 200 OK 1156 | $reqstate->{proxyhdl}->unshift_read(line => sub{ 1157 | &$startproxy(); 1158 | }); 1159 | } else { 1160 | $reqstate->{hdl}->push_write($line); 1161 | $self->client_do_disconnect($reqstate); 1162 | } 1163 | }); 1164 | } else { 1165 | &$startproxy(); 1166 | } 1167 | 1168 | }; 1169 | }; 1170 | if (my $err = $@) { 1171 | warn $err; 1172 | $self->log_aborted_request($reqstate, $err); 1173 | $self->client_do_disconnect($reqstate); 1174 | } 1175 | } 1176 | 1177 | sub handle_request { 1178 | my ($self, $reqstate, $auth, $method, $path) = @_; 1179 | 1180 | my $base_uri = $self->{base_uri}; 1181 | 1182 | eval { 1183 | my $r = $reqstate->{request}; 1184 | 1185 | # disable timeout on handle (we already have all data we need) 1186 | # we re-enable timeout in response() 1187 | $reqstate->{hdl}->timeout(0); 1188 | 1189 | if ($path =~ m/^\Q$base_uri\E/) { 1190 | $self->handle_api2_request($reqstate, $auth, $method, $path); 1191 | return; 1192 | } 1193 | 1194 | if ($self->{pages} && ($method eq 'GET') && (my $handler = $self->{pages}->{$path})) { 1195 | if (ref($handler) eq 'CODE') { 1196 | my $params = decode_urlencoded($r->url->query()); 1197 | my ($resp, $userid) = &$handler($self, $reqstate->{request}, $params); 1198 | # HACK: see Note 1 1199 | Net::SSLeay::ERR_clear_error(); 1200 | $self->response($reqstate, $resp); 1201 | } elsif (ref($handler) eq 'HASH') { 1202 | if (my $filename = $handler->{file}) { 1203 | my $fh = IO::File->new($filename) || 1204 | die "unable to open file '$filename' - $!\n"; 1205 | send_file_start($self, $reqstate, { path => $filename }); 1206 | } else { 1207 | die "internal error - no handler"; 1208 | } 1209 | } else { 1210 | die "internal error - no handler"; 1211 | } 1212 | return; 1213 | } 1214 | 1215 | if ($self->{dirs} && ($method eq 'GET')) { 1216 | # we only allow simple names 1217 | if ($path =~ m!^(/\S+/)([a-zA-Z0-9\-\_\.]+)$!) { 1218 | my ($subdir, $file) = ($1, $2); 1219 | if (my $dir = $self->{dirs}->{$subdir}) { 1220 | my $filename = "$dir$file"; 1221 | my $fh = IO::File->new($filename) || 1222 | die "unable to open file '$filename' - $!\n"; 1223 | send_file_start($self, $reqstate, { path => $filename }); 1224 | return; 1225 | } 1226 | } 1227 | } 1228 | 1229 | die "no such file '$path'\n"; 1230 | }; 1231 | if (my $err = $@) { 1232 | $self->error($reqstate, HTTP_INTERNAL_SERVER_ERROR, $err); 1233 | } 1234 | } 1235 | 1236 | my sub assert_form_disposition { 1237 | die "wrong Content-Disposition '$_[0]' in multipart, expected 'form-data'\n" if $_[0] ne 'form-data'; 1238 | } 1239 | 1240 | sub file_upload_multipart { 1241 | my ($self, $reqstate, $auth, $method, $path, $rstate) = @_; 1242 | 1243 | eval { 1244 | my $boundary = $rstate->{boundary}; 1245 | my $hdl = $reqstate->{hdl}; 1246 | my $startlen = length($hdl->{rbuf}); 1247 | 1248 | my $newline_re = qr/\015?\012/; 1249 | my $delim_re = qr/--\Q$boundary\E${newline_re}/; 1250 | my $close_delim_re = qr/--\Q$boundary\E--/; 1251 | 1252 | # Phase 0 - preserve boundary, but remove everything before 1253 | if ($rstate->{phase} == 0 && $hdl->{rbuf} =~ s/^.*?($delim_re)/$1/s) { 1254 | $rstate->{read} += $startlen - length($hdl->{rbuf}); 1255 | $rstate->{phase} = 1; 1256 | } 1257 | 1258 | my $remove_until_data = sub { 1259 | my ($hdl) = @_; 1260 | # remove any remaining multipart "headers" like Content-Type 1261 | $hdl->{rbuf} =~ s/^.*?${newline_re}{2}//s; 1262 | }; 1263 | 1264 | my $extract_form_disposition = sub { 1265 | my ($name) = @_; 1266 | if ($hdl->{rbuf} =~ s/^${delim_re}.*?Content-Disposition: (.*?); name="$name"(.*?${delim_re})/$2/s) { 1267 | assert_form_disposition($1); 1268 | $remove_until_data->($hdl); 1269 | $hdl->{rbuf} =~ s/^(.*?)(${delim_re})/$2/s; 1270 | $rstate->{params}->{$name} = trim($1); 1271 | } 1272 | }; 1273 | 1274 | if ($rstate->{phase} == 1) { # Phase 1 - parse payload without file data 1275 | $extract_form_disposition->('content'); 1276 | $extract_form_disposition->('checksum-algorithm'); 1277 | $extract_form_disposition->('checksum'); 1278 | 1279 | if ($hdl->{rbuf} =~ s/^${delim_re}Content-Disposition: (.*?); name="(.*?)"; filename="([^"]+)"//s) { 1280 | assert_form_disposition($1); 1281 | die "wrong field name '$2' for file upload, expected 'filename'" if $2 ne "filename"; 1282 | $rstate->{phase} = 2; 1283 | $rstate->{params}->{filename} = trim($3); 1284 | $remove_until_data->($hdl); # any remaining multipart "headers" like Content-Type 1285 | } 1286 | } 1287 | 1288 | if ($rstate->{phase} == 2) { # Phase 2 - dump content into file 1289 | my ($data, $write_length); 1290 | if ($hdl->{rbuf} =~ s/^(.*?)${newline_re}?+${close_delim_re}.*$//s) { 1291 | $data = $1; 1292 | $write_length = length($data); 1293 | $rstate->{phase} = 100; 1294 | } else { 1295 | $write_length = length($hdl->{rbuf}) - $rstate->{boundlen}; 1296 | $data = substr($hdl->{rbuf}, 0, $write_length, '') if $write_length > 0; 1297 | } 1298 | 1299 | if ($write_length > 0) { 1300 | syswrite($rstate->{outfh}, $data) == $write_length or die "write to temporary file failed - $!\n"; 1301 | $rstate->{bytes} += $write_length; 1302 | } 1303 | } 1304 | 1305 | if ($rstate->{phase} == 100) { # Phase 100 - transfer finished 1306 | my $elapsed = tv_interval($rstate->{starttime}); 1307 | syslog('info', "multipart upload complete (size: %dB time: %.3fs rate: %.2fMiB/s filename: %s)", 1308 | $rstate->{bytes}, $elapsed, $rstate->{bytes} / ($elapsed * 1024 * 1024), 1309 | $rstate->{params}->{filename} 1310 | ); 1311 | $self->handle_api2_request($reqstate, $auth, $method, $path, $rstate); 1312 | } 1313 | 1314 | $rstate->{read} += $startlen - length($hdl->{rbuf}); 1315 | 1316 | if ($rstate->{read} + length($hdl->{rbuf}) >= $rstate->{size} && $rstate->{phase} != 100) { 1317 | die "upload failed"; 1318 | } 1319 | }; 1320 | if (my $err = $@) { 1321 | syslog('err', $err); 1322 | $self->error($reqstate, HTTP_INTERNAL_SERVER_ERROR, $err); 1323 | } 1324 | } 1325 | 1326 | sub parse_content_type { 1327 | my ($ctype) = @_; 1328 | 1329 | my ($ct, @params) = split(/\s*[;,]\s*/o, $ctype); 1330 | 1331 | foreach my $v (@params) { 1332 | if ($v =~ m/^\s*boundary\s*=\s*(\S+?)\s*$/o) { 1333 | return wantarray ? ($ct, $1) : $ct; 1334 | } 1335 | } 1336 | 1337 | return wantarray ? ($ct) : $ct; 1338 | } 1339 | 1340 | my $tmpfile_seq_no = 0; 1341 | 1342 | sub get_upload_filename { 1343 | # choose unpredictable tmpfile name 1344 | 1345 | $tmpfile_seq_no++; 1346 | return "/var/tmp/pveupload-" . Digest::MD5::md5_hex($tmpfile_seq_no . time() . $$); 1347 | } 1348 | 1349 | sub unshift_read_header { 1350 | my ($self, $reqstate, $state) = @_; 1351 | 1352 | $state = { size => 0, count => 0 } if !$state; 1353 | 1354 | $reqstate->{hdl}->unshift_read(line => sub { 1355 | my ($hdl, $line) = @_; 1356 | 1357 | eval { 1358 | # print "$$: got header: $line\n" if $self->{debug}; 1359 | 1360 | die "too many http header lines (> $limit_max_headers)\n" if ++$state->{count} >= $limit_max_headers; 1361 | die "http header too large\n" if ($state->{size} += length($line)) >= $limit_max_header_size; 1362 | 1363 | my $r = $reqstate->{request}; 1364 | if ($line eq '') { 1365 | 1366 | $r->push_header($state->{key}, $state->{val}) 1367 | if $state->{key}; 1368 | 1369 | return if !$self->process_header($reqstate); 1370 | return if !$self->ensure_tls_connection($reqstate); 1371 | 1372 | $self->authenticate_and_handle_request($reqstate); 1373 | 1374 | } elsif ($line =~ /^([^:\s]+)\s*:\s*(.*)/) { 1375 | $r->push_header($state->{key}, $state->{val}) if $state->{key}; 1376 | ($state->{key}, $state->{val}) = ($1, $2); 1377 | $self->unshift_read_header($reqstate, $state); 1378 | } elsif ($line =~ /^\s+(.*)/) { 1379 | $state->{val} .= " $1"; 1380 | $self->unshift_read_header($reqstate, $state); 1381 | } else { 1382 | $self->error($reqstate, 506, "unable to parse request header"); 1383 | } 1384 | }; 1385 | warn $@ if $@; 1386 | }); 1387 | }; 1388 | 1389 | # sends an (error) response and returns 0 in case of errors 1390 | sub process_header { 1391 | my ($self, $reqstate) = @_; 1392 | 1393 | my $request = $reqstate->{request}; 1394 | 1395 | my $path = uri_unescape($request->uri->path()); 1396 | my $method = $request->method(); 1397 | 1398 | if (!$known_methods->{$method}) { 1399 | my $resp = HTTP::Response->new(HTTP_NOT_IMPLEMENTED, "method '$method' not available"); 1400 | $self->response($reqstate, $resp); 1401 | return 0; 1402 | } 1403 | 1404 | my $conn = $request->header('Connection'); 1405 | my $accept_enc = $request->header('Accept-Encoding'); 1406 | $reqstate->{accept_gzip} = ($accept_enc && $accept_enc =~ m/gzip/) ? 1 : 0; 1407 | $reqstate->{accept_deflate} = ($accept_enc && $accept_enc =~ m/deflate/) ? 1 : 0; 1408 | 1409 | if ($conn) { 1410 | $reqstate->{keep_alive} = 0 if $conn =~ m/close/oi; 1411 | } else { 1412 | if ($reqstate->{proto}->{ver} < 1001) { 1413 | $reqstate->{keep_alive} = 0; 1414 | } 1415 | } 1416 | 1417 | my $te = $request->header('Transfer-Encoding'); 1418 | if ($te && lc($te) eq 'chunked') { 1419 | # Handle chunked transfer encoding 1420 | $self->error($reqstate, 501, "chunked transfer encoding not supported"); 1421 | return 0; 1422 | } elsif ($te) { 1423 | $self->error($reqstate, 501, "Unknown transfer encoding '$te'"); 1424 | return 0; 1425 | } 1426 | 1427 | my $pveclientip = $request->header('PVEClientIP'); 1428 | 1429 | # fixme: how can we make PVEClientIP header trusted? 1430 | if ($self->{trusted_env} && $pveclientip) { 1431 | $reqstate->{peer_host} = $pveclientip; 1432 | } else { 1433 | $request->header('PVEClientIP', $reqstate->{peer_host}); 1434 | } 1435 | 1436 | if (my $rpcenv = $self->{rpcenv}) { 1437 | $rpcenv->set_request_host($request->header('Host')); 1438 | } 1439 | 1440 | return 1; 1441 | } 1442 | 1443 | # sends an (redirect) response, disconnects the client and returns 0 if 1444 | # connection is not TLS-protected 1445 | sub ensure_tls_connection { 1446 | my ($self, $reqstate) = @_; 1447 | 1448 | # Skip if server doesn't use TLS 1449 | if (!$self->{tls_ctx}) { 1450 | return 1; 1451 | } 1452 | 1453 | # TLS session exists, so the handshake has succeeded 1454 | if ($reqstate->{hdl}->{tls}) { 1455 | return 1; 1456 | } 1457 | 1458 | my $request = $reqstate->{request}; 1459 | my $method = $request->method(); 1460 | 1461 | my $h_host = $reqstate->{request}->header('Host'); 1462 | 1463 | die "Header field 'Host' not found in request\n" 1464 | if !$h_host; 1465 | 1466 | my $secure_host = "https://" . ($h_host =~ s/^http(s)?:\/\///r); 1467 | 1468 | my $header = HTTP::Headers->new('Location' => $secure_host . $request->uri()); 1469 | 1470 | if ($method eq 'GET' || $method eq 'HEAD') { 1471 | $self->error($reqstate, 301, 'Moved Permanently', $header); 1472 | } else { 1473 | $self->error($reqstate, 308, 'Permanent Redirect', $header); 1474 | } 1475 | 1476 | # disconnect the client so they may immediately connect again via HTTPS 1477 | $self->client_do_disconnect($reqstate); 1478 | 1479 | return 0; 1480 | } 1481 | 1482 | sub authenticate_and_handle_request { 1483 | my ($self, $reqstate) = @_; 1484 | 1485 | my $request = $reqstate->{request}; 1486 | my $method = $request->method(); 1487 | 1488 | my $path = uri_unescape($request->uri->path()); 1489 | my $base_uri = $self->{base_uri}; 1490 | 1491 | my $auth = {}; 1492 | 1493 | if (my $proxy_real_ip_header = $self->{proxy_real_ip_header}) { 1494 | if (my $proxy_real_ip_value = $request->header($proxy_real_ip_header)) { 1495 | my $real_ip = Net::IP->new($proxy_real_ip_value); 1496 | if (defined($real_ip) && $self->check_allowed_proxy($reqstate->{peer_host})) { 1497 | $reqstate->{log}->{real_ip} = Net::IP::ip_compress_address( 1498 | $real_ip->ip(), 1499 | $real_ip->version(), 1500 | ); 1501 | } 1502 | } 1503 | } 1504 | 1505 | if ($self->{spiceproxy}) { 1506 | my $connect_str = $request->header('Host'); 1507 | my ($vmid, $node, $port) = $self->verify_spice_connect_url($connect_str); 1508 | 1509 | if (!(defined($vmid) && $node && $port)) { 1510 | $self->error($reqstate, HTTP_UNAUTHORIZED, "invalid ticket"); 1511 | return; 1512 | } 1513 | 1514 | $self->handle_spice_proxy_request($reqstate, $connect_str, $vmid, $node, $port); 1515 | return; 1516 | 1517 | } elsif ($path =~ m/^\Q$base_uri\E/) { 1518 | my $token = $request->header('CSRFPreventionToken'); 1519 | my $cookie = $request->header('Cookie'); 1520 | my $auth_header = $request->header('Authorization'); 1521 | 1522 | # prefer actual cookie 1523 | my $ticket = PVE::APIServer::Formatter::extract_auth_value( 1524 | $cookie, 1525 | $self->{cookie_name} 1526 | ); 1527 | 1528 | # fallback to cookie in 'Authorization' header 1529 | if (!$ticket) { 1530 | $ticket = PVE::APIServer::Formatter::extract_auth_value( 1531 | $auth_header, 1532 | $self->{cookie_name} 1533 | ); 1534 | } 1535 | 1536 | # finally, fallback to API token if no ticket has been provided so far 1537 | my $api_token; 1538 | if (!$ticket) { 1539 | $api_token = PVE::APIServer::Formatter::extract_auth_value( 1540 | $auth_header, 1541 | $self->{apitoken_name} 1542 | ); 1543 | } 1544 | 1545 | my ($rel_uri, $format) = &$split_abs_uri($path, $self->{base_uri}); 1546 | if (!$format) { 1547 | $self->error($reqstate, HTTP_NOT_IMPLEMENTED, "no such uri"); 1548 | return; 1549 | } 1550 | 1551 | eval { 1552 | $auth = $self->auth_handler( 1553 | $method, 1554 | $rel_uri, 1555 | $ticket, 1556 | $token, 1557 | $api_token, 1558 | $reqstate->{peer_host} 1559 | ); 1560 | }; 1561 | if (my $err = $@) { 1562 | # HACK: see Note 1 1563 | Net::SSLeay::ERR_clear_error(); 1564 | # always delay unauthorized calls by 3 seconds 1565 | my $delay = 3; 1566 | 1567 | if (ref($err) eq "PVE::Exception") { 1568 | 1569 | $err->{code} ||= HTTP_INTERNAL_SERVER_ERROR, 1570 | my $resp = HTTP::Response->new($err->{code}, $err->{msg}); 1571 | $self->response($reqstate, $resp, undef, 0, $delay); 1572 | 1573 | } elsif (my $formatter = PVE::APIServer::Formatter::get_login_formatter($format)) { 1574 | my ($raw, $ct, $nocomp) = 1575 | $formatter->($path, $auth, $self->{formatter_config}); 1576 | 1577 | my $resp; 1578 | if (ref($raw) && (ref($raw) eq 'HTTP::Response')) { 1579 | $resp = $raw; 1580 | 1581 | } else { 1582 | $resp = HTTP::Response->new(HTTP_UNAUTHORIZED, "Login Required"); 1583 | $resp->header("Content-Type" => $ct); 1584 | $resp->content($raw); 1585 | } 1586 | 1587 | $self->response($reqstate, $resp, undef, $nocomp, $delay); 1588 | 1589 | } else { 1590 | my $resp = HTTP::Response->new(HTTP_UNAUTHORIZED, $err); 1591 | $self->response($reqstate, $resp, undef, 0, $delay); 1592 | } 1593 | 1594 | return; 1595 | } 1596 | } 1597 | 1598 | $reqstate->{log}->{userid} = $auth->{userid}; 1599 | my $len = $request->header('Content-Length'); 1600 | 1601 | if ($len) { 1602 | 1603 | if (!($method eq 'PUT' || $method eq 'POST')) { 1604 | $self->error($reqstate, 501, "Unexpected content for method '$method'"); 1605 | return; 1606 | } 1607 | 1608 | my $ctype = $request->header('Content-Type'); 1609 | my ($ct, $boundary) = $ctype ? parse_content_type($ctype) : (); 1610 | 1611 | if ($auth->{isUpload} && !$self->{trusted_env}) { 1612 | die "upload 'Content-Type '$ctype' not implemented\n" 1613 | if !($boundary && $ct && ($ct eq 'multipart/form-data')); 1614 | 1615 | die "upload without content length header not supported" if !$len; 1616 | 1617 | die "upload without content length header not supported" if !$len; 1618 | 1619 | $self->dprint("start upload $path $ct $boundary"); 1620 | 1621 | my $tmpfilename = get_upload_filename(); 1622 | my $outfh = IO::File->new($tmpfilename, O_RDWR|O_CREAT|O_EXCL, 0600) || 1623 | die "unable to create temporary upload file '$tmpfilename'"; 1624 | 1625 | $reqstate->{keep_alive} = 0; 1626 | 1627 | my $boundlen = length($boundary) + 8; # \015?\012--$boundary--\015?\012 1628 | 1629 | my $state = { 1630 | size => $len, 1631 | boundary => $boundary, 1632 | boundlen => $boundlen, 1633 | maxheader => 2048 + $boundlen, # should be large enough 1634 | params => decode_urlencoded($request->url->query()), 1635 | phase => 0, 1636 | read => 0, 1637 | post_size => 0, 1638 | starttime => [gettimeofday], 1639 | outfh => $outfh, 1640 | }; 1641 | 1642 | die "'tmpfilename' query parameter is not allowed for file uploads\n" 1643 | if exists $state->{params}->{tmpfilename}; 1644 | 1645 | $reqstate->{tmpfilename} = $tmpfilename; 1646 | $reqstate->{hdl}->on_read(sub { 1647 | $self->file_upload_multipart($reqstate, $auth, $method, $path, $state); 1648 | }); 1649 | 1650 | return; 1651 | } 1652 | 1653 | if ($len > $limit_max_post) { 1654 | $self->error($reqstate, 501, "for data too large"); 1655 | return; 1656 | } 1657 | 1658 | if (!$ct || $ct eq 'application/x-www-form-urlencoded' || $ct eq 'application/json') { 1659 | $reqstate->{hdl}->unshift_read(chunk => $len, sub { 1660 | my ($hdl, $data) = @_; 1661 | $request->content($data); 1662 | $self->handle_request($reqstate, $auth, $method, $path); 1663 | }); 1664 | 1665 | } else { 1666 | $self->error($reqstate, 506, "upload 'Content-Type '$ctype' not implemented"); 1667 | } 1668 | 1669 | } else { 1670 | $self->handle_request($reqstate, $auth, $method, $path); 1671 | } 1672 | } 1673 | 1674 | sub push_request_header { 1675 | my ($self, $reqstate) = @_; 1676 | 1677 | eval { 1678 | $reqstate->{hdl}->push_read(line => sub { 1679 | my ($hdl, $line) = @_; 1680 | 1681 | eval { 1682 | # print "got request header: $line\n" if $self->{debug}; 1683 | 1684 | $reqstate->{keep_alive}--; 1685 | 1686 | if ($line =~ /(\S+)\040(\S+)\040HTTP\/(\d+)\.(\d+)/o) { 1687 | my ($method, $url, $maj, $min) = ($1, $2, $3, $4); 1688 | 1689 | if ($maj != 1) { 1690 | $self->error($reqstate, 506, "http protocol version $maj.$min not supported"); 1691 | return; 1692 | } 1693 | if ($url =~ m|^[^/]*@|) { 1694 | # if an '@' comes before the first slash proxy forwarding might consider 1695 | # the frist part of the url to be part of an authority... 1696 | $self->error($reqstate, 400, "invalid url"); 1697 | return; 1698 | } 1699 | 1700 | $self->{request_count}++; # only count valid request headers 1701 | if ($self->{request_count} >= $self->{max_requests}) { 1702 | $self->{end_loop} = 1; 1703 | } 1704 | $reqstate->{log} = { requestline => $line }; 1705 | $reqstate->{proto}->{str} = "HTTP/$maj.$min"; 1706 | $reqstate->{proto}->{maj} = $maj; 1707 | $reqstate->{proto}->{min} = $min; 1708 | $reqstate->{proto}->{ver} = $maj*1000+$min; 1709 | $reqstate->{request} = HTTP::Request->new($method, $url); 1710 | $reqstate->{starttime} = [gettimeofday]; 1711 | 1712 | $self->unshift_read_header($reqstate); 1713 | } elsif ($line eq '') { 1714 | # ignore empty lines before requests (browser bugs?) 1715 | $self->push_request_header($reqstate); 1716 | } else { 1717 | $self->error($reqstate, 400, 'bad request'); 1718 | } 1719 | }; 1720 | warn $@ if $@; 1721 | }); 1722 | }; 1723 | warn $@ if $@; 1724 | } 1725 | 1726 | sub accept { 1727 | my ($self) = @_; 1728 | 1729 | my $clientfh; 1730 | 1731 | return if $self->{end_loop}; 1732 | 1733 | # we need to m make sure that only one process calls accept 1734 | while (!flock($self->{lockfh}, Fcntl::LOCK_EX())) { 1735 | next if $! == EINTR; 1736 | die "could not get lock on file '$self->{lockfile}' - $!\n"; 1737 | } 1738 | 1739 | my $again = 0; 1740 | my $errmsg; 1741 | eval { 1742 | while (!$self->{end_loop} && 1743 | !defined($clientfh = $self->{socket}->accept()) && 1744 | ($! == EINTR)) {}; 1745 | 1746 | if ($self->{end_loop}) { 1747 | $again = 0; 1748 | } else { 1749 | $again = ($! == EAGAIN || $! == WSAEWOULDBLOCK); 1750 | if (!defined($clientfh)) { 1751 | $errmsg = "failed to accept connection: $!\n"; 1752 | } 1753 | } 1754 | }; 1755 | warn $@ if $@; 1756 | 1757 | flock($self->{lockfh}, Fcntl::LOCK_UN()); 1758 | 1759 | if (!defined($clientfh)) { 1760 | return if $again; 1761 | die $errmsg if $errmsg; 1762 | } 1763 | 1764 | fh_nonblocking $clientfh, 1; 1765 | 1766 | return $clientfh; 1767 | } 1768 | 1769 | sub wait_end_loop { 1770 | my ($self) = @_; 1771 | 1772 | $self->{end_loop} = 1; 1773 | 1774 | undef $self->{socket_watch}; 1775 | 1776 | $0 = "$0 (shutdown)" if $0 !~ m/\(shutdown\)$/; 1777 | 1778 | if ($self->{conn_count} <= 0) { 1779 | $self->{end_cond}->send(1); 1780 | return; 1781 | } 1782 | 1783 | # fork and exit, so that parent starts a new worker 1784 | if (fork()) { 1785 | exit(0); 1786 | } 1787 | 1788 | # else we need to wait until all open connections gets closed 1789 | my $w; $w = AnyEvent->timer (after => 1, interval => 1, cb => sub { 1790 | eval { 1791 | # todo: test for active connections instead (we can abort idle connections) 1792 | if ($self->{conn_count} <= 0) { 1793 | undef $w; 1794 | $self->{end_cond}->send(1); 1795 | } 1796 | }; 1797 | warn $@ if $@; 1798 | }); 1799 | } 1800 | 1801 | 1802 | sub check_host_access { 1803 | my ($self, $clientip) = @_; 1804 | 1805 | $clientip = PVE::APIServer::Utils::normalize_v4_in_v6($clientip); 1806 | my $cip = Net::IP->new($clientip); 1807 | 1808 | if (!$cip) { 1809 | $self->dprint("client IP not parsable: $@"); 1810 | return 0; 1811 | } 1812 | 1813 | my $match_allow = 0; 1814 | my $match_deny = 0; 1815 | 1816 | if ($self->{allow_from}) { 1817 | foreach my $t (@{$self->{allow_from}}) { 1818 | if ($t->overlaps($cip)) { 1819 | $match_allow = 1; 1820 | $self->dprint("client IP allowed: ". $t->print()); 1821 | last; 1822 | } 1823 | } 1824 | } 1825 | 1826 | if ($self->{deny_from}) { 1827 | foreach my $t (@{$self->{deny_from}}) { 1828 | if ($t->overlaps($cip)) { 1829 | $self->dprint("client IP denied: ". $t->print()); 1830 | $match_deny = 1; 1831 | last; 1832 | } 1833 | } 1834 | } 1835 | 1836 | if ($match_allow == $match_deny) { 1837 | # match both allow and deny, or no match 1838 | return $self->{policy} && $self->{policy} eq 'allow' ? 1 : 0; 1839 | } 1840 | 1841 | return $match_allow; 1842 | } 1843 | 1844 | sub check_allowed_proxy { 1845 | my ($self, $client_ip) = @_; 1846 | 1847 | $client_ip = PVE::APIServer::Utils::normalize_v4_in_v6($client_ip); 1848 | my $client_ip_object = Net::IP->new($client_ip); 1849 | 1850 | if (!$client_ip_object) { 1851 | $self->dprint("client IP not parsable: $@"); 1852 | return 0; 1853 | } 1854 | 1855 | if (my $proxy_real_ip_allow_from = $self->{proxy_real_ip_allow_from}) { 1856 | for my $allowed_net ($proxy_real_ip_allow_from->@*) { 1857 | if ($allowed_net->overlaps($client_ip_object)) { 1858 | $self->dprint("client IP in allowed proxies: ". $allowed_net->print()); 1859 | return 1; 1860 | } 1861 | } 1862 | return 0; 1863 | } 1864 | return 1; 1865 | } 1866 | 1867 | sub accept_connections { 1868 | my ($self) = @_; 1869 | 1870 | my ($clientfh, $handle_creation); 1871 | eval { 1872 | 1873 | while ($clientfh = $self->accept()) { 1874 | 1875 | my $reqstate = { keep_alive => $self->{keep_alive} }; 1876 | 1877 | # stop keep-alive when there are many open connections 1878 | if ($self->{conn_count} + 1 >= $self->{max_conn_soft_limit}) { 1879 | $reqstate->{keep_alive} = 0; 1880 | } 1881 | 1882 | if (my $sin = getpeername($clientfh)) { 1883 | my ($pfamily, $pport, $phost) = PVE::Tools::unpack_sockaddr_in46($sin); 1884 | ($reqstate->{peer_port}, $reqstate->{peer_host}) = ($pport, Socket::inet_ntop($pfamily, $phost)); 1885 | } else { 1886 | $self->dprint("getpeername failed: $!"); 1887 | close($clientfh); 1888 | next; 1889 | } 1890 | 1891 | if (!$self->{trusted_env} && !$self->check_host_access($reqstate->{peer_host})) { 1892 | $self->dprint("ABORT request from $reqstate->{peer_host} - access denied"); 1893 | $reqstate->{log}->{code} = 403; 1894 | $self->log_request($reqstate); 1895 | close($clientfh); 1896 | next; 1897 | } 1898 | 1899 | # Increment conn_count before creating new handle, since creation 1900 | # triggers callbacks, which can potentialy decrement (e.g. 1901 | # on_error) conn_count before AnyEvent::Handle->new() returns. 1902 | $handle_creation = 1; 1903 | $self->{conn_count}++; 1904 | $reqstate->{hdl} = AnyEvent::Handle->new( 1905 | fh => $clientfh, 1906 | rbuf_max => $limit_max_post + $limit_max_header_size, 1907 | timeout => $self->{timeout}, 1908 | linger => 0, # avoid problems with ssh - really needed ? 1909 | on_eof => sub { 1910 | my ($hdl) = @_; 1911 | eval { 1912 | $self->log_aborted_request($reqstate); 1913 | $self->client_do_disconnect($reqstate); 1914 | }; 1915 | if (my $err = $@) { syslog('err', $err); } 1916 | }, 1917 | on_error => sub { 1918 | my ($hdl, $fatal, $message) = @_; 1919 | eval { 1920 | $self->log_aborted_request($reqstate, $message); 1921 | $self->client_do_disconnect($reqstate); 1922 | }; 1923 | if (my $err = $@) { syslog('err', "$err"); } 1924 | }, 1925 | ); 1926 | $handle_creation = 0; 1927 | 1928 | $self->dprint("ACCEPT FH" . $clientfh->fileno() . " CONN$self->{conn_count}"); 1929 | 1930 | if ($self->{tls_ctx}) { 1931 | $self->dprint("Setting TLS to autostart"); 1932 | $reqstate->{hdl}->unshift_read(tls_autostart => $self->{tls_ctx}, "accept"); 1933 | } 1934 | 1935 | $self->push_request_header($reqstate); 1936 | } 1937 | }; 1938 | 1939 | if (my $err = $@) { 1940 | syslog('err', $err); 1941 | $self->dprint("connection accept error: $err"); 1942 | close($clientfh); 1943 | if ($handle_creation) { 1944 | if ($self->{conn_count} <= 0) { 1945 | warn "connection count <= 0 not decrementing!\n"; 1946 | } else { 1947 | $self->{conn_count}--; 1948 | } 1949 | } 1950 | $self->{end_loop} = 1; 1951 | } 1952 | 1953 | $self->wait_end_loop() if $self->{end_loop}; 1954 | } 1955 | 1956 | # Note: We can't open log file in non-blocking mode and use AnyEvent::Handle, 1957 | # because we write from multiple processes, and that would arbitrarily mix output 1958 | # of all processes. 1959 | sub open_access_log { 1960 | my ($self, $filename) = @_; 1961 | 1962 | my $old_mask = umask(0137);; 1963 | my $logfh = IO::File->new($filename, ">>") || 1964 | die "unable to open log file '$filename' - $!\n"; 1965 | umask($old_mask); 1966 | 1967 | $logfh->autoflush(1); 1968 | 1969 | $self->{logfh} = $logfh; 1970 | } 1971 | 1972 | sub write_log { 1973 | my ($self, $data) = @_; 1974 | 1975 | return if !defined($self->{logfh}) || !$data; 1976 | 1977 | my $res = $self->{logfh}->print($data); 1978 | 1979 | if (!$res) { 1980 | delete $self->{logfh}; 1981 | syslog('err', "error writing access log"); 1982 | $self->{end_loop} = 1; # terminate asap 1983 | } 1984 | } 1985 | 1986 | sub atfork_handler { 1987 | my ($self) = @_; 1988 | 1989 | eval { 1990 | # something else do to ? 1991 | close($self->{socket}); 1992 | }; 1993 | warn $@ if $@; 1994 | } 1995 | 1996 | sub run { 1997 | my ($self) = @_; 1998 | 1999 | $self->{end_cond}->recv; 2000 | } 2001 | 2002 | sub new { 2003 | my ($this, %args) = @_; 2004 | 2005 | my $class = ref($this) || $this; 2006 | 2007 | foreach my $req (qw(socket lockfh lockfile)) { 2008 | die "misssing required argument '$req'" if !defined($args{$req}); 2009 | } 2010 | 2011 | my $self = bless { %args }, $class; 2012 | 2013 | $self->{cookie_name} //= 'PVEAuthCookie'; 2014 | $self->{apitoken_name} //= 'PVEAPIToken'; 2015 | $self->{base_uri} //= "/api2"; 2016 | $self->{dirs} //= {}; 2017 | $self->{title} //= 'API Inspector'; 2018 | $self->{compression} //= 1; 2019 | 2020 | # formatter_config: we pass some configuration values to the Formatter 2021 | $self->{formatter_config} = {}; 2022 | foreach my $p (qw(apitoken_name cookie_name base_uri title)) { 2023 | $self->{formatter_config}->{$p} = $self->{$p}; 2024 | } 2025 | $self->{formatter_config}->{csrfgen_func} = 2026 | $self->can('generate_csrf_prevention_token'); 2027 | 2028 | # add default dirs which includes jquery and bootstrap 2029 | my $jsbase = '/usr/share/javascript'; 2030 | add_dirs($self->{dirs}, '/js/' => "$jsbase/"); 2031 | # libjs-bootstrap uses symlinks for this, which we do not want to allow.. 2032 | my $glyphicons = '/usr/share/fonts/truetype/glyphicons/'; 2033 | add_dirs($self->{dirs}, '/js/bootstrap/fonts/' => "$glyphicons"); 2034 | 2035 | # init inotify 2036 | PVE::INotify::inotify_init(); 2037 | 2038 | fh_nonblocking($self->{socket}, 1); 2039 | 2040 | $self->{end_loop} = 0; 2041 | $self->{conn_count} = 0; 2042 | $self->{request_count} = 0; 2043 | $self->{timeout} = 5 if !$self->{timeout}; 2044 | $self->{keep_alive} = 0 if !defined($self->{keep_alive}); 2045 | $self->{max_conn} = 800 if !$self->{max_conn}; 2046 | $self->{max_requests} = 8000 if !$self->{max_requests}; 2047 | 2048 | $self->{policy} = 'allow' if !$self->{policy}; 2049 | 2050 | $self->{end_cond} = AnyEvent->condvar; 2051 | 2052 | if ($self->{ssl}) { 2053 | my $ssl_defaults = { 2054 | # Note: older versions are considered insecure, for example 2055 | # search for "Poodle"-Attack 2056 | method => 'any', 2057 | sslv2 => 0, 2058 | sslv3 => 0, 2059 | 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', 2060 | honor_cipher_order => 1, 2061 | }; 2062 | 2063 | # workaround until anyevent supports TLS 1.3 ciphersuites directly 2064 | my $ciphersuites = delete $self->{ssl}->{ciphersuites}; 2065 | 2066 | foreach my $k (keys %$ssl_defaults) { 2067 | $self->{ssl}->{$k} //= $ssl_defaults->{$k}; 2068 | } 2069 | 2070 | if (!defined($self->{ssl}->{dh_file})) { 2071 | $self->{ssl}->{dh} = 'skip2048'; 2072 | } 2073 | 2074 | my $tls_ctx_flags = 0; 2075 | $tls_ctx_flags |= &Net::SSLeay::OP_NO_COMPRESSION; 2076 | $tls_ctx_flags |= &Net::SSLeay::OP_SINGLE_ECDH_USE; 2077 | $tls_ctx_flags |= &Net::SSLeay::OP_SINGLE_DH_USE; 2078 | $tls_ctx_flags |= &Net::SSLeay::OP_NO_RENEGOTIATION; 2079 | if (delete $self->{ssl}->{honor_cipher_order}) { 2080 | $tls_ctx_flags |= &Net::SSLeay::OP_CIPHER_SERVER_PREFERENCE; 2081 | } 2082 | # workaround until anyevent supports disabling TLS 1.3 directly 2083 | if (exists($self->{ssl}->{tlsv1_3}) && !$self->{ssl}->{tlsv1_3}) { 2084 | $tls_ctx_flags |= &Net::SSLeay::OP_NO_TLSv1_3; 2085 | } 2086 | 2087 | 2088 | $self->{tls_ctx} = AnyEvent::TLS->new(%{$self->{ssl}}); 2089 | Net::SSLeay::CTX_set_options($self->{tls_ctx}->{ctx}, $tls_ctx_flags); 2090 | if (defined($ciphersuites)) { 2091 | warn "Failed to set TLS 1.3 ciphersuites '$ciphersuites'\n" 2092 | if !Net::SSLeay::CTX_set_ciphersuites($self->{tls_ctx}->{ctx}, $ciphersuites); 2093 | } 2094 | 2095 | my $opts = Net::SSLeay::CTX_get_options($self->{tls_ctx}->{ctx}); 2096 | my $min_version = Net::SSLeay::TLS1_1_VERSION(); 2097 | my $max_version = Net::SSLeay::TLS1_3_VERSION(); 2098 | if ($opts & &Net::SSLeay::OP_NO_TLSv1_1) { 2099 | $min_version = Net::SSLeay::TLS1_2_VERSION(); 2100 | } 2101 | if ($opts & &Net::SSLeay::OP_NO_TLSv1_2) { 2102 | $min_version = Net::SSLeay::TLS1_3_VERSION(); 2103 | } 2104 | if ($opts & &Net::SSLeay::OP_NO_TLSv1_3) { 2105 | die "misconfigured TLS settings - cannot disable all supported TLS versions!\n" 2106 | if $min_version && $min_version == Net::SSLeay::TLS1_3_VERSION(); 2107 | $max_version = Net::SSLeay::TLS1_2_VERSION(); 2108 | } 2109 | Net::SSLeay::CTX_set_min_proto_version($self->{tls_ctx}->{ctx}, $min_version) if $min_version; 2110 | Net::SSLeay::CTX_set_max_proto_version($self->{tls_ctx}->{ctx}, $max_version); 2111 | } 2112 | 2113 | if ($self->{spiceproxy}) { 2114 | $known_methods = { CONNECT => 1 }; 2115 | } 2116 | 2117 | $self->open_access_log($self->{logfile}) if $self->{logfile}; 2118 | 2119 | $self->{max_conn_soft_limit} = $self->{max_conn} > 100 ? $self->{max_conn} - 20 : $self->{max_conn}; 2120 | 2121 | $self->{socket_watch} = AnyEvent->io(fh => $self->{socket}, poll => 'r', cb => sub { 2122 | eval { 2123 | if ($self->{conn_count} >= $self->{max_conn}) { 2124 | my $w; $w = AnyEvent->timer (after => 1, interval => 1, cb => sub { 2125 | if ($self->{conn_count} < $self->{max_conn}) { 2126 | undef $w; 2127 | $self->accept_connections(); 2128 | } 2129 | }); 2130 | } else { 2131 | $self->accept_connections(); 2132 | } 2133 | }; 2134 | warn $@ if $@; 2135 | }); 2136 | 2137 | $self->{term_watch} = AnyEvent->signal(signal => "TERM", cb => sub { 2138 | undef $self->{term_watch}; 2139 | $self->wait_end_loop(); 2140 | }); 2141 | 2142 | $self->{quit_watch} = AnyEvent->signal(signal => "QUIT", cb => sub { 2143 | undef $self->{quit_watch}; 2144 | $self->wait_end_loop(); 2145 | }); 2146 | 2147 | $self->{inotify_poll} = AnyEvent->timer(after => 5, interval => 5, cb => sub { 2148 | PVE::INotify::poll(); # read inotify events 2149 | }); 2150 | 2151 | return $self; 2152 | } 2153 | 2154 | # static helper to add directory including all subdirs 2155 | # This can be used to setup $self->{dirs} 2156 | sub add_dirs { 2157 | my ($result_hash, $alias, $subdir) = @_; 2158 | 2159 | $result_hash->{$alias} = $subdir; 2160 | 2161 | my $wanted = sub { 2162 | my $dir = $File::Find::dir; 2163 | if ($dir =~m!^$subdir(.*)$!) { 2164 | my $name = "$alias$1/"; 2165 | $result_hash->{$name} = "$dir/"; 2166 | } 2167 | }; 2168 | 2169 | find({wanted => $wanted, follow => 0, no_chdir => 1}, $subdir); 2170 | } 2171 | 2172 | # abstract functions - subclass should overwrite/implement them 2173 | 2174 | sub verify_spice_connect_url { 2175 | my ($self, $connect_str) = @_; 2176 | 2177 | die "implement me"; 2178 | 2179 | #return ($vmid, $node, $port); 2180 | } 2181 | 2182 | # formatters can call this when the generate a new page 2183 | sub generate_csrf_prevention_token { 2184 | my ($username) = @_; 2185 | 2186 | return undef; # do nothing by default 2187 | } 2188 | 2189 | sub auth_handler { 2190 | my ($self, $method, $rel_uri, $ticket, $token, $api_token, $peer_host) = @_; 2191 | 2192 | die "implement me"; 2193 | 2194 | # return { 2195 | # ticket => $ticket, 2196 | # token => $token, 2197 | # userid => $username, 2198 | # age => $age, 2199 | # isUpload => $isUpload, 2200 | # api_token => $api_token, 2201 | #}; 2202 | } 2203 | 2204 | sub rest_handler { 2205 | my ($self, $clientip, $method, $rel_uri, $auth, $params, $format) = @_; 2206 | 2207 | # please do not raise exceptions here (always return a result). 2208 | 2209 | return { 2210 | status => HTTP_NOT_IMPLEMENTED, 2211 | message => "Method '$method $rel_uri' not implemented", 2212 | }; 2213 | 2214 | # this should return the following properties, which 2215 | # are then passed to the Formatter 2216 | 2217 | # status: HTTP status code 2218 | # message: Error message 2219 | # errors: more detailed error hash (per parameter) 2220 | # info: reference to JSON schema definition - useful to format output 2221 | # data: result data 2222 | 2223 | # total: additional info passed to output 2224 | # changes: additional info passed to output 2225 | 2226 | # if you want to proxy the request to another node return this 2227 | # { proxy => $remip, proxynode => $node, proxy_params => $params }; 2228 | 2229 | # to pass the request to the local priviledged daemon use: 2230 | # { proxy => 'localhost' , proxy_params => $params }; 2231 | 2232 | # to download aspecific file use: 2233 | # { download => "/path/to/file" }; 2234 | } 2235 | 2236 | sub check_cert_fingerprint { 2237 | my ($self, $cert) = @_; 2238 | 2239 | die "implement me"; 2240 | } 2241 | 2242 | sub initialize_cert_cache { 2243 | my ($self, $node) = @_; 2244 | 2245 | die "implement me"; 2246 | } 2247 | 2248 | sub remote_node_ip { 2249 | my ($self, $node) = @_; 2250 | 2251 | die "implement me"; 2252 | 2253 | # return $remip; 2254 | } 2255 | 2256 | 2257 | 1; 2258 | -------------------------------------------------------------------------------- /src/PVE/APIServer/Formatter.pm: -------------------------------------------------------------------------------- 1 | package PVE::APIServer::Formatter; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use URI::Escape; 7 | 8 | # generic formatter support 9 | # PVE::APIServer::Formatter::* classes should register themselves here 10 | 11 | my $formatter_hash = {}; 12 | my $page_formatter_hash = {}; 13 | 14 | sub register_formatter { 15 | my ($format, $code) = @_; 16 | 17 | die "formatter '$format' already defined" 18 | if defined($formatter_hash->{$format}); 19 | 20 | $formatter_hash->{$format} = $code; 21 | } 22 | 23 | sub register_page_formatter { 24 | my (%config) = @_; 25 | 26 | my $format = $config{format} || 27 | die "missing format"; 28 | 29 | my $path = $config{path} || 30 | die "missing path"; 31 | 32 | my $method = $config{method} || 33 | die "missing method"; 34 | 35 | my $code = $config{code} || 36 | die "missing formatter code"; 37 | 38 | die "duplicate page formatter for '$method: $path'" 39 | if defined($page_formatter_hash->{$format}->{$method}->{$path}); 40 | 41 | $page_formatter_hash->{$format}->{$method}->{$path} = $code; 42 | } 43 | 44 | sub get_formatter { 45 | my ($format, $method, $path) = @_; 46 | 47 | return undef if !defined($format); 48 | 49 | if (defined($method) && defined($path)) { 50 | my $code = $page_formatter_hash->{$format}->{$method}->{$path}; 51 | return $code if defined($code); 52 | } 53 | 54 | return $formatter_hash->{$format}; 55 | } 56 | 57 | my $login_formatter_hash = {}; 58 | 59 | sub register_login_formatter { 60 | my ($format, $code) = @_; 61 | 62 | die "login formatter '$format' already defined" 63 | if defined($login_formatter_hash->{$format}); 64 | 65 | $login_formatter_hash->{$format} = $code; 66 | } 67 | 68 | sub get_login_formatter { 69 | my ($format) = @_; 70 | 71 | return undef if !defined($format); 72 | 73 | return $login_formatter_hash->{$format}; 74 | } 75 | 76 | # some helper functions 77 | 78 | sub extract_auth_value { 79 | my ($header, $key) = @_; 80 | 81 | return undef if !$header; 82 | 83 | my $value = ($header =~ /(?:^|\s)\Q$key\E(?:=| )([^;]*)/)[0]; 84 | 85 | $value = uri_unescape($value) if $value; 86 | 87 | return $value; 88 | } 89 | 90 | sub create_auth_cookie { 91 | my ($ticket, $cookie_name) = @_; 92 | 93 | my $encticket = uri_escape($ticket); 94 | 95 | return "${cookie_name}=$encticket; path=/; secure; SameSite=Lax;"; 96 | } 97 | 98 | sub create_auth_header { 99 | my ($value, $key) = @_; 100 | 101 | return undef if !$key; 102 | 103 | my $encoded = uri_escape($value); 104 | return "${key} ${encoded}"; 105 | } 106 | 107 | 1; 108 | -------------------------------------------------------------------------------- /src/PVE/APIServer/Formatter/Bootstrap.pm: -------------------------------------------------------------------------------- 1 | package PVE::APIServer::Formatter::Bootstrap; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use HTML::Entities; 7 | use JSON; 8 | use URI::Escape; 9 | 10 | # Helpers to generate simple html pages using Bootstrap markup. 11 | 12 | sub new { 13 | my ($class, $res, $url, $auth, $config) = @_; 14 | 15 | my $self = bless { 16 | url => $url, 17 | title => $config->{title}, 18 | cookie_name => $config->{cookie_name}, 19 | apitoken_name => $config->{apitoken_name}, 20 | js => '', 21 | }, $class; 22 | 23 | if (my $username = $auth->{userid}) { 24 | $self->{csrftoken} = $config->{csrfgen_func}->($username); 25 | } 26 | 27 | return $self; 28 | } 29 | 30 | sub body { 31 | my ($self, $html) = @_; 32 | 33 | my $jssetup = "PVE = {};\n\n"; # create namespace 34 | 35 | if ($self->{csrftoken}) { 36 | $jssetup .= "PVE.CSRFPreventionToken = '$self->{csrftoken}';\n"; 37 | } 38 | 39 | $jssetup .= "PVE.delete_auth_cookie = function() {\n"; 40 | 41 | if ($self->{cookie_name}) { 42 | $jssetup .= " document.cookie = \"$self->{cookie_name}=; expires=Thu, 01 Jan 1970 00:00:01 GMT; path=/; secure; SameSite=Lax;\";\n"; 43 | }; 44 | $jssetup .= "};\n"; 45 | 46 | return <<_EOD; 47 | 48 | 49 | 50 | 51 | 52 | 53 | $self->{title} 54 | 55 | 56 | 57 | 58 | 61 | 62 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | $html 77 | 80 | 81 | 82 | _EOD 83 | } 84 | 85 | my $comp_id_counter = 0; 86 | 87 | sub el { 88 | my ($self, %param) = @_; 89 | 90 | $param{tag} = 'div' if !$param{tag}; 91 | 92 | my $id; 93 | 94 | my $html = "<$param{tag}"; 95 | 96 | if (wantarray) { 97 | $comp_id_counter++; 98 | $id = "pveid$comp_id_counter"; 99 | $html .= " id=$id"; 100 | } 101 | 102 | my $skip = { 103 | tag => 1, 104 | cn => 1, 105 | html => 1, 106 | text => 1, 107 | }; 108 | 109 | my $boolattr = { 110 | required => 1, 111 | autofocus => 1, 112 | }; 113 | 114 | my $noescape = { 115 | placeholder => 1, 116 | onclick => 1, 117 | }; 118 | 119 | foreach my $attr (keys %param) { 120 | next if $skip->{$attr}; 121 | my $v = $noescape->{$attr} ? $param{$attr} : uri_escape_utf8($param{$attr}, "^\/\ A-Za-z0-9\-\._~"); 122 | next if !defined($v); 123 | if ($boolattr->{$attr}) { 124 | $html .= " $attr" if $v; 125 | } else { 126 | $html .= " $attr=\"$v\""; 127 | } 128 | } 129 | 130 | $html .= ">"; 131 | 132 | 133 | if (my $cn = $param{cn}) { 134 | if(ref($cn) eq 'ARRAY'){ 135 | foreach my $rec (@$cn) { 136 | $html .= $self->el(%$rec); 137 | } 138 | } else { 139 | $html .= $self->el(%$cn); 140 | } 141 | } elsif ($param{html}) { 142 | $html .= $param{html}; 143 | } elsif ($param{text}) { 144 | $html .= encode_entities($param{text}); 145 | } 146 | 147 | $html .= ""; 148 | 149 | return wantarray ? ($html, $id) : $html; 150 | } 151 | 152 | sub alert { 153 | my ($self, %param) = @_; 154 | 155 | return $self->el(class => "alert alert-danger", %param); 156 | } 157 | 158 | sub add_js { 159 | my ($self, $js) = @_; 160 | 161 | $self->{js} .= $js . "\n"; 162 | } 163 | 164 | my $format_event_callback = sub { 165 | my ($info) = @_; 166 | 167 | my $pstr = encode_json($info->{param}); 168 | return "function(e){$info->{fn}.apply(e, $pstr);}"; 169 | }; 170 | 171 | sub button { 172 | my ($self, %param) = @_; 173 | 174 | $param{tag} = 'button'; 175 | $param{class} = "btn btn-default btn-xs"; 176 | 177 | if (my $click = delete $param{click}) { 178 | my ($html, $id) = $self->el(%param); 179 | my $cb = &$format_event_callback($click); 180 | $self->add_js("jQuery('#$id').on('click', $cb);"); 181 | return $html; 182 | } else { 183 | return $self->el(%param); 184 | } 185 | } 186 | 187 | 1; 188 | -------------------------------------------------------------------------------- /src/PVE/APIServer/Formatter/HTML.pm: -------------------------------------------------------------------------------- 1 | package PVE::APIServer::Formatter::HTML; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use PVE::APIServer::Formatter; 7 | use HTTP::Status; 8 | use JSON; 9 | use HTML::Entities; 10 | use PVE::JSONSchema; 11 | use PVE::APIServer::Formatter::Bootstrap; 12 | use PVE::APIServer::Formatter::Standard; 13 | 14 | my $portal_format = 'html'; 15 | my $portal_ct = 'text/html;charset=UTF-8'; 16 | 17 | my $get_portal_base_url = sub { 18 | my ($config) = @_; 19 | return "$config->{base_uri}/$portal_format"; 20 | }; 21 | 22 | my $get_portal_login_url = sub { 23 | my ($config) = @_; 24 | return "$config->{base_uri}/$portal_format/access/ticket"; 25 | }; 26 | 27 | sub render_page { 28 | my ($doc, $html, $config) = @_; 29 | 30 | my $items = []; 31 | 32 | push @$items, { 33 | tag => 'li', 34 | cn => { 35 | tag => 'a', 36 | href => $get_portal_login_url->($config), 37 | onclick => "PVE.delete_auth_cookie();", 38 | text => "Logout", 39 | }}; 40 | 41 | my $base_url = $get_portal_base_url->($config); 42 | 43 | my $nav = $doc->el( 44 | class => "navbar navbar-inverse navbar-fixed-top", 45 | role => "navigation", cn => { 46 | class => "container", cn => [ 47 | { 48 | class => "navbar-header", cn => [ 49 | { 50 | tag => 'button', 51 | type => 'button', 52 | class => "navbar-toggle", 53 | 'data-toggle' => "collapse", 54 | 'data-target' => ".navbar-collapse", 55 | cn => [ 56 | { tag => 'span', class => 'sr-only', text => "Toggle navigation" }, 57 | { tag => 'span', class => 'icon-bar' }, 58 | { tag => 'span', class => 'icon-bar' }, 59 | { tag => 'span', class => 'icon-bar' }, 60 | ], 61 | }, 62 | { 63 | tag => 'a', 64 | class => "navbar-brand", 65 | href => $base_url, 66 | text => $config->{title}, 67 | }, 68 | ], 69 | }, 70 | { 71 | class => "collapse navbar-collapse", 72 | cn => { 73 | tag => 'ul', 74 | class => "nav navbar-nav", 75 | cn => $items, 76 | }, 77 | }, 78 | ], 79 | }); 80 | 81 | $items = []; 82 | my @pcomp = split('/', $doc->{url}); 83 | shift @pcomp; # empty 84 | shift @pcomp; # api2 85 | shift @pcomp; # $format 86 | 87 | my $href = $base_url; 88 | push @$items, { tag => 'li', cn => { 89 | tag => 'a', 90 | href => $href, 91 | text => 'Home'}}; 92 | 93 | foreach my $comp (@pcomp) { 94 | $href .= "/".encode_entities($comp); 95 | push @$items, { tag => 'li', cn => { 96 | tag => 'a', 97 | href => $href, 98 | text => $comp}}; 99 | } 100 | 101 | my $breadcrumbs = $doc->el(tag => 'ol', class => 'breadcrumb container', cn => $items); 102 | 103 | return $doc->body($nav . $breadcrumbs . $html); 104 | } 105 | 106 | my $login_form = sub { 107 | my ($config, $doc, $param, $errmsg) = @_; 108 | 109 | $param = {} if !$param; 110 | 111 | my $username = $param->{username} || ''; 112 | my $password = $param->{password} || ''; 113 | 114 | my $items = [ 115 | { 116 | tag => 'label', 117 | text => "Please sign in", 118 | }, 119 | { 120 | tag => 'input', 121 | type => 'text', 122 | class => 'form-control', 123 | name => 'username', 124 | value => $username, 125 | placeholder => "Enter user name", 126 | required => 1, 127 | autofocus => 1, 128 | }, 129 | { 130 | tag => 'input', 131 | type => 'password', 132 | class => 'form-control', 133 | name => 'password', 134 | value => $password, 135 | placeholder => 'Password', 136 | required => 1, 137 | }, 138 | ]; 139 | 140 | my $html = ''; 141 | 142 | $html .= $doc->alert(text => $errmsg) if ($errmsg); 143 | 144 | $html .= $doc->el( 145 | class => 'container', 146 | cn => { 147 | tag => 'form', 148 | role => 'form', 149 | method => 'POST', 150 | action => $get_portal_login_url->($config), 151 | cn => [ 152 | { 153 | class => 'form-group', 154 | cn => $items, 155 | }, 156 | { 157 | tag => 'button', 158 | type => 'submit', 159 | class => 'btn btn-lg btn-primary btn-block', 160 | text => "Sign in", 161 | }, 162 | ], 163 | }); 164 | 165 | return $html; 166 | }; 167 | 168 | PVE::APIServer::Formatter::register_login_formatter($portal_format, sub { 169 | my ($path, $auth, $config) = @_; 170 | 171 | my $headers = HTTP::Headers->new(Location => $get_portal_login_url->($config)); 172 | return HTTP::Response->new(301, "Moved", $headers); 173 | }); 174 | 175 | PVE::APIServer::Formatter::register_formatter($portal_format, sub { 176 | my ($res, $data, $param, $path, $auth, $config) = @_; 177 | 178 | # fixme: clumsy! 179 | PVE::APIServer::Formatter::Standard::prepare_response_data($portal_format, $res); 180 | $data = $res->{data}; 181 | 182 | my $html = ''; 183 | my $doc = PVE::APIServer::Formatter::Bootstrap->new($res, $path, $auth, $config); 184 | 185 | if (!HTTP::Status::is_success($res->{status})) { 186 | $html .= $doc->alert(text => "Error $res->{status}: $res->{message}"); 187 | } 188 | 189 | my $lnk; 190 | 191 | if (my $info = $res->{info}) { 192 | $html .= $doc->el(tag => 'h3', text => 'Description'); 193 | $html .= $doc->el(tag => 'p', text => $info->{description}); 194 | 195 | $lnk = PVE::JSONSchema::method_get_child_link($info); 196 | } 197 | 198 | if ($lnk && $data && $data->{data} && HTTP::Status::is_success($res->{status})) { 199 | 200 | my $href = $lnk->{href}; 201 | if ($href =~ m/^\{(\S+)\}$/) { 202 | 203 | my $items = []; 204 | 205 | my $prop = $1; 206 | $path =~ s/\/+$//; # remove trailing slash 207 | 208 | foreach my $elem (sort {$a->{$prop} cmp $b->{$prop}} @{$data->{data}}) { 209 | next if !ref($elem); 210 | 211 | if (defined(my $value = $elem->{$prop})) { 212 | my $tv = to_json($elem, {pretty => 1, allow_nonref => 1, canonical => 1}); 213 | 214 | push @$items, { 215 | tag => 'a', 216 | class => 'list-group-item', 217 | href => "$path/".encode_entities($value), 218 | cn => [ 219 | { 220 | tag => 'h4', 221 | class => 'list-group-item-heading', 222 | text => $value, 223 | }, 224 | { 225 | tag => 'pre', 226 | class => 'list-group-item', 227 | text => $tv, 228 | }, 229 | ], 230 | }; 231 | } 232 | } 233 | 234 | $html .= $doc->el(class => 'list-group', cn => $items); 235 | 236 | } else { 237 | 238 | my $json = to_json($data, {allow_nonref => 1, pretty => 1, canonical => 1}); 239 | $html .= $doc->el(tag => 'pre', text => $json); 240 | } 241 | 242 | } else { 243 | 244 | my $json = to_json($data, {allow_nonref => 1, pretty => 1, canonical => 1}); 245 | $html .= $doc->el(tag => 'pre', text => $json); 246 | } 247 | 248 | $html = $doc->el(class => 'container', html => $html); 249 | 250 | my $raw = render_page($doc, $html, $config); 251 | return ($raw, $portal_ct); 252 | }); 253 | 254 | PVE::APIServer::Formatter::register_page_formatter( 255 | 'format' => $portal_format, 256 | method => 'GET', 257 | path => "/access/ticket", 258 | code => sub { 259 | my ($res, $data, $param, $path, $auth, $config) = @_; 260 | 261 | my $doc = PVE::APIServer::Formatter::Bootstrap->new($res, $path, $auth, $config); 262 | 263 | my $html = $login_form->($config, $doc); 264 | 265 | my $raw = render_page($doc, $html, $config); 266 | return ($raw, $portal_ct); 267 | }); 268 | 269 | PVE::APIServer::Formatter::register_page_formatter( 270 | 'format' => $portal_format, 271 | method => 'POST', 272 | path => "/access/ticket", 273 | code => sub { 274 | my ($res, $data, $param, $path, $auth, $config) = @_; 275 | 276 | if (HTTP::Status::is_success($res->{status})) { 277 | my $cookie = PVE::APIServer::Formatter::create_auth_cookie( 278 | $data->{ticket}, $config->{cookie_name}); 279 | 280 | my $headers = HTTP::Headers->new(Location => $get_portal_base_url->($config), 281 | 'Set-Cookie' => $cookie); 282 | return HTTP::Response->new(301, "Moved", $headers); 283 | } 284 | 285 | # Note: HTTP server redirects to 'GET /access/ticket', so below 286 | # output is not really visible. 287 | 288 | my $doc = PVE::APIServer::Formatter::Bootstrap->new($res, $path, $auth, $config); 289 | 290 | my $html = $login_form->($config, $doc); 291 | 292 | my $raw = render_page($doc, $html, $config); 293 | return ($raw, $portal_ct); 294 | }); 295 | 296 | 1; 297 | -------------------------------------------------------------------------------- /src/PVE/APIServer/Formatter/Standard.pm: -------------------------------------------------------------------------------- 1 | package PVE::APIServer::Formatter::Standard; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use PVE::APIServer::Formatter; 7 | use HTTP::Status; 8 | use JSON; 9 | use HTML::Entities; 10 | use PVE::JSONSchema; 11 | 12 | # register result formatters 13 | 14 | sub prepare_response_data { 15 | my ($format, $res) = @_; 16 | 17 | my $success = 1; 18 | my $new = { 19 | data => $res->{data}, 20 | }; 21 | if (scalar(keys %{$res->{errors}})) { 22 | $success = 0; 23 | $new->{errors} = $res->{errors}; 24 | } 25 | 26 | if ($format eq 'extjs' || $format eq 'htmljs') { 27 | # HACK: extjs wants 'success' property instead of useful HTTP status codes 28 | if (HTTP::Status::is_error($res->{status})) { 29 | $success = 0; 30 | $new->{message} = "$res->{message}" || status_message($res->{status}); 31 | $new->{status} = $res->{status} || 200; 32 | $res->{message} = undef; 33 | $res->{status} = 200; 34 | } 35 | $new->{success} = $success; 36 | } elsif ($format eq 'json') { 37 | if (HTTP::Status::is_error($res->{status})) { 38 | $new->{message} = "$res->{message}" || status_message($res->{status}); 39 | } 40 | } 41 | 42 | if ($success && $res->{total}) { 43 | $new->{total} = $res->{total}; 44 | } 45 | 46 | if ($success && $res->{changes}) { 47 | $new->{changes} = $res->{changes}; 48 | } 49 | 50 | $res->{data} = $new; 51 | } 52 | 53 | PVE::APIServer::Formatter::register_formatter('json', sub { 54 | my ($res, $data, $param, $path, $auth, $config) = @_; 55 | 56 | my $nocomp = 0; 57 | 58 | my $ct = 'application/json;charset=UTF-8'; 59 | 60 | prepare_response_data('json', $res); 61 | 62 | my $raw = to_json($res->{data}, {utf8 => 1, allow_nonref => 1}); 63 | 64 | return ($raw, $ct, $nocomp); 65 | }); 66 | 67 | 68 | PVE::APIServer::Formatter::register_formatter('extjs', sub { 69 | my ($res, $data, $param, $path, $auth, $config) = @_; 70 | 71 | my $nocomp = 0; 72 | 73 | my $ct = 'application/json;charset=UTF-8'; 74 | 75 | prepare_response_data('extjs', $res); 76 | 77 | my $raw = to_json($res->{data}, {utf8 => 1, allow_nonref => 1}); 78 | 79 | return ($raw, $ct, $nocomp); 80 | }); 81 | 82 | PVE::APIServer::Formatter::register_formatter('htmljs', sub { 83 | my ($res, $data, $param, $path, $auth, $config) = @_; 84 | 85 | my $nocomp = 0; 86 | 87 | # we use this for extjs file upload forms 88 | 89 | my $ct = 'text/html;charset=UTF-8'; 90 | 91 | prepare_response_data('htmljs', $res); 92 | 93 | my $raw = encode_entities(to_json($res->{data}, {allow_nonref => 1})); 94 | 95 | return ($raw, $ct, $nocomp); 96 | }); 97 | 98 | 99 | PVE::APIServer::Formatter::register_formatter('spiceconfig', sub { 100 | my ($res, $data, $param, $path, $auth, $config) = @_; 101 | 102 | my $nocomp = 0; 103 | 104 | my $ct = 'application/x-virt-viewer;charset=UTF-8'; 105 | 106 | prepare_response_data('spiceconfig', $res); 107 | 108 | $data = $res->{data}; 109 | 110 | my $raw; 111 | 112 | if ($data && ref($data) && ref($data->{data})) { 113 | $raw = "[virt-viewer]\n"; 114 | while (my ($key, $value) = each %{$data->{data}}) { 115 | $raw .= "$key=$value\n" if defined($value); 116 | } 117 | } 118 | 119 | return ($raw, $ct, $nocomp); 120 | }); 121 | 122 | PVE::APIServer::Formatter::register_formatter('png', sub { 123 | my ($res, $data, $param, $path, $auth, $config) = @_; 124 | 125 | my $nocomp = 1; 126 | 127 | my $ct = 'image/png'; 128 | 129 | prepare_response_data('png', $res); 130 | 131 | $data = $res->{data}; 132 | 133 | # fixme: better to revove that whole png thing ? 134 | 135 | my $filename; 136 | my $raw = ''; 137 | 138 | if ($data && ref($data) && ref($data->{data}) && 139 | $data->{data}->{filename} && defined($data->{data}->{image})) { 140 | $filename = $data->{data}->{filename}; 141 | $raw = $data->{data}->{image}; 142 | } 143 | 144 | return ($raw, $ct, $nocomp); 145 | }); 146 | -------------------------------------------------------------------------------- /src/PVE/APIServer/Utils.pm: -------------------------------------------------------------------------------- 1 | package PVE::APIServer::Utils; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Net::IP; 7 | 8 | # all settings are used for pveproxy and pmgproxy 9 | # the ALLOW/DENY/POLICY is also used by spiceproxy 10 | sub read_proxy_config { 11 | my ($proxy_name) = @_; 12 | 13 | my $conffile = "/etc/default/$proxy_name"; 14 | 15 | # Note: evaluate with bash 16 | my $shcmd = ". $conffile;\n"; 17 | $shcmd .= 'echo \"LISTEN_IP:\$LISTEN_IP\";'; 18 | $shcmd .= 'echo \"ALLOW_FROM:\$ALLOW_FROM\";'; 19 | $shcmd .= 'echo \"DENY_FROM:\$DENY_FROM\";'; 20 | $shcmd .= 'echo \"POLICY:\$POLICY\";'; 21 | $shcmd .= 'echo \"CIPHERS:\$CIPHERS\";'; 22 | $shcmd .= 'echo \"CIPHERSUITES:\$CIPHERSUITES\";'; 23 | $shcmd .= 'echo \"DHPARAMS:\$DHPARAMS\";'; 24 | $shcmd .= 'echo \"TLS_KEY_FILE:\$TLS_KEY_FILE\";'; 25 | $shcmd .= 'echo \"HONOR_CIPHER_ORDER:\$HONOR_CIPHER_ORDER\";'; 26 | $shcmd .= 'echo \"COMPRESSION:\$COMPRESSION\";'; 27 | $shcmd .= 'echo \"DISABLE_TLS_1_2:\$DISABLE_TLS_1_2\";'; 28 | $shcmd .= 'echo \"DISABLE_TLS_1_3:\$DISABLE_TLS_1_3\";'; 29 | $shcmd .= 'echo \"PROXY_REAL_IP_HEADER:\$PROXY_REAL_IP_HEADER\";'; 30 | $shcmd .= 'echo \"PROXY_REAL_IP_ALLOW_FROM:\$PROXY_REAL_IP_ALLOW_FROM\";'; 31 | 32 | my $data = -f $conffile ? `bash -c "$shcmd"` : ''; 33 | 34 | my $res = {}; 35 | 36 | my $boolean_options = [ 37 | 'HONOR_CIPHER_ORDER', 38 | 'COMPRESSION', 39 | 'DISABLE_TLS_1_2', 40 | 'DISABLE_TLS_1_3', 41 | ]; 42 | 43 | while ($data =~ s/^(.*)\n//) { 44 | my ($key, $value) = split(/:/, $1, 2); 45 | next if !defined($value) || $value eq ''; 46 | if ($key eq 'ALLOW_FROM' || $key eq 'DENY_FROM') { 47 | my $ips = []; 48 | foreach my $ip (split(/,/, $value)) { 49 | if ($ip eq 'all') { 50 | push @$ips, Net::IP->new('0/0') || die Net::IP::Error() . "\n"; 51 | push @$ips, Net::IP->new('::/0') || die Net::IP::Error() . "\n"; 52 | next; 53 | } 54 | push @$ips, Net::IP->new(normalize_v4_in_v6($ip)) || die Net::IP::Error() . "\n"; 55 | } 56 | $res->{$key} = $ips; 57 | } elsif ($key eq 'LISTEN_IP') { 58 | $res->{$key} = $value; 59 | } elsif ($key eq 'POLICY') { 60 | die "unknown policy '$value'\n" if $value !~ m/^(allow|deny)$/; 61 | $res->{$key} = $value; 62 | } elsif ($key eq 'CIPHERS') { 63 | $res->{$key} = $value; 64 | } elsif ($key eq 'CIPHERSUITES') { 65 | $res->{$key} = $value; 66 | } elsif ($key eq 'DHPARAMS') { 67 | $res->{$key} = $value; 68 | } elsif ($key eq 'TLS_KEY_FILE') { 69 | $res->{$key} = $value; 70 | } elsif ($key eq 'PROXY_REAL_IP_HEADER') { 71 | $res->{$key} = $value; 72 | } elsif ($key eq 'PROXY_REAL_IP_ALLOW_FROM') { 73 | my $ips = []; 74 | for my $ip (split(/,/, $value)) { 75 | if ($ip eq 'all') { 76 | push @$ips, Net::IP->new('0/0') || die Net::IP::Error() . "\n"; 77 | push @$ips, Net::IP->new('::/0') || die Net::IP::Error() . "\n"; 78 | next; 79 | } 80 | push @$ips, Net::IP->new(normalize_v4_in_v6($ip)) || die Net::IP::Error() . "\n"; 81 | } 82 | $res->{$key} = $ips; 83 | } elsif (grep { $key eq $_ } @$boolean_options) { 84 | die "unknown value '$value' - use 0 or 1\n" if $value !~ m/^(0|1)$/; 85 | $res->{$key} = $value; 86 | } else { 87 | # silently skip everythin else? 88 | } 89 | } 90 | 91 | return $res; 92 | } 93 | 94 | sub normalize_v4_in_v6 { 95 | my ($ip_text) = @_; 96 | 97 | my $ip = Net::IP->new($ip_text) || die Net::IP::Error() . "\n"; 98 | my $v4_mapped_v6_prefix = Net::IP->new('::ffff:0:0/96'); 99 | if ($v4_mapped_v6_prefix->overlaps($ip)) { 100 | return Net::IP::ip_get_embedded_ipv4($ip_text); 101 | } 102 | return $ip_text; 103 | } 104 | 105 | 1; 106 | -------------------------------------------------------------------------------- /src/examples/console-demo.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # This demo requires some other packages: novnc-pve and 4 | # pve-manager (for PVE::NoVncIndex) 5 | 6 | 7 | # First, we need some helpers to create authentication Tickets 8 | 9 | package Ticket; 10 | 11 | use strict; 12 | use warnings; 13 | use Net::SSLeay; 14 | 15 | use PVE::Ticket; 16 | 17 | use Crypt::OpenSSL::RSA; 18 | 19 | my $min_ticket_lifetime = -60*5; # allow 5 minutes time drift 20 | my $max_ticket_lifetime = 60*60*2; # 2 hours 21 | 22 | my $rsa = Crypt::OpenSSL::RSA->generate_key(2048); 23 | 24 | sub create_ticket { 25 | my ($username) = @_; 26 | 27 | return PVE::Ticket::assemble_rsa_ticket($rsa, 'DEMO', $username); 28 | } 29 | 30 | sub verify_ticket { 31 | my ($ticket, $noerr) = @_; 32 | 33 | return PVE::Ticket::verify_rsa_ticket( 34 | $rsa, 'DEMO', $ticket, undef, 35 | $min_ticket_lifetime, $max_ticket_lifetime, $noerr); 36 | } 37 | 38 | # VNC tickets 39 | # - they do not contain the username in plain text 40 | # - they are restricted to a specific resource path (example: '/vms/100') 41 | sub assemble_vnc_ticket { 42 | my ($username, $path) = @_; 43 | 44 | my $secret_data = "$username:$path"; 45 | 46 | return PVE::Ticket::assemble_rsa_ticket( 47 | $rsa, 'DEMOVNC', undef, $secret_data); 48 | } 49 | 50 | sub verify_vnc_ticket { 51 | my ($ticket, $username, $path, $noerr) = @_; 52 | 53 | my $secret_data = "$username:$path"; 54 | 55 | return PVE::Ticket::verify_rsa_ticket( 56 | $rsa, 'DEMOVNC', $ticket, $secret_data, -20, 40, $noerr); 57 | } 58 | 59 | # We stack several PVE::RESTHandler classes to create 60 | # the API for the novnc-pve console. 61 | 62 | package NodeInfoAPI; 63 | 64 | use strict; 65 | use warnings; 66 | 67 | use PVE::RESTHandler; 68 | use PVE::JSONSchema qw(get_standard_option); 69 | use PVE::RESTEnvironment; 70 | use PVE::SafeSyslog; 71 | 72 | use base qw(PVE::RESTHandler); 73 | 74 | __PACKAGE__->register_method ({ 75 | name => 'index', 76 | path => '', 77 | method => 'GET', 78 | permissions => { user => 'all' }, 79 | description => "Node index.", 80 | parameters => { 81 | additionalProperties => 0, 82 | properties => { 83 | node => get_standard_option('pve-node'), 84 | }, 85 | }, 86 | returns => { 87 | type => 'array', 88 | items => { 89 | type => "object", 90 | properties => {}, 91 | }, 92 | links => [ { rel => 'child', href => "{name}" } ], 93 | }, 94 | code => sub { 95 | my ($param) = @_; 96 | 97 | my $result = [ 98 | { name => 'vncshell' }, 99 | ]; 100 | 101 | return $result; 102 | }}); 103 | 104 | __PACKAGE__->register_method ({ 105 | name => 'vncshell', 106 | path => 'vncshell', 107 | method => 'POST', 108 | description => "Creates a VNC Shell proxy.", 109 | parameters => { 110 | additionalProperties => 0, 111 | properties => { 112 | node => get_standard_option('pve-node'), 113 | websocket => { 114 | optional => 1, 115 | type => 'boolean', 116 | description => "use websocket instead of standard vnc.", 117 | default => 1, 118 | }, 119 | }, 120 | }, 121 | returns => { 122 | additionalProperties => 0, 123 | properties => { 124 | user => { type => 'string' }, 125 | ticket => { type => 'string' }, 126 | port => { type => 'integer' }, 127 | upid => { type => 'string' }, 128 | }, 129 | }, 130 | code => sub { 131 | my ($param) = @_; 132 | 133 | my $node = $param->{node}; 134 | 135 | # we only implement the websocket based VNC here 136 | my $websocket = $param->{websocket} // 1; 137 | die "standard VNC not implemented" if !$websocket; 138 | 139 | my $authpath = "/nodes/$node"; 140 | 141 | my $restenv = PVE::RESTEnvironment->get(); 142 | my $user = $restenv->get_user(); 143 | 144 | my $ticket = Ticket::assemble_vnc_ticket($user, $authpath); 145 | 146 | my $family = PVE::Tools::get_host_address_family($node); 147 | my $port = PVE::Tools::next_vnc_port($family); 148 | 149 | my $cmd = ['/usr/bin/vncterm', '-rfbport', $port, 150 | '-timeout', 10, '-notls', '-listen', 'localhost', 151 | '-c', '/usr/bin/top']; 152 | 153 | my $realcmd = sub { 154 | my $upid = shift; 155 | 156 | syslog ('info', "starting vnc proxy $upid\n"); 157 | 158 | my $cmdstr = join (' ', @$cmd); 159 | syslog ('info', "launch command: $cmdstr"); 160 | 161 | eval { 162 | foreach my $k (keys %ENV) { 163 | next if $k eq 'PATH' || $k eq 'TERM' || $k eq 'USER' || $k eq 'HOME'; 164 | delete $ENV{$k}; 165 | } 166 | $ENV{PWD} = '/'; 167 | 168 | $ENV{PVE_VNC_TICKET} = $ticket; # pass ticket to vncterm 169 | 170 | PVE::Tools::run_command($cmd, errmsg => "vncterm failed"); 171 | }; 172 | if (my $err = $@) { 173 | syslog('err', $err); 174 | } 175 | 176 | return; 177 | }; 178 | 179 | my $upid = $restenv->fork_worker('vncshell', "", $user, $realcmd); 180 | 181 | PVE::Tools::wait_for_vnc_port($port); 182 | 183 | return { 184 | user => $user, 185 | ticket => $ticket, 186 | port => $port, 187 | upid => $upid, 188 | }; 189 | }}); 190 | 191 | __PACKAGE__->register_method({ 192 | name => 'vncwebsocket', 193 | path => 'vncwebsocket', 194 | method => 'GET', 195 | description => "Opens a weksocket for VNC traffic.", 196 | parameters => { 197 | additionalProperties => 0, 198 | properties => { 199 | node => get_standard_option('pve-node'), 200 | vncticket => { 201 | description => "Ticket from previous call to vncproxy.", 202 | type => 'string', 203 | maxLength => 512, 204 | }, 205 | port => { 206 | description => "Port number returned by previous vncproxy call.", 207 | type => 'integer', 208 | minimum => 5900, 209 | maximum => 5999, 210 | }, 211 | }, 212 | }, 213 | returns => { 214 | type => "object", 215 | properties => { 216 | port => { type => 'string' }, 217 | }, 218 | }, 219 | code => sub { 220 | my ($param) = @_; 221 | 222 | my $authpath = "/nodes/$param->{node}"; 223 | 224 | my $restenv = PVE::RESTEnvironment->get(); 225 | my $user = $restenv->get_user(); 226 | 227 | Ticket::verify_vnc_ticket($param->{vncticket}, $user, $authpath); 228 | 229 | my $port = $param->{port}; 230 | 231 | return { port => $port }; 232 | }}); 233 | 234 | 235 | package NodeAPI; 236 | 237 | use strict; 238 | use warnings; 239 | 240 | use PVE::RESTHandler; 241 | use PVE::JSONSchema qw(get_standard_option); 242 | 243 | use base qw(PVE::RESTHandler); 244 | 245 | __PACKAGE__->register_method ({ 246 | subclass => "NodeInfoAPI", 247 | path => '{node}', 248 | }); 249 | 250 | __PACKAGE__->register_method ({ 251 | name => 'index', 252 | path => '', 253 | method => 'GET', 254 | permissions => { user => 'all' }, 255 | description => "Cluster node index.", 256 | parameters => { 257 | additionalProperties => 0, 258 | properties => {}, 259 | }, 260 | returns => { 261 | type => 'array', 262 | items => { 263 | type => "object", 264 | properties => {}, 265 | }, 266 | links => [ { rel => 'child', href => "{node}" } ], 267 | }, 268 | code => sub { 269 | my ($param) = @_; 270 | 271 | my $res = [ 272 | { node => 'elsa' }, 273 | ]; 274 | 275 | return $res; 276 | }}); 277 | 278 | 279 | package YourAPI; 280 | 281 | use strict; 282 | use warnings; 283 | 284 | use PVE::RESTHandler; 285 | use PVE::JSONSchema; 286 | 287 | use base qw(PVE::RESTHandler); 288 | 289 | __PACKAGE__->register_method ({ 290 | subclass => "NodeAPI", 291 | path => 'nodes', 292 | }); 293 | 294 | __PACKAGE__->register_method ({ 295 | name => 'index', 296 | path => '', 297 | method => 'GET', 298 | permissions => { user => 'all' }, 299 | description => "Directory index.", 300 | parameters => { 301 | additionalProperties => 0, 302 | properties => {}, 303 | }, 304 | returns => { 305 | type => 'array', 306 | items => { 307 | type => "object", 308 | properties => { 309 | subdir => { type => 'string' }, 310 | }, 311 | }, 312 | links => [ { rel => 'child', href => "{subdir}" } ], 313 | }, 314 | code => sub { 315 | my ($resp, $param) = @_; 316 | 317 | my $res = [ { subdir => 'nodes' } ]; 318 | 319 | return $res; 320 | }}); 321 | 322 | 323 | # This is the REST/HTTPS Server 324 | package DemoServer; 325 | 326 | use strict; 327 | use warnings; 328 | use HTTP::Status qw(:constants); 329 | use URI::Escape; 330 | 331 | use PVE::APIServer::AnyEvent; 332 | use PVE::Exception qw(raise_param_exc); 333 | use PVE::RESTEnvironment; 334 | 335 | use base('PVE::APIServer::AnyEvent'); 336 | 337 | sub new { 338 | my ($this, %args) = @_; 339 | 340 | my $class = ref($this) || $this; 341 | 342 | my $self = $class->SUPER::new(%args); 343 | 344 | PVE::RESTEnvironment->init('pub'); 345 | 346 | return $self; 347 | } 348 | 349 | sub auth_handler { 350 | my ($self, $method, $rel_uri, $ticket, $token, $peer_host) = @_; 351 | 352 | my $restenv = PVE::RESTEnvironment::get(); 353 | $restenv->set_user(undef); 354 | 355 | # explicitly allow some calls without authentication 356 | if ($rel_uri eq '/access/ticket' && 357 | ($method eq 'POST' || $method eq 'GET')) { 358 | return; # allow call to create ticket 359 | } 360 | 361 | my $userid = Ticket::verify_ticket($ticket); 362 | $restenv->set_user($userid); 363 | 364 | return { 365 | ticket => $ticket, 366 | userid => $userid, 367 | }; 368 | } 369 | 370 | sub rest_handler { 371 | my ($self, $clientip, $method, $rel_uri, $auth, $params) = @_; 372 | 373 | my $resp = { 374 | status => HTTP_NOT_IMPLEMENTED, 375 | message => "Method '$method $rel_uri' not implemented", 376 | }; 377 | 378 | if ($rel_uri eq '/access/ticket') { 379 | if ($method eq 'POST') { 380 | if ($params->{username} && $params->{username} eq 'demo' && 381 | $params->{password} && $params->{password} eq 'demo') { 382 | return { 383 | status => HTTP_OK, 384 | data => { 385 | ticket => Ticket::create_ticket($params->{username}), 386 | }, 387 | }; 388 | } 389 | return $resp; 390 | } elsif ($method eq 'GET') { 391 | # this is allowed to display the login form 392 | return { status => HTTP_OK, data => {} }; 393 | } else { 394 | return $resp; 395 | } 396 | } 397 | 398 | my ($handler, $info); 399 | 400 | eval { 401 | my $uri_param = {}; 402 | ($handler, $info) = YourAPI->find_handler($method, $rel_uri, $uri_param); 403 | return if !$handler || !$info; 404 | 405 | foreach my $p (keys %{$params}) { 406 | if (defined($uri_param->{$p})) { 407 | raise_param_exc({$p => "duplicate parameter (already defined in URI)"}); 408 | } 409 | $uri_param->{$p} = $params->{$p}; 410 | } 411 | 412 | $resp = { 413 | data => $handler->handle($info, $uri_param), 414 | info => $info, # useful to format output 415 | status => HTTP_OK, 416 | }; 417 | }; 418 | if (my $err = $@) { 419 | $resp = { info => $info }; 420 | if (ref($err) eq "PVE::Exception") { 421 | $resp->{status} = $err->{code} || HTTP_INTERNAL_SERVER_ERROR; 422 | $resp->{errors} = $err->{errors} if $err->{errors}; 423 | $resp->{message} = $err->{msg}; 424 | } else { 425 | $resp->{status} = HTTP_INTERNAL_SERVER_ERROR; 426 | $resp->{message} = $err; 427 | } 428 | } 429 | 430 | return $resp; 431 | } 432 | 433 | 434 | # The main package creates the socket and runs the server 435 | package main; 436 | 437 | use strict; 438 | use warnings; 439 | 440 | use Socket qw(IPPROTO_TCP TCP_NODELAY SOMAXCONN); 441 | use IO::Socket::IP; 442 | use HTTP::Headers; 443 | use HTTP::Response; 444 | use Data::Dumper; 445 | 446 | use PVE::Tools qw(run_command); 447 | use PVE::INotify; 448 | use PVE::APIServer::Formatter::Standard; 449 | use PVE::APIServer::Formatter::HTML; 450 | use PVE::NoVncIndex; 451 | 452 | my $nodename = PVE::INotify::nodename(); 453 | my $port = 9999; 454 | 455 | my $cert_file = "simple-demo.pem"; 456 | 457 | if (! -f $cert_file) { 458 | print "generating demo server certificate\n"; 459 | my $cmd = ['openssl', 'req', '-batch', '-x509', '-newkey', 'rsa:4096', 460 | '-nodes', '-keyout', $cert_file, '-out', $cert_file, 461 | '-subj', "/CN=$nodename/", 462 | '-days', '3650']; 463 | run_command($cmd); 464 | } 465 | 466 | my $socket = IO::Socket::IP->new( 467 | LocalAddr => $nodename, 468 | LocalPort => $port, 469 | Listen => SOMAXCONN, 470 | Proto => 'tcp', 471 | GetAddrInfoFlags => 0, 472 | ReuseAddr => 1) || 473 | die "unable to create socket - $@\n"; 474 | 475 | # we often observe delays when using Nagle algorithm, 476 | # so we disable that to maximize performance 477 | setsockopt($socket, IPPROTO_TCP, TCP_NODELAY, 1); 478 | 479 | my $accept_lock_fn = "simple-demo.lck"; 480 | my $lockfh = IO::File->new(">>${accept_lock_fn}") || 481 | die "unable to open lock file '${accept_lock_fn}' - $!\n"; 482 | 483 | my $dirs = {}; 484 | PVE::APIServer::AnyEvent::add_dirs( 485 | $dirs, '/novnc/' => '/usr/share/novnc-pve/'); 486 | 487 | my $server = DemoServer->new( 488 | debug => 1, 489 | socket => $socket, 490 | lockfile => $accept_lock_fn, 491 | lockfh => $lockfh, 492 | title => 'Simple Demo API', 493 | cookie_name => 'DEMO', 494 | logfh => \*STDOUT, 495 | tls_ctx => { verify => 0, cert_file => $cert_file }, 496 | dirs => $dirs, 497 | pages => { 498 | '/' => sub { get_index($nodename, @_) }, 499 | }, 500 | ); 501 | 502 | # NOTE: Requests to non-API pages are not authenticated 503 | # so you must be very careful here 504 | 505 | my $root_page = <<__EOD__; 506 | 507 | 508 | 509 | 510 | 511 | 512 | Simple Demo Server 513 | 514 | 515 |

Simple Demo Server ($nodename)

516 | 517 |

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

519 | 520 |

Server console is here: Console 521 | 522 | 523 | 524 | __EOD__ 525 | 526 | sub get_index { 527 | my ($nodename, $server, $r, $args) = @_; 528 | 529 | my $token = ''; 530 | 531 | my ($ticket, $userid); 532 | if (my $cookie = $r->header('Cookie')) { 533 | #$ticket = PVE::APIServer::Formatter::extract_auth_cookie($cookie, $server->{cookie_name}); 534 | # $userid = Ticket::verify_ticket($ticket, 1); 535 | } 536 | 537 | my $page = $root_page; 538 | 539 | if (defined($args->{console}) && $args->{novnc}) { 540 | $page = PVE::NoVncIndex::get_index('en', $userid, $token, 541 | $args->{console}, $nodename); 542 | } 543 | 544 | my $headers = HTTP::Headers->new(Content_Type => "text/html; charset=utf-8"); 545 | my $resp = HTTP::Response->new(200, "OK", $headers, $page); 546 | 547 | return $resp; 548 | } 549 | 550 | print "demo server listens at: https://$nodename:$port/\n"; 551 | 552 | $server->run(); 553 | -------------------------------------------------------------------------------- /src/examples/simple-demo.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | package DemoServer; 4 | 5 | use strict; 6 | use warnings; 7 | use HTTP::Status qw(:constants); 8 | use URI::Escape; 9 | 10 | use PVE::APIServer::AnyEvent; 11 | use PVE::Exception qw(raise_param_exc); 12 | 13 | use base('PVE::APIServer::AnyEvent'); 14 | 15 | use Digest::MD5; 16 | 17 | my $secret = Digest::MD5::md5_base64($$ . time()); 18 | 19 | sub create_ticket { 20 | my ($username) = @_; 21 | 22 | my $salt = sprintf("%08x", time()); 23 | my $data = "$username:$salt"; 24 | my $sig = Digest::MD5::md5_base64("$data:$secret"); 25 | return "$username:$salt:$sig"; 26 | } 27 | 28 | sub verify_ticket { 29 | my ($ticket) = @_; 30 | 31 | die "no ticket" if !defined($ticket); 32 | my ($userid, $salt, $rest) = split(/:/, $ticket, 3); 33 | 34 | die "invalid ticket" if !defined($salt) || !defined($rest); 35 | 36 | die "invalid unsername" if $userid ne 'demo'; 37 | 38 | my $sig = Digest::MD5::md5_base64("$userid:$salt:$secret"); 39 | 40 | die "invalid ticket" if $rest ne $sig; 41 | 42 | return $userid; 43 | } 44 | 45 | sub auth_handler { 46 | my ($self, $method, $rel_uri, $ticket, $token, $peer_host) = @_; 47 | 48 | # explicitly allow some calls without authentication 49 | if ($rel_uri eq '/access/ticket' && 50 | ($method eq 'POST' || $method eq 'GET')) { 51 | return; # allow call to create ticket 52 | } 53 | 54 | my $userid = verify_ticket($ticket); 55 | 56 | return { 57 | ticket => $ticket, 58 | userid => $userid, 59 | }; 60 | } 61 | 62 | sub rest_handler { 63 | my ($self, $clientip, $method, $rel_uri, $auth, $params) = @_; 64 | 65 | my $resp = { 66 | status => HTTP_NOT_IMPLEMENTED, 67 | message => "Method '$method $rel_uri' not implemented", 68 | }; 69 | if ($rel_uri eq '/access/ticket') { 70 | if ($method eq 'POST') { 71 | if ($params->{username} && $params->{username} eq 'demo' && 72 | $params->{password} && $params->{password} eq 'demo') { 73 | return { 74 | status => HTTP_OK, 75 | data => { 76 | ticket => create_ticket($params->{username}), 77 | }, 78 | }; 79 | } 80 | return $resp; 81 | } elsif ($method eq 'GET') { 82 | # this is allowed to display the login form 83 | return { status => HTTP_OK, data => {} }; 84 | } else { 85 | return $resp; 86 | } 87 | } 88 | 89 | $resp = { 90 | data => { 91 | method => $method, 92 | clientip => $clientip, 93 | rel_uri => $rel_uri, 94 | auth => $auth, 95 | params => $params, 96 | }, 97 | info => { description => "You called API method '$method $rel_uri'" }, 98 | status => HTTP_OK, 99 | }; 100 | 101 | return $resp; 102 | } 103 | 104 | 105 | package main; 106 | 107 | use strict; 108 | use warnings; 109 | 110 | use Socket qw(IPPROTO_TCP TCP_NODELAY SOMAXCONN); 111 | use IO::Socket::IP; 112 | use HTTP::Headers; 113 | use HTTP::Response; 114 | 115 | use PVE::Tools qw(run_command); 116 | use PVE::INotify; 117 | use PVE::APIServer::Formatter::Standard; 118 | use PVE::APIServer::Formatter::HTML; 119 | 120 | my $nodename = PVE::INotify::nodename(); 121 | my $port = 9999; 122 | 123 | my $cert_file = "simple-demo.pem"; 124 | 125 | if (! -f $cert_file) { 126 | print "generating demo server certificate\n"; 127 | my $cmd = ['openssl', 'req', '-batch', '-x509', '-newkey', 'rsa:4096', 128 | '-nodes', '-keyout', $cert_file, '-out', $cert_file, 129 | '-subj', "/CN=$nodename/", 130 | '-days', '3650']; 131 | run_command($cmd); 132 | } 133 | 134 | my $socket = IO::Socket::IP->new( 135 | LocalAddr => $nodename, 136 | LocalPort => $port, 137 | Listen => SOMAXCONN, 138 | Proto => 'tcp', 139 | GetAddrInfoFlags => 0, 140 | ReuseAddr => 1) || 141 | die "unable to create socket - $@\n"; 142 | 143 | # we often observe delays when using Nagle algorithm, 144 | # so we disable that to maximize performance 145 | setsockopt($socket, IPPROTO_TCP, TCP_NODELAY, 1); 146 | 147 | my $accept_lock_fn = "simple-demo.lck"; 148 | my $lockfh = IO::File->new(">>${accept_lock_fn}") || 149 | die "unable to open lock file '${accept_lock_fn}' - $!\n"; 150 | 151 | my $server = DemoServer->new( 152 | socket => $socket, 153 | lockfile => $accept_lock_fn, 154 | lockfh => $lockfh, 155 | title => 'Simple Demo API', 156 | logfh => \*STDOUT, 157 | tls_ctx => { verify => 0, cert_file => $cert_file }, 158 | pages => { 159 | '/' => sub { get_index($nodename, @_) }, 160 | }, 161 | ); 162 | 163 | # NOTE: Requests to non-API pages are not authenticated 164 | # so you must be very careful here 165 | 166 | my $root_page = <<__EOD__; 167 | 168 | 169 | 170 | 171 | 172 | 173 | Simple Demo Server 174 | 175 | 176 |

Simple Demo Server ($nodename)

177 | 178 | You can browse the API here. Please sign 179 | in with usrename demo and passwort demo. 180 | 181 | 182 | 183 | __EOD__ 184 | 185 | sub get_index { 186 | my ($nodename, $server, $r, $args) = @_; 187 | 188 | my $headers = HTTP::Headers->new(Content_Type => "text/html; charset=utf-8"); 189 | my $resp = HTTP::Response->new(200, "OK", $headers, $root_page); 190 | 191 | } 192 | 193 | print "demo server listens at: https://$nodename:$port/\n"; 194 | 195 | $server->run(); 196 | --------------------------------------------------------------------------------