# start quick and EXTREMELY dirty xmodem transfert
sub xmodemrecv
{
  print $sock "\x15"; #NAK 
  A000: while(1) {
    SOH: while(1) {
      if (sysread($sock,$buf,1) <= 0) { die "*** died$! ***\n"; } #SOH
      last SOH if ( $buf eq "\x01" ) || ( $buf eq "\x04" )
    }
    # leave if last byte received is an EOT
    last A000 if ($buf eq "\x04");
    # last byte received was SOH
    if (sysread($sock,$buf,1) <= 0) { die "*** died$! ***\n"; }
    $seq = unpack("c",$buf);
    if (sysread($sock,$buf,1) <= 0) { die "*** died$! ***\n"; }
    $cseq = unpack("c",$buf); 
    $mseq = - ($seq & 255) -1; # just for fun we calculate the cmpl se
+q as well
    if (sysread($sock,$buf,128) <= 0) { die "*** died$! ***\n"; }
    $sum = 0;
    for ($i = 0; $i < 128; $i++) {
      $sum += unpack("c",substr($buf,$i,1));
    } 
      $sum = pack("c",($sum & 255)); 
    print "$buf";
    if (sysread($sock,$buf,1) <= 0) { die "*** died$! ***\n"; }
    $crc = $buf; 
    if ($crc eq $sum) {
      # packet ok 
      print $sock "\x06"; #ACK
    } else { 
      # packet nok - crc differs
      print $sock "\x15"; #NAK
    }
  }
  print $sock "\x06"; #ACK
}
[download]

# start quick and EXTREMELY dirty xmodem transfert
sub xmodemsend
{
  # reading the file to be send
  open (BET ,"filename") || die "*** coudn't open filename ***\n";
  $tosend = <BET>;
  close BET || die "*** couldn't close filename ***\n";
  # wait for #NAK
  WNAK: while(1) {
    if (sysread($sock,$buf,1) <= 0) { die "*** died$! ***\n"; } 
    if ($buf eq "\x18") { die "*** CAN received from bs2000 ***\n"; }
    last WNAK if ( $buf eq "\x15" );
    print "$buf"; # print characters bcs after A020 comes TRASEC OK te
+xt
  }
  # start of transfert
  $tel = 1;
  $ptr = 0;
  A000: while(1) {
    $ctel = pack("c",($tel & 255));
    $mtel = pack("c",- ($tel & 255));
    $sum = 0;
    $buf = "";
    for ($i = 0; $i < 128; $i++) {
      $byte = substr($tosend,$i+$ptr,1);
      $buf = "$buf$byte";
      $sum += unpack("c",$byte);
    }
    $sum = pack("c",($sum & 255)); # calculate checksum
    syswrite($sock,"\x01$ctel$mtel$buf$sum",132); # send complete bloc
+k
    print "$buf";
    if (sysread($sock,$buf,1) <= 0) { die "*** died$! ***\n"; }
    if ($buf ne "\x06" && $buf ne "\x15" && $buf ne "\x18") { 
      die "*** no ACK, NAK nor CAN recevied after blocktransfert ***\n
+"; 
    }
    if ($buf eq "\x18") { #CAN
      return;
    }
    if ($buf eq "\x06") { #ACK
      # packet ok 
      $tel++;
      $ptr += 128;
    } 
    last A000 if $ptr eq length($tosend);
    if ($ptr > length($tosend)) { die "*** cannot happen :) ***\n"; }
    if ($buf eq "\x15") { #NAK 
      # packet nok - crc differs
    }
  }
  print $sock "\x04"; # EOT
  if (sysread($sock,$buf,1) <= 0) { die "*** died$! ***\n"; }
  if ($buf ne "\x06") { die "*** no ACK received after xmodem send ***
+\n"; }
}
[download]