path: root/bin/capture+encode+serve

#!/usr/bin/perl

# Send live video/audio media as RTP streams, published via RTSP

# Depends: libglib-object-introspection-perl, gir1.2-gst-rtsp-server-1.0
# Recommends: gstreamer1.0-plugins-good

use v5.12;
use warnings;

use Glib qw( TRUE FALSE );
use Glib::Object::Introspection;
use IPC::System::Simple qw(capturex);

BEGIN {
    Glib::Object::Introspection->setup(
        basename => 'Gst',
        version  => '1.0',
        package  => 'Gst',
    );
    Glib::Object::Introspection->setup(
        basename => 'GstRtspServer',
        version  => '1.0',
        package  => 'Gst',
    );
}

my $ADDRESS  = shift || $ENV{'ADDRESS'}  || '127.0.0.1';
my $PORT     = shift || $ENV{'PORT'}     || '8554';
my $VDEVICES = shift || $ENV{'VDEVICES'} || '';
my $ADEVICES = shift || $ENV{'ADEVICES'} || '';
my $VFORMAT = shift || $ENV{'VFORMAT'} || 'VP8'; # H264 VP8 RAW - default: VP8
my $AFORMAT
    = shift || $ENV{'AFORMAT'} || 'OPUS';    # AMR OPUS RAW - default: OPUS

my @VDEVICES = $VDEVICES ? split ' ', $VDEVICES : sort split ' ',
    capturex( 'find', qw(/dev -maxdepth 1 -type c -name video*) );

# FIXME: Detect/blacklist and skip faulty devices
#my @ADEVICES = grep { /^hw:/ } capturex( 'arecord', qw(-L) );
my @ADEVICES = split ' ', $ADEVICES;
chomp @ADEVICES;

#use Data::Dump; die dd @ADEVICES;

my $HEIGHT    = 240;
my $FRAMERATE = 25;
my $AUDIORATE = 48000;

my $VBITRATE = 256000;

my $VCAPS = "video/x-raw,height=$HEIGHT";
my $ACAPS = "audio/x-raw,rate=$AUDIORATE,channels=2,depth=16";

# * http://stackoverflow.com/a/42237307
my $ABUFFERS = 20000;

# * force threads using queues - see http://stackoverflow.com/a/30738533
# * generous queue sizes inspired by https://wiki.xiph.org/GST_cookbook
my $QUEUE = "queue max-size-bytes=100000000 max-size-time=0";

my %VFORMAT = (
    H264 => {

       # * let x264 use low-latency sliced-threads (i.e. don't disable treads)
        VENC =>
            "x264enc speed-preset=ultrafast tune=zerolatency bitrate=800 byte-stream=true key-int-max=15 intra-refresh=true option-string=\"slice-max-size=8192:vbv-maxrate=80:vbv-bufsize=10\" ! video/x-h264,profile=baseline ! $QUEUE ! rtph264pay",
    },
    VP8 => {
        VENC =>
            "vp8enc threads=4 cpu-used=15 deadline=1000000 end-usage=1 target-bitrate=$VBITRATE undershoot=95 keyframe-max-dist=999999 max-quantizer=56 deadline=5000 static-threshold=500 ! video/x-vp8 ! $QUEUE ! rtpvp8pay",
    },
    RAW => {
        VENC => "rtpvrawpay",
    },
);

my %AFORMAT = (
    AMR => {
        AENC => "amrnbenc ! $QUEUE ! rtpamrpay",
    },
    OPUS => {
        AENC => "opusenc ! $QUEUE ! rtpopuspay",
    },
    RAW => {
        AENC => "rtpL16pay",
    },
);

our $nextpayload = 0;

sub cam
{
    my $device  = shift;
    my $payload = "pay" . $nextpayload++;

    my $factory = Gst::RTSPMediaFactory->new();
    $factory->set_launch(
        "( v4l2src device=$device ! $QUEUE ! videoconvert ! $VCAPS ! $QUEUE ! $VFORMAT{$VFORMAT}{'VENC'} name=$payload )"
    );
    $factory->set_shared(TRUE);
    say "media ($device): " . $factory->get_launch();

#   $factory->set_latency(5);
#say "latency ($device): " . $factory->get_latency();

    return $factory;
}

sub mic
{
    my $device  = shift;
    my $payload = "pay" . $nextpayload++;

    my $factory = Gst::RTSPMediaFactory->new();
    $factory->set_launch(
        "( alsasrc device=$device buffer-time=$ABUFFERS ! $QUEUE ! audioconvert ! $QUEUE ! $AFORMAT{$AFORMAT}{'AENC'} name=$payload )"
    );
    $factory->set_shared(TRUE);

#say "media ($device): " . $factory->get_launch();
#   $factory->set_latency(5);
#say "latency ($device): " . $factory->get_latency();
    return $factory;
}

Gst::init( [ $0, @ARGV ] );
my $loop = Glib::MainLoop->new( undef, FALSE );

# create a server instance
my $server = Gst::RTSPServer->new();
$server->set_address($ADDRESS);
$server->set_service($PORT);

# get the mount points for this server, every server has a default
# object that be used to map uri mount points to media factories
my $mounts = $server->get_mount_points();

# attach media to URIs
my @mounts;
for my $i ( 0 .. $#VDEVICES ) {
    my $mount = "/cam$i";
    $mounts->add_factory( $mount, cam( $VDEVICES[$i] ) );
    push @mounts, $mount;
}
for my $i ( 0 .. $#ADEVICES ) {
    my $mount = "/mic$i";
    $mounts->add_factory( $mount, mic( $ADEVICES[$i] ) );
    push @mounts, $mount;
}

# don't need the ref to the mapper anymore
undef $mounts;

# attach the server to the default maincontext
my $retval = $server->attach(undef);

# start serving
say "streams ready at the following URLs:";
for (@mounts) {
    say "rtsp://$ADDRESS:$PORT$_";
}
$loop->run;