Skip to content

Instantly share code, notes, and snippets.

@nabe-abk
Created December 19, 2019 14:19
Show Gist options
  • Save nabe-abk/5058b77c2940050d7bca278f6cea9735 to your computer and use it in GitHub Desktop.
Save nabe-abk/5058b77c2940050d7bca278f6cea9735 to your computer and use it in GitHub Desktop.
#!/usr/bin/perl
################################################################################
# IP camera relay (Webcam/VAPIX relay) (C)2015-2019 nabe@abk
################################################################################
# This program is licensed under GPLv2 or later.
#
use strict;
use Socket qw(:all);
use Fcntl;
################################################################################
print "IP camera relay 2019/12/19 (C)nabe\@abk\n\n";
################################################################################
my $DEBUG = 0;
my $TIMEOUT = 1; # [sec] Connection Timeout in parse header
my $RETRY_WAIT = 1; # [sec] IP Camera reconnect time
my $SELECT_WAIT = 0.1; # [sec]
my $BIND_PORT = 8888;
my $BOUNDARY = 'IPCameraRelayPlBboundary';
################################################################################
# Options
################################################################################
my $BLANK_IMG;
my @CAMERAS;
{
my $black;
my @ary = @ARGV;
while(@ary) {
my $opt = shift(@ary);
if ($opt eq '-i') {
my $file = shift(@ary);
$BLANK_IMG = &load_jpeg_file( $file );
if (!$BLANK_IMG) {
print STDERR "Can't read jpeg : $file\n";
}
next;
}
if ($opt eq '-p') {
$BIND_PORT = int(shift(@ary));
next;
}
if ($opt eq '-r') {
$RETRY_WAIT = shift(@ary) + 0;
if ($RETRY_WAIT < 1) { $RETRY_WAIT = 1; }
next;
}
if ($opt eq '-b') {
$black = 1;
next;
}
if ($opt eq '-d') {
$DEBUG = 1;
$TIMEOUT = 999;
next;
}
if ($opt !~ m|^(?:http://)?([\w\-\.]+)(?:\:(\d+))?(.*)|i) {
print STDERR "Unknown option : $opt\n";
next;
}
my $host = $1;
my $port = $2 || 80;
my $path = $3 || '/';
my $num = $#CAMERAS+1;
print "Camera_$num http://$host:$port$path\n";
my $addr = pack_sockaddr_in($port, inet_aton($host));
push(@CAMERAS,{
host => $host,
port => $port,
path => $path,
addr => $addr
});
}
$BLANK_IMG ||= $black ? &load_blank_image_black_640x480() : &load_blank_image_blue_640x480();
$BLANK_IMG = &image2block( $BLANK_IMG );
if (!@CAMERAS) {
print <<HELP;
Usage: $0 [options] Camera-Stream-URL [Stream-URL2] ...
Available options are:
-p port bind port for client
-r sec retry interval time(sec). default 1 sec
-i file blank jpeg image. Is the same as camera's image size(pixel)
(default) 640x480 blue image
-b blank image set to 640x480 pixel black image
-d debug mode
(Camera-Stream-URL examples)
http://192.168.1.101/video
http://192.168.1.102:8080/mjpeg
192.168.1.110:8080/path
192.168.1.120:8080
If exists multiple URL, try connect round robin URL.
This software works only Motion JPEG stream.
HELP
exit(0);
}
}
################################################################################
# Create Server sock
################################################################################
my $srv;
socket($srv, PF_INET, SOCK_STREAM, 0) || die "Can't open socket";
setsockopt($srv, SOL_SOCKET, SO_REUSEADDR, 1);
bind($srv, sockaddr_in($BIND_PORT, INADDR_ANY)) || die("bind failed: port=$BIND_PORT");
listen($srv, SOMAXCONN);
print "Bind port : $BIND_PORT\n";
print "Retry wait : $RETRY_WAIT sec\n";
$RETRY_WAIT /= ($#CAMERAS+1);
################################################################################
# Create Video IP receive sock
################################################################################
my $rec;
my $CAMERA;
my $camera_c = 0;
sub connect_receiver {
$CAMERA = $CAMERAS[ $camera_c ];
$camera_c++;
if ($#CAMERAS < $camera_c) { $camera_c=0; }
socket($rec, PF_INET, SOCK_STREAM, 0) || die "Can't open socket";
&set_nonblock($rec);
connect($rec, $CAMERA->{addr});
&set_block($rec);
$DEBUG && print "[IP Camera] Try connect $CAMERA->{host}:$CAMERA->{port}\n";
}
&connect_receiver();
################################################################################
# Main Loop
################################################################################
my @clients;
my $read_bits;
my $wri_bits;
my $err_bits;
my $state;
my %hosts;
$SIG{PIPE} = sub { };
$SIG{INT} = sub {
close($srv);
close($rec);
foreach(@clients) { close($_); }
exit(-1);
};
&set_bit($read_bits, $srv);
my $rec_state;
my $rec_boundary;
my $rec_wait = 0;
sub close_receiver {
$rec_wait = $RETRY_WAIT;
close($rec);
}
while (1) {
my $r = $read_bits;
my $w;
if ($rec_wait <= 0) {
&set_bit($r, $rec);
&set_bit($w, $rec);
}
select($r, $w, undef, $SELECT_WAIT);
# receiver connect wait
if ($rec_wait > 0) { $rec_wait -= $SELECT_WAIT; }
# new client
while(&check_bit($r, $srv)) {
my $client;
my $addr = accept($client, $srv);
if (!$addr) { last; }
setsockopt($client, IPPROTO_TCP, TCP_NODELAY, 1);
my($port, $ip_bin) = sockaddr_in($addr);
my $ip = inet_ntoa($ip_bin);
$DEBUG && print "Connection from $ip:$port\n";
$hosts{$client} = "$ip:$port";
local $SIG{ALRM} = sub { close($client); };
alarm( $TIMEOUT );
while (my $buf = <$client>) {
if ($buf =~ m/^\r?\n$/) { last; }
}
&send_response_header($client);
alarm(0);
push(@clients, $client);
last;
}
#----------------------------------------------------------------
# ip stream receive
#----------------------------------------------------------------
while(!$rec_state && &check_bit($w, $rec)) {
local $SIG{ALRM} = sub { close($rec); };
alarm( $TIMEOUT );
my $size = &send_request_header($rec, $CAMERA);
if (!$size) {
&close_receiver();
&connect_receiver();
alarm(0);
last;
}
$rec_state = 1;
while ((my $line = <$rec>) || 1) {
$line =~ s/[\r\n]//g;
if ($line =~ m|^Content-Type:\s*[\w/-]+\s*;\s*boundary=(.*)|) {
$rec_boundary = "--$1\r\n";
next;
}
if ($line eq '') { last; }
}
alarm(0);
$DEBUG && print "[IP Camera] Connected $CAMERA->{host}:$CAMERA->{port}\n";
next;
}
my $img;
if ($rec_state && &check_bit($r, $rec)) {
$img = &read_one_block($rec, $rec_boundary);
if (!$img) {
&close_receiver();
&connect_receiver();
$rec_state = 0;
next;
}
$DEBUG && print "[IP Camera] Receive one block\n";
}
if ($rec_state && !$img) { next; }
#----------------------------------------------------------------
# Stream send
#----------------------------------------------------------------
foreach(@clients) {
my $size = &socket_out($_, $img ? "--$BOUNDARY\r\n$img" : $BLANK_IMG);
if (!$size) {
$DEBUG && print "Connection close $hosts{$_}\n";
close($_);
$_ = undef;
}
}
@clients = grep { $_ } @clients;
}
exit(0);
################################################################################
# network subroutine
################################################################################
sub set_bit { vec($_[0], fileno($_[1]), 1) = 1; }
sub check_bit { return vec($_[0], fileno($_[1]), 1); }
sub socket_out {
my $sock = shift;
return syswrite($sock, $_[0], length($_[0]) );
}
sub set_block {
my $sock = shift;
return &set_nonblock($sock, 1);
}
sub set_nonblock {
my $sock = shift;
my $block = shift;
if ($^O eq 'MSWin32') {
my $f = 0x8004667e; # FIONBIO for windows
my $v = pack("L", $block ? 0 : 1);
ioctl($sock, $f, $v);
return;
}
my $flags = fcntl($sock, F_GETFL, 0);
if ($block) {
$flags &= ~O_NONBLOCK;
} else {
$flags |= O_NONBLOCK;
}
fcntl($sock, F_SETFL, $flags);
}
################################################################################
# print_response_header
################################################################################
sub send_request_header {
my $sock = shift;
my $info = shift;
my $p = ($info->{port} == 80) ? '' : ":$info->{port}";
my $request = <<REQUEST;
GET $info->{path} HTTP/1.1
Host: $info->{host}$p
REQUEST
$request =~ s/\r?\n/\r\n/g;
return &socket_out($sock, $request);
}
sub send_response_header {
my $sock = shift;
my $response = <<RESPONSE;
HTTP/1.1 200 OK
Connection: close
Server: IP Camera Relay Server
Cache-Control: no-store, no-cache, must-revalidate, pre-check=0, post-check=0, max-age=0
Pragma: no-cache
Expires: -1
Access-Control-Allow-Origin: *
Content-Type: multipart/x-mixed-replace;boundary=$BOUNDARY
RESPONSE
$response =~ s/\r?\n/\r\n/g;
return &socket_out($sock, $response);
}
################################################################################
# recieve packet
################################################################################
sub read_one_block {
my $sock = shift;
my $bound = shift;
while(my $line = <$sock>) {
if ($line eq $bound) { last; }
}
# (Example)
# --Ba4oTvQMY8ew04N8dcnM
# Content-Type: image/jpeg
# Content-Length: 22534
my $img = "";
my $len;
while(my $line = <$sock>) {
$img .= $line;
if ($line =~ /^Content-Length:\s*(\d+)/) {
$len = $1;
next;
}
if ($line eq "\r\n") { last; }
}
my $size = $len && read($sock, $img, $len, length($img));
if ($len == 0 || $size != $len) {
return;
}
return $img;
}
################################################################################
# blank images
################################################################################
sub image2block {
my $img = shift;
my $len = length($img);
my $header = <<HEADER;
--$BOUNDARY
Content-Type: image/jpeg
Content-Length: $len
HEADER
$header =~ s/\r?\n/\r\n/g;
return "$header$img";
}
sub load_blank_image_black_640x480 {
return "\xff\xd8\xff\xe0\x00\x10\x4a\x46\x49\x46\x00\x01\x01\x00\x00\x01"
. "\x00\x01\x00\x00\xff\xdb\x00\x43\x00\x02\x02\x02\x02\x02\x01\x02"
. "\x02\x02\x02\x03\x02\x02\x03\x03\x06\x04\x03\x03\x03\x03\x07\x05"
. "\x05\x04\x06\x08\x07\x09\x08\x08\x07\x08\x08\x09\x0a\x0d\x0b\x09"
. "\x0a\x0c\x0a\x08\x08\x0b\x0f\x0b\x0c\x0d\x0e\x0e\x0f\x0e\x09\x0b"
. "\x10\x11\x10\x0e\x11\x0d\x0e\x0e\x0e\xff\xdb\x00\x43\x01\x02\x03"
. "\x03\x03\x03\x03\x07\x04\x04\x07\x0e\x09\x08\x09\x0e\x0e\x0e\x0e"
. "\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e"
. "\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e"
. "\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\xff\xc0"
. "\x00\x11\x08\x01\xe0\x02\x80\x03\x01\x22\x00\x02\x11\x01\x03\x11"
. "\x01\xff\xc4\x00\x15\x00\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00"
. "\x00\x00\x00\x00\x00\x00\x00\x0a\xff\xc4\x00\x14\x10\x01\x00\x00"
. "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xc4"
. "\x00\x14\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"
. "\x00\x00\x00\x00\xff\xc4\x00\x14\x11\x01\x00\x00\x00\x00\x00\x00"
. "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xda\x00\x0c\x03\x01"
. "\x00\x02\x11\x03\x11\x00\x3f\x00\x9f\xf0\x00\x00\x00\x00\x00\x00"
.("\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" x 112)
. "\x00\x1f\xff\xd9";
}
sub load_blank_image_blue_640x480 {
return "\xff\xd8\xff\xe0\x00\x10\x4a\x46\x49\x46\x00\x01\x01\x00\x00\x01"
. "\x00\x01\x00\x00\xff\xdb\x00\x43\x00\x02\x02\x02\x02\x02\x01\x02"
. "\x02\x02\x02\x03\x02\x02\x03\x03\x06\x04\x03\x03\x03\x03\x07\x05"
. "\x05\x04\x06\x08\x07\x09\x08\x08\x07\x08\x08\x09\x0a\x0d\x0b\x09"
. "\x0a\x0c\x0a\x08\x08\x0b\x0f\x0b\x0c\x0d\x0e\x0e\x0f\x0e\x09\x0b"
. "\x10\x11\x10\x0e\x11\x0d\x0e\x0e\x0e\xff\xdb\x00\x43\x01\x02\x03"
. "\x03\x03\x03\x03\x07\x04\x04\x07\x0e\x09\x08\x09\x0e\x0e\x0e\x0e"
. "\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e"
. "\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e"
. "\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\x0e\xff\xc0"
. "\x00\x11\x08\x01\xe0\x02\x80\x03\x01\x22\x00\x02\x11\x01\x03\x11"
. "\x01\xff\xc4\x00\x15\x00\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00"
. "\x00\x00\x00\x00\x00\x00\x00\x09\xff\xc4\x00\x14\x10\x01\x00\x00"
. "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xc4"
. "\x00\x16\x01\x01\x01\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"
. "\x00\x00\x00\x00\x07\x09\xff\xc4\x00\x14\x11\x01\x00\x00\x00\x00"
. "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xda\x00\x0c"
. "\x03\x01\x00\x02\x11\x03\x11\x00\x3f\x00\x8e\x60\x37\xf1\x2b\x00"
.("\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00" x 112)
. "\x00\x00\x00\x00\x00\x07\xff\xd9";
}
################################################################################
# load jpeg file
################################################################################
sub load_jpeg_file {
my $file = shift;
my $fh;
my $data;
sysopen($fh, $file, O_RDONLY);
binmode($fh);
read($fh, $data, -s $fh);
close($fh);
# check JPEG header
if ($data !~ /^\xFF\xD8\xFF\xE0..JFIF/s) { return ; }
return $data;
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment