Запуск приложения с диска, а не из памяти.

[Des]

Я хочу сделать чтобы после обновления программа закрывалась и запускалась уже новая, скаченная с базы, версия файла, но в линуксе при этом запускается старая версия т.к. он запускает файл не с диска, а у себя из памяти. Кто нибудь знает как это обойти и запустить именно с диска?

[MiniQ]

А как вы запускаете новую версию? Из старой? Выйдя и перезапустив из скрипта?

[скалогрыз]

Работает, без каких либо проблем

вот программа 1

Код: Выделить всё

program v1;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}cthreads,{$endif} SysUtils, Classes, BaseUnix;
var
  LastError : string = '';

function FileCopy(const src, dst: string): Boolean;
var
  d: TFileStream;
  s: TfileStream;
  a: integer;
begin
  try
  s:=TFileStream.Create(src, fmOpenRead or fmShareDenyNone);
  if FileExists(dst) then DeleteFile(dst);
  d:=TFileStream.Create(dst, fmCreate);
  try
    d.CopyFrom(s, s.size);
  finally
    s.Free;
    d.Free;
  end;
  FpChmod(dst, &777);

  except
    on e:exception do begin
      LastError:=e.Message;
      result:=false;
    end;
  end;

end;

var
  pid : pid_t;
begin
  writeln('I am version 1');
  if FileExists('v2') then begin
    writeln('please hit enter to update');
    if not FileCopy('v1','v-old') then writeln('failed to make a backup');
    if not FileCopy('v2','v1') then writeln('failed to update! ', LastError)
    else begin
      pid := FpFork;
      if pid=0 then begin
        FpExecv('v1', nil);
      end else
        ;
    end;
  end else
    writeln('no update available');
end.


вот программа 2

Код: Выделить всё

program v2;

{$mode objfpc}{$H+}

begin
    writeln('i am version 2');
end.


1) Компилируем обе.
2) запускаем v1

Код: Выделить всё

./v1
I am version 1
please hit enter to update
I am version 2


Добавлено спустя 1 минуту 55 секунд:

А как вы запускаете новую версию? Из старой? Выйдя и перезапустив из скрипта?

На линуксе (и бсд) исполняемые файлы системой не лочатся на время исполнения, можно заменять файлы не завершая процесс.

[mig-31]

Не только исполняемые, но ,например: и shared object тоже.
Команда sync запишет кеш диска на диск.

[Des]

Работает, без каких либо проблем

вот программа 1

Код: Выделить всё

program v1;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}cthreads,{$endif} SysUtils, Classes, BaseUnix;
var
  LastError : string = '';

function FileCopy(const src, dst: string): Boolean;
var
  d: TFileStream;
  s: TfileStream;
  a: integer;
begin
  try
  s:=TFileStream.Create(src, fmOpenRead or fmShareDenyNone);
  if FileExists(dst) then DeleteFile(dst);
  d:=TFileStream.Create(dst, fmCreate);
  try
    d.CopyFrom(s, s.size);
  finally
    s.Free;
    d.Free;
  end;
  FpChmod(dst, &777);

  except
    on e:exception do begin
      LastError:=e.Message;
      result:=false;
    end;
  end;

end;

var
  pid : pid_t;
begin
  writeln('I am version 1');
  if FileExists('v2') then begin
    writeln('please hit enter to update');
    if not FileCopy('v1','v-old') then writeln('failed to make a backup');
    if not FileCopy('v2','v1') then writeln('failed to update! ', LastError)
    else begin
      pid := FpFork;
      if pid=0 then begin
        FpExecv('v1', nil);
      end else
        ;
    end;
  end else
    writeln('no update available');
end.


вот программа 2

Код: Выделить всё

program v2;

{$mode objfpc}{$H+}

begin
    writeln('i am version 2');
end.


1) Компилируем обе.
2) запускаем v1

Код: Выделить всё

./v1
I am version 1
please hit enter to update
I am version 2


Добавлено спустя 1 минуту 55 секунд:

А как вы запускаете новую версию? Из старой? Выйдя и перезапустив из скрипта?

На линуксе (и бсд) исполняемые файлы системой не лочатся на время исполнения, можно заменять файлы не завершая процесс.

Я так понимаю новая версия приложения это будет дочерний процесс? потому что когда я делаю application.terminate у меня закрываются оба приложения и версия 1 и версия 2. Как закрыть тогда первое приложение?

[скалогрыз]

Я так понимаю новая версия приложения это будет дочерний процесс? потому что когда я делаю application.terminate у меня закрываются оба приложения и версия 1 и версия 2. Как закрыть тогда первое приложение?

а ты вторую версию через FpExecv() запускаешь?

