update OC.DE GPX URI
[useful-scripts/mirkarte.git] / gpx.cgi
1 #!/usr/bin/perl -T
2 # From MirOS: www/files/wp.cgi,v 1.28 2018/08/29 02:13:26 tg Exp $
3 #-
4 # Copyright © 2013, 2014, 2019
5 #       mirabilos <m@mirbsd.org>
6 #
7 # Provided that these terms and disclaimer and all copyright notices
8 # are retained or reproduced in an accompanying document, permission
9 # is granted to deal in this work without restriction, including un‐
10 # limited rights to use, publicly perform, distribute, sell, modify,
11 # merge, give away, or sublicence.
12 #
13 # This work is provided “AS IS” and WITHOUT WARRANTY of any kind, to
14 # the utmost extent permitted by applicable law, neither express nor
15 # implied; without malicious intent or gross negligence. In no event
16 # may a licensor, author or contributor be held liable for indirect,
17 # direct, other damage, loss, or other issues arising in any way out
18 # of dealing in the work, even if advised of the possibility of such
19 # damage or existence of a defect, except proven that it results out
20 # of said person’s immediate fault when using the work as intended.
21
22 use strict;
23 use warnings;
24
25 # magic to allow including relative to dirname($0)
26 use FindBin qw/$Bin/;
27 BEGIN {
28         if ($Bin =~ m!([\w\./]+)!) {
29                 $Bin = $1;
30         } else {
31                 die "Bad directory $Bin\n";
32         }
33 }
34 use lib $Bin;
35 # include wp.pm, hopefully from dirname($0)
36 use wp;
37
38 # for gpx.sh calls
39 chdir($Bin) or die;
40
41 my $output = "";
42 my $query = "";
43 my $found = 0;
44
45 if (defined($ENV{QUERY_STRING})) {
46         for my $p (split(/[;&]+/, $ENV{QUERY_STRING})) {
47                 next unless $p;
48                 $p =~ y/+/ /;
49                 my ($key, $val) = split(/=/, $p, 2);
50                 next unless defined($key);
51
52                 next unless ($key eq "q");
53                 next unless defined($val);
54                 $val =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/chr(hex($1))/eg;
55                 next if $val =~ /[\t\r\n]/;
56                 $query = $val;
57         }
58         if ($query eq "") {
59                 my $p = $ENV{QUERY_STRING};
60                 $p =~ y/+/ /;
61                 $p =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/chr(hex($1))/eg;
62                 next if $p =~ /[\t\r\n]/;
63                 $query = $p;
64         }
65 }
66
67 # ltrim and rtrim
68 $query =~ s/^\s+//;
69 $query =~ s/\s+$//;
70
71 # handle early, before uppercasing
72 my ($code, $label, $url) = explwp($query);
73 if ($code eq 'm/') {
74         &redirect($url);
75 }
76 if ($code =~ m!^(gh|Gh)$!) {
77         $output = $label;
78         $found = 2;
79         $query = "";
80 }
81
82 # early drop invalid requests
83 $query = "" unless $query =~ /^[0-9A-Za-z_-]*$/;
84 # uppercase, nice to the user
85 $query =~ y/a-z/A-Z/;
86
87 # local substitution helper
88 sub chkwp($) {
89         my ($q) = @_;
90         my ($code, $label, $url) = explwp($q);
91
92         # once only
93         $found = -1 unless $found == 0;
94
95         # not implemented yet
96         if ($code ne "") {
97                 $output = $url;
98                 $found = 1 if $found == 0;
99         }
100
101         # via ./gpx.sh
102         if ($code =~ m!^(GD|VX|gh|Gh)$!) {
103                 $output = $label;
104                 $found = 2 if $found == 1;
105         }
106
107         # via redirect
108         if ($code =~ m!^(OC)$!) {
109                 $output = $label;
110                 $found = 3 if $found == 1;
111         }
112
113         return ($url);
114 }
115
116 if ($query ne "") {
117         substwps($query);
118 }
119
120 if ($found == 3) {
121         &redirect("https://www.opencaching.de/search.php?searchbywp=1&showresult=1&output=GPX&f_inactive=0&f_ignored=0&wp=$output") if
122             ($output =~ m!^OC!);
123
124         # fall through
125         $found = 0;
126 }
127
128 if ($found == 2) {
129         delete $ENV{'PATH'};
130         my $gpx = qx(./gpx.sh $output);
131
132         if ($? == 0 && $gpx =~ m!<wpt!) {
133                 print("Content-type: application/force-download\r\n");
134                 printf("Content-Length: %d\r\n", length $gpx);
135                 print("Content-Disposition: attachment; filename=\"$output.gpx\"\r\n");
136                 print("X-Content-Type-Options: nosniff\r\n");
137                 print("\r\n$gpx");
138                 exit(0);
139         }
140
141         # fall through
142         $found = 0;
143 }
144
145 $output = "http://www.mirbsd.org/wp.htm" unless ($found > 0);
146 &redirect($output);