You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 
esp-link/examples/dummy-web-server.pl

322 lines
7.1 KiB

#!/usr/bin/perl
use strict;
use IO::Socket::INET;
use Data::Dumper;
use File::Basename;
# auto-flush on socket
$| = 1;
# creating a listening socket
my $server = new IO::Socket::INET (
LocalHost => '0.0.0.0',
LocalPort => '7777',
Proto => 'tcp',
Listen => 5,
Reuse => 1
);
die "cannot create socket $!\n" unless $server;
print "server waiting for client connection on port 7777\n";
my @webmethods = (
[ "menu", \&getMenu ],
[ "pins", \&getPins ],
[ "system/info", \&getSystemInfo ],
[ "wifi/info", \&getWifiInfo ],
);
my $client;
while ($client = $server->accept())
{
my $pid ;
while (not defined ($pid = fork()))
{
sleep 5;
}
if ($pid)
{
close $client; # Only meaningful in the client
}
else
{
$client->autoflush(1); # Always a good idea
close $server;
my $httpReq = parse_http( $client );
#print Dumper($httpReq);
my $httpResp = process_http( $httpReq );
#print Dumper($httpResp);
my $data = "HTTP/1.1 " . $httpResp->{code} . " " . $httpResp->{text} . "\r\n";
if( exists $httpResp->{fields} )
{
for my $key( keys %{$httpResp->{fields}} )
{
$data .= "$key: " . $httpResp->{fields}{$key} . "\r\n";
}
}
$data .= "\r\n";
if( exists $httpResp->{body} )
{
$data .= $httpResp->{body};
}
$client->send($data);
if( $httpResp->{done} )
{
# notify client that response has been sent
#shutdown($client, 1);
}
}
}
exit(0);
sub parse_http
{
my ($client) = @_;
# read up to 1024 characters from the connected client
my $data = "";
do{
my $buf = "";
$client->recv($buf, 1024);
$data .= $buf;
}while( $data !~ /\r\n\r\n/s );
#print "Query: $data\n";
my %resp;
my @lines = split /\r\n/, $data;
my $head = shift @lines;
if( $head =~ /(GET|POST) / )
{
$resp{method} = $1;
$head =~ s/(GET|POST) //;
if( $head =~ /^([^ ]+) HTTP\/\d\.\d/ )
{
$resp{url} = $1;
my %fields;
while( my $arg = shift @lines )
{
if( $arg =~ /^([\w-]+): (.*)$/ )
{
$fields{$1} = $2;
}
}
$resp{fields} = \%fields;
}
else
{
$resp{method} = 'ERROR';
$resp{error} = 'Invalid HTTP request';
}
}
else
{
$resp{method} = 'ERROR';
$resp{error} = 'Invalid HTTP request';
}
return \%resp;
}
sub error_response
{
my ($code, $msg) = @_;
my %resp;
$resp{code} = $code;
$resp{text} = $msg;
$resp{fields} = {};
$resp{done} = 1;
return \%resp;
}
sub slurp
{
my ($file) = @_;
open IF, "<", $file or die "Can't read file: $!";
my @fc = <IF>;
close(IF);
my $cnt = join("", @fc);
return $cnt;
}
sub content_response
{
my ($content, $url) = @_;
my %resp;
$resp{code} = 200;
$resp{text} = "OK";
$resp{done} = 1;
$resp{body} = $content;
$resp{fields} = {};
$resp{fields}{'Content-Length'} = length($content);
$resp{fields}{'Content-Type'} = "text/json";
$resp{fields}{'Content-Type'} = "text/html; charset=UTF-8" if( $url =~ /\.html$/ );
$resp{fields}{'Content-Type'} = "text/css" if( $url =~ /\.css$/ );
$resp{fields}{'Content-Type'} = "text/javascript" if( $url =~ /\.js$/ );
$resp{fields}{'Content-Type'} = "image/gif" if( $url =~ /\.ico$/ );
$resp{fields}{'Connection'} = 'close';
return \%resp;
}
sub process_http
{
my ($httpReq) = @_;
if( $httpReq->{method} eq 'ERROR' )
{
return error_response(400, $httpReq->{error});
}
if( $httpReq->{method} eq 'GET' )
{
my $url = $httpReq->{url};
$url =~ s/^\///;
$url = "home.html" if ! $url;
my $pth = dirname $0;
if( -f "$pth/../html/$url" )
{
my $cnt = slurp( "$pth/../html/$url" );
if( $url =~ /\.html$/ )
{
my $prep = slurp( "$pth/../html/head-" );
$cnt = "$prep$cnt";
}
return content_response($cnt, $url);
}
if( -f "$pth/web-server/$url" )
{
my $cnt = slurp( "$pth/web-server/$url" );
if( $url =~ /\.html$/ )
{
my $prep = slurp( "$pth/head-user-" );
$cnt = "$prep$cnt";
}
return content_response($cnt, $url);
}
elsif( grep { $_->[0] eq $url } @webmethods )
{
my @mth = grep { $_->[0] eq $url } @webmethods;
my $webm = $mth[0];
return content_response( $webm->[1]->(), $url );
}
else
{
return error_response(404, "File not found");
}
}
# TODO
return error_response(400, "Invalid HTTP request");
}
sub getMenu
{
my $out = sprintf(
"{ " .
"\"menu\": [ " .
"\"Home\", \"/home.html\", " .
"\"WiFi Station\", \"/wifi/wifiSta.html\", " .
"\"WiFi Soft-AP\", \"/wifi/wifiAp.html\", " .
"\"&#xb5;C Console\", \"/console.html\", " .
"\"Services\", \"/services.html\", " .
#ifdef MQTT
"\"REST/MQTT\", \"/mqtt.html\", " .
#endif
"\"Debug log\", \"/log.html\", " .
"\"Web Server\", \"/web-server.html\"" .
"%s" .
" ], " .
"\"version\": \"%s\", " .
"\"name\": \"%s\"" .
" }", readUserPages(), "dummy", "dummy-esp-link");
return $out;
}
sub getPins
{
return '{ "reset":12, "isp":-1, "conn":-1, "ser":2, "swap":0, "rxpup":1 }';
}
sub getSystemInfo
{
return '{ "name": "esp-link-dummy", "reset cause": "6=external", "size": "4MB:512/512", "upload-size": "3145728", "id": "0xE0 0x4016", "partition": "user2.bin", "slip": "disabled", "mqtt": "disabled/disconnected", "baud": "57600", "description": "" }';
}
sub getWifiInfo
{
return '{"mode": "STA", "modechange": "yes", "ssid": "DummySSID", "status": "got IP address", "phy": "11n", "rssi": "-45dB", "warn": "Switch to <a href=\"#\" onclick=\"changeWifiMode(3)\">STA+AP mode</a>", "apwarn": "Switch to <a href=\"#\" onclick=\"changeWifiMode(3)\">STA+AP mode</a>", "mac":"12:34:56:78:9a:bc", "chan":"11", "apssid": "ESP_012345", "appass": "", "apchan": "11", "apmaxc": "4", "aphidd": "disabled", "apbeac": "100", "apauth": "OPEN","apmac":"12:34:56:78:9a:bc", "ip": "192.168.1.2", "netmask": "255.255.255.0", "gateway": "192.168.1.1", "hostname": "esp-link", "staticip": "0.0.0.0", "dhcp": "on"}';
}
sub read_dir_structure
{
my ($dir, $base) = @_;
my @files;
opendir my $dh, $dir or die "Could not open '$dir' for reading: $!\n";
while (my $file = readdir $dh) {
if ($file eq '.' or $file eq '..') {
next;
}
my $path = "$dir/$file";
if( -d "$path" )
{
my @sd = read_dir_structure($path, "$base/$file");
push @files, @sd ;
}
else
{
push @files, "$base/$file";
}
}
close( $dh );
$_ =~ s/^\/// for(@files);
return @files;
}
sub readUserPages
{
my $pth = dirname $0;
my @files = read_dir_structure( "$pth/web-server", "/" );
@files = grep { $_ =~ /\.html$/ } @files;
my $add = '';
for my $f ( @files )
{
my $nam = $f;
$nam =~ s/\.html$//;
$nam =~ s/[^\/]*\///g;
$add .= ", \"$nam\", \"$f\"";
}
return $add;
}