[Des]

Я так понимаю новая версия приложения это будет дочерний процесс? потому что когда я делаю application.terminate у меня закрываются оба приложения и версия 1 и версия 2. Как закрыть тогда первое приложение?

а ты вторую версию через FpExecv() запускаешь?

да, все как у тебя, за исключением копирования, копирую по своему. старый deletefile('v1'), потом новый renamefile('v2','v1')

[скалогрыз]

да, все как у тебя, за исключением копирования, копирую по своему. старый deletefile('v1'), потом новый renamefile('v2','v1')

дочерний процесс не прибивается за просто так.

в аттаче пример GUI-ёвого приложения, которое после update-а вызывает(себе) Application.Terminate и всё работает, как ожидается.

[Des]

да, все как у тебя, за исключением копирования, копирую по своему. старый deletefile('v1'), потом новый renamefile('v2','v1')

дочерний процесс не прибивается за просто так.

в аттаче пример GUI-ёвого приложения, которое после update-а вызывает(себе) Application.Terminate и всё работает, как ожидается.

у меня все работает именно как в моей программе, как только в верссии 1 делаю Application.Terminate закрывается и версия 1 и версия 2

[скалогрыз]

у меня все работает именно как в моей программе, как только в верссии 1 делаю Application.Terminate закрывается и версия 1 и версия 2

хм, а что за линукс такой?

Может настройки шелла/терминала какие-то хитрые?!

[Des]

у меня все работает именно как в моей программе, как только в верссии 1 делаю Application.Terminate закрывается и версия 1 и версия 2

хм, а что за линукс такой?

Может настройки шелла/терминала какие-то хитрые?!

Rosa Desktop Fresh R6

[скалогрыз]

у меня получается автоматически прибить дочерный процесс только по принуждению

Код: Выделить всё

program v1;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}cthreads,{$endif} ctypes, SysUtils, Classes, BaseUnix;
var
  LastError : string = '';

function FileCopy(const src, dst: string): Boolean;
var
  d: TFileStream;
  s: TfileStream;
  a: integer;
begin
  try
  s:=TFileStream.Create(src, fmOpenRead or fmShareDenyNone);
  if FileExists(dst) then DeleteFile(dst);
  d:=TFileStream.Create(dst, fmCreate);
  try
    d.CopyFrom(s, s.size);
  finally
    s.Free;
    d.Free;
  end;
  FpChmod(dst, &777);
  Result:=true;

  except
    on e:exception do begin
      LastError:=e.Message;
      result:=false;
    end;
  end;

end;

const
  PR_SET_PDEATHSIG = 1;  // Second arg is a signal
  PR_GET_PDEATHSIG = 2;  // Second arg is a ptr to return the signal

function prctl(ctrl: cint; arg2,arg3, arg4, arg5: culong): cint;
  cdecl; external;

procedure SetParentDeathSignal(a: cint);
begin
  prctl(PR_SET_PDEATHSIG, a, 0,0,0);
end;

procedure ShowParentDeathSignal;
var
  res : integer;
  vl  : cint;
begin
  vl:=0;
  res:=prctl(PR_GET_PDEATHSIG,culong(@vl),0,0,0);
  writeln('res = ', res);
  writeln('sig = ', vl);
end;

var
  pid : pid_t;
begin
  writeln('I am version 1');
  ShowParentDeathSignal;
  if FileExists('v2') then begin
    writeln('please hit enter to update');
    if not FileCopy('v1','v-old') then writeln('failed to make a backup');
    if not FileCopy('v2','v1') then writeln('failed to update! ', LastError)
    else begin
      pid := FpFork;
      if pid=0 then begin
        writeln('forking child');
        SetParentDeathSignal(SIGTERM);
        ShowParentDeathSignal;
        FpExecv('v1', nil);
      end else begin
        writeln('i am taking a nap for a sec, so the child could start');
        writeln('and setup Parent Death Signal!');
        sleep(100);
        writeln('i am shutting down!');
        halt(0);
      end;
    end;
  end else
    writeln('no update available');
end. 

program v2;
uses SysUtils;
var
  i : integer;
begin
  writeln('I am version 2');
  for i:=0 to 10 do begin
    writelN(i);
    sleep(1000);
  end;
 
  writelN('version 2 is done!');
end.



Если закоментировать SetParentDeathSignal(SIGTERM); то он у тебя какой "sig = " показывает?

[Des]

у меня получается автоматически прибить дочерный процесс только по принуждению

Код: Выделить всё

program v1;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}cthreads,{$endif} ctypes, SysUtils, Classes, BaseUnix;
var
  LastError : string = '';

function FileCopy(const src, dst: string): Boolean;
var
  d: TFileStream;
  s: TfileStream;
  a: integer;
begin
  try
  s:=TFileStream.Create(src, fmOpenRead or fmShareDenyNone);
  if FileExists(dst) then DeleteFile(dst);
  d:=TFileStream.Create(dst, fmCreate);
  try
    d.CopyFrom(s, s.size);
  finally
    s.Free;
    d.Free;
  end;
  FpChmod(dst, &777);
  Result:=true;

  except
    on e:exception do begin
      LastError:=e.Message;
      result:=false;
    end;
  end;

end;

const
  PR_SET_PDEATHSIG = 1;  // Second arg is a signal
  PR_GET_PDEATHSIG = 2;  // Second arg is a ptr to return the signal

function prctl(ctrl: cint; arg2,arg3, arg4, arg5: culong): cint;
  cdecl; external;

procedure SetParentDeathSignal(a: cint);
begin
  prctl(PR_SET_PDEATHSIG, a, 0,0,0);
end;

procedure ShowParentDeathSignal;
var
  res : integer;
  vl  : cint;
begin
  vl:=0;
  res:=prctl(PR_GET_PDEATHSIG,culong(@vl),0,0,0);
  writeln('res = ', res);
  writeln('sig = ', vl);
end;

var
  pid : pid_t;
begin
  writeln('I am version 1');
  ShowParentDeathSignal;
  if FileExists('v2') then begin
    writeln('please hit enter to update');
    if not FileCopy('v1','v-old') then writeln('failed to make a backup');
    if not FileCopy('v2','v1') then writeln('failed to update! ', LastError)
    else begin
      pid := FpFork;
      if pid=0 then begin
        writeln('forking child');
        SetParentDeathSignal(SIGTERM);
        ShowParentDeathSignal;
        FpExecv('v1', nil);
      end else begin
        writeln('i am taking a nap for a sec, so the child could start');
        writeln('and setup Parent Death Signal!');
        sleep(100);
        writeln('i am shutting down!');
        halt(0);
      end;
    end;
  end else
    writeln('no update available');
end. 

program v2;
uses SysUtils;
var
  i : integer;
begin
  writeln('I am version 2');
  for i:=0 to 10 do begin
    writelN(i);
    sleep(1000);
  end;
 
  writelN('version 2 is done!');
end.



Если закоментировать SetParentDeathSignal(SIGTERM); то он у тебя какой "sig = " показывает?

I am version 1

res = 0

sig = 0

please hit enter to update

forking child

res = 0

sig = 0

I am version 2

0

i am taking a nap for a sec, so the child could start

and setup Parent Death Signal!

i am shutting down!

[скалогрыз]

Очень интересно. давай посмотрим кто прибивает v2

Код: Выделить всё

program v1;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}cthreads,{$endif} ctypes, SysUtils, Classes, BaseUnix;
var
  LastError : string = '';

function FileCopy(const src, dst: string): Boolean;
var
  d: TFileStream;
  s: TfileStream;
  a: integer;
begin
  try
  s:=TFileStream.Create(src, fmOpenRead or fmShareDenyNone);
  if FileExists(dst) then DeleteFile(dst);
  d:=TFileStream.Create(dst, fmCreate);
  try
    d.CopyFrom(s, s.size);
  finally
    s.Free;
    d.Free;
  end;
  FpChmod(dst, &777);
  Result:=true;

  except
    on e:exception do begin
      LastError:=e.Message;
      result:=false;
    end;
  end;

end;

const
  PR_SET_PDEATHSIG = 1;  // Second arg is a signal
  PR_GET_PDEATHSIG = 2;  // Second arg is a ptr to return the signal

function prctl(ctrl: cint; arg2,arg3, arg4, arg5: culong): cint;
  cdecl; external;

procedure SetParentDeathSignal(a: cint);
begin
  prctl(PR_SET_PDEATHSIG, a, 0,0,0);
end;

procedure ShowParentDeathSignal;
var
  res : integer;
  vl  : cint;
begin
  vl:=0;
  res:=prctl(PR_GET_PDEATHSIG,culong(@vl),0,0,0);
  writeln('res = ', res);
  writeln('sig = ', vl);
end;

var
  pid : pid_t;
begin
  writeln('I am version 1');
  writeln('mypid: ', GetProcessID);
  //ShowParentDeathSignal;
  if FileExists('v2') then begin
    writeln('please hit enter to update');
    if not FileCopy('v1','v-old') then writeln('failed to make a backup');
    if not FileCopy('v2','v1') then writeln('failed to update! ', LastError)
    else begin
      pid := FpFork;
      if pid=0 then begin
        writeln('forking child');
        //SetParentDeathSignal(SIGTERM);
        //ShowParentDeathSignal;
        FpExecv('v1', nil);
      end else begin
        writeln('i am taking a nap for a sec, so the child could start');
        writeln('and setup Parent Death Signal!');
        sleep(1000);
        writeln('i am shutting down!');
        halt(0);
      end;
    end;
  end else
    writeln('no update available');
end.

program v2;
{$mode delphi}
uses SysUtils, baseunix;

procedure HandlerSigTerm(signal: longint; info: psiginfo; context: psigcontext); cdecl;
begin
  if Assigned(info) then
    writeln('Terminated by: ', info^._sifields._kill._pid)
  else
    writeln('no info :(');
  Halt(0);
end;

var
  i : integer;
  act : sigactionrec;
begin
  FillChar(act, sizeof(act), 0);
  act.sa_handler:=HandlerSigTerm;
  act.sa_flags:=SA_SIGINFO;
  FPSigaction(SIGTERM, @act, nil);

  writeln('mypid: ', GetProcessID);
  writeln('I am version 2');
  for i:=0 to 10 do begin
    writelN(i);
    sleep(1000);
  end;


  writelN('version 2 is done!');
end. 


[Des]

Очень интересно. давай посмотрим кто прибивает v2

Код: Выделить всё

program v1;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}cthreads,{$endif} ctypes, SysUtils, Classes, BaseUnix;
var
  LastError : string = '';

function FileCopy(const src, dst: string): Boolean;
var
  d: TFileStream;
  s: TfileStream;
  a: integer;
begin
  try
  s:=TFileStream.Create(src, fmOpenRead or fmShareDenyNone);
  if FileExists(dst) then DeleteFile(dst);
  d:=TFileStream.Create(dst, fmCreate);
  try
    d.CopyFrom(s, s.size);
  finally
    s.Free;
    d.Free;
  end;
  FpChmod(dst, &777);
  Result:=true;

  except
    on e:exception do begin
      LastError:=e.Message;
      result:=false;
    end;
  end;

end;

const
  PR_SET_PDEATHSIG = 1;  // Second arg is a signal
  PR_GET_PDEATHSIG = 2;  // Second arg is a ptr to return the signal

function prctl(ctrl: cint; arg2,arg3, arg4, arg5: culong): cint;
  cdecl; external;

procedure SetParentDeathSignal(a: cint);
begin
  prctl(PR_SET_PDEATHSIG, a, 0,0,0);
end;

procedure ShowParentDeathSignal;
var
  res : integer;
  vl  : cint;
begin
  vl:=0;
  res:=prctl(PR_GET_PDEATHSIG,culong(@vl),0,0,0);
  writeln('res = ', res);
  writeln('sig = ', vl);
end;

var
  pid : pid_t;
begin
  writeln('I am version 1');
  writeln('mypid: ', GetProcessID);
  //ShowParentDeathSignal;
  if FileExists('v2') then begin
    writeln('please hit enter to update');
    if not FileCopy('v1','v-old') then writeln('failed to make a backup');
    if not FileCopy('v2','v1') then writeln('failed to update! ', LastError)
    else begin
      pid := FpFork;
      if pid=0 then begin
        writeln('forking child');
        //SetParentDeathSignal(SIGTERM);
        //ShowParentDeathSignal;
        FpExecv('v1', nil);
      end else begin
        writeln('i am taking a nap for a sec, so the child could start');
        writeln('and setup Parent Death Signal!');
        sleep(1000);
        writeln('i am shutting down!');
        halt(0);
      end;
    end;
  end else
    writeln('no update available');
end.

program v2;
{$mode delphi}
uses SysUtils, baseunix;

procedure HandlerSigTerm(signal: longint; info: psiginfo; context: psigcontext); cdecl;
begin
  if Assigned(info) then
    writeln('Terminated by: ', info^._sifields._kill._pid)
  else
    writeln('no info :(');
  Halt(0);
end;

var
  i : integer;
  act : sigactionrec;
begin
  FillChar(act, sizeof(act), 0);
  act.sa_handler:=HandlerSigTerm;
  act.sa_flags:=SA_SIGINFO;
  FPSigaction(SIGTERM, @act, nil);

  writeln('mypid: ', GetProcessID);
  writeln('I am version 2');
  for i:=0 to 10 do begin
    writelN(i);
    sleep(1000);
  end;


  writelN('version 2 is done!');
end. 


I am version 1

mypid: 6970

please hit enter to update

forking child

mypid: 6971

I am version 2

0

i am taking a nap for a sec, so the child could start

and setup Parent Death Signal!

i am shutting down